[ibb] implement keep

2 files changed, 53 insertions, 2 deletions

diff --git a/apex/Ibb.hs b/apex/Ibb.hs
index c626f3f..7d8a377 100644
--- a/apex/Ibb.hs
+++ b/apex/Ibb.hs
@@ -9,6 +9,7 @@ module Ibb where
 
 import Alpha
 import Biz.Ibb
+import qualified Biz.Ibb.Keep as Keep
 import Data.Maybe (fromMaybe)
 import qualified Lucid as L
 import Lucid.Base
diff --git a/lore/Biz/Ibb/Keep.hs b/lore/Biz/Ibb/Keep.hs
index 533dab8..03ec143 100644
--- a/lore/Biz/Ibb/Keep.hs
+++ b/lore/Biz/Ibb/Keep.hs
@@ -13,10 +13,29 @@
 module Biz.Ibb.Keep where
 
 import Biz.Ibb.Core (Person(..), Book(..))
-import Data.SafeCopy
+import Control.Monad.State (get, put)
+import Data.Acid (Update)
 import Data.Data (Data, Typeable)
+import Data.IxSet (Indexable(..), IxSet, ixFun, ixSet)
+import qualified Data.IxSet as IxSet
+import Data.SafeCopy
 import Data.Text (Text)
-import Data.IxSet (Indexable(..), ixFun, ixSet)
+import qualified Data.Text as Text
+
+-- * Keep
+
+-- | Main database. Need to think of a better name for this.
+data IbbKeep = IbbKeep
+  { _people :: IxSet Person
+  }
+  deriving (Data, Typeable)
+
+$(deriveSafeCopy 0 'base ''IbbKeep)
+
+initialIbbKeep :: IbbKeep
+initialIbbKeep = IbbKeep
+  { _people = empty
+  }
 
 -- * Index @Person@
 
@@ -38,6 +57,23 @@ instance Indexable Person where
     , ixFun $ \p -> [ PersonBlurb $ _blurb p ]
     ]
 
+-- | updates the `IbbKeep` with a new `Person`
+newPerson :: Text -> Text -> Update IbbKeep Person
+newPerson name blurb = do
+  k <- get
+  put $ k { _people = IxSet.insert p (_people k)
+          }
+  return p
+    where
+      p = Person
+          { _name = name
+          , _pic = Text.empty
+          , _twitter = Text.empty
+          , _website = Text.empty
+          , _books = []
+          , _blurb = blurb
+          }
+
 -- * Index @Book@
 
 $(deriveSafeCopy 0 'base  ''Book)
@@ -54,3 +90,17 @@ instance Indexable Book where
     , ixFun $ \b -> [ BookAuthor $ _author b ]
     , ixFun $ \b -> [ _amznref b ]
     ]
+
+-- | updates the `IbbKeep` with a new `Book`
+--newBook :: Text -> Text -> Text -> Update IbbKeep Book
+--newBook title author amznref = do
+--  ibbKeep <- get
+--  put $ ibbKeep { _books = IxSet.insert b (_books ibbKeep)
+--                , _people = _people ibbKeep
+--                }
+--  return b
+--    where
+--      b = Book { _title = title
+--               , _author = author
+--               , _amznref = amznref
+--               }