summaryrefslogtreecommitdiff
path: root/lore/Biz/Ibb/Keep.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2019-09-05 21:42:46 -0700
committerBen Sima <ben@bsima.me>2019-09-05 21:42:46 -0700
commit752dcc5e1b04c507c67485c137b7ece2208e6f42 (patch)
tree543525e838ea2c90eac27aa27f71e62b059a9d6b /lore/Biz/Ibb/Keep.hs
parent291a40f56ccc937a1f0c6735efb795e28c5c360b (diff)
[ibb] implement first api route
Diffstat (limited to 'lore/Biz/Ibb/Keep.hs')
-rw-r--r--lore/Biz/Ibb/Keep.hs30
1 files changed, 24 insertions, 6 deletions
diff --git a/lore/Biz/Ibb/Keep.hs b/lore/Biz/Ibb/Keep.hs
index 03ec143..ad7dcbc 100644
--- a/lore/Biz/Ibb/Keep.hs
+++ b/lore/Biz/Ibb/Keep.hs
@@ -14,7 +14,9 @@ module Biz.Ibb.Keep where
import Biz.Ibb.Core (Person(..), Book(..))
import Control.Monad.State (get, put)
-import Data.Acid (Update)
+import Control.Monad.Reader (ask)
+import Data.Acid (Update, makeAcidic)
+import qualified Data.Acid as Acid
import Data.Data (Data, Typeable)
import Data.IxSet (Indexable(..), IxSet, ixFun, ixSet)
import qualified Data.IxSet as IxSet
@@ -22,6 +24,8 @@ import Data.SafeCopy
import Data.Text (Text)
import qualified Data.Text as Text
+import qualified Biz.Ibb.Influencers as Influencers
+
-- * Keep
-- | Main database. Need to think of a better name for this.
@@ -32,11 +36,6 @@ data IbbKeep = IbbKeep
$(deriveSafeCopy 0 'base ''IbbKeep)
-initialIbbKeep :: IbbKeep
-initialIbbKeep = IbbKeep
- { _people = empty
- }
-
-- * Index @Person@
$(deriveSafeCopy 0 'base ''Person)
@@ -74,6 +73,11 @@ newPerson name blurb = do
, _blurb = blurb
}
+getPeople :: Int -> Acid.Query IbbKeep [Person]
+getPeople n = do
+ keep <- ask
+ return $ take n $ IxSet.toList $ _people keep
+
-- * Index @Book@
$(deriveSafeCopy 0 'base ''Book)
@@ -104,3 +108,17 @@ instance Indexable Book where
-- , _author = author
-- , _amznref = amznref
-- }
+
+-- * Opening the keep
+
+-- defines @NewPerson@ for us.
+$(makeAcidic ''IbbKeep ['newPerson, 'getPeople])
+
+initialIbbKeep :: IbbKeep
+initialIbbKeep = IbbKeep
+ { _people = IxSet.fromList Influencers.allPeople
+ }
+
+openLocal :: String -> IO (Acid.AcidState IbbKeep)
+openLocal dir =
+ Acid.openLocalStateFrom dir initialIbbKeep