From 291a40f56ccc937a1f0c6735efb795e28c5c360b Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Wed, 4 Sep 2019 07:08:46 -0700 Subject: [ibb] implement keep --- apex/Ibb.hs | 1 + lore/Biz/Ibb/Keep.hs | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++-- 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 +-- } -- cgit v1.2.3