[ibb] add keep instances

1 files changed, 56 insertions, 0 deletions

diff --git a/lore/Biz/Ibb/Keep.hs b/lore/Biz/Ibb/Keep.hs
new file mode 100644
index 0000000..348d0ad
--- /dev/null
+++ b/lore/Biz/Ibb/Keep.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+-- | Keep is a database built on Data.Acid.
+--
+-- If this proves useful, maybe we could make it a more general thing. Like
+-- `Biz.Keep`. I could wrap all the safecopy stuff in my own template haskell
+-- like `$(keep ''MyType)`.
+--
+module Biz.Ibb.Keep where
+
+import Biz.Ibb.Influencers (Person(..), Book(..))
+import Data.SafeCopy
+import Data.Data (Data, Typeable)
+import Data.Text (Text)
+import Data.IxSet (Indexable(..), ixFun, ixSet)
+
+-- * Index @Person@
+
+$(deriveSafeCopy 0 'base  ''Person)
+
+newtype PersonName =
+  PersonName Text deriving (Eq, Ord, Data, Typeable)
+
+newtype PersonBlurb =
+  PersonBlurb Text deriving (Eq, Ord, Data, Typeable)
+
+instance Indexable Person where
+  empty = ixSet
+    [ ixFun $ \p -> [ PersonName $ _name p ]
+    , ixFun $ \p -> [ _pic p ]
+    , ixFun $ \p -> [ _twitter p ]
+    , ixFun $ \p -> [ _website p ]
+    , ixFun $ \p -> [ _books p ]
+    , ixFun $ \p -> [ PersonBlurb $ _blurb p ]
+    ]
+
+-- * Index @Book@
+
+$(deriveSafeCopy 0 'base  ''Book)
+
+newtype BookTitle =
+  BookTitle Text deriving (Eq, Ord, Data, Typeable)
+
+newtype BookAuthor =
+  BookAuthor Text deriving (Eq, Ord, Data, Typeable)
+
+instance Indexable Book where
+  empty = ixSet
+    [ ixFun $ \b -> [ BookTitle $ _title b ]
+    , ixFun $ \b -> [ BookAuthor $ _author b ]
+    , ixFun $ \b -> [ _amznref b ]
+    ]