summaryrefslogtreecommitdiff
path: root/lore/Biz
diff options
context:
space:
mode:
Diffstat (limited to 'lore/Biz')
-rw-r--r--lore/Biz/Ibb/Core.hs4
-rw-r--r--lore/Biz/Ibb/Keep.hs30
2 files changed, 26 insertions, 8 deletions
diff --git a/lore/Biz/Ibb/Core.hs b/lore/Biz/Ibb/Core.hs
index 9ffa966..5d8f805 100644
--- a/lore/Biz/Ibb/Core.hs
+++ b/lore/Biz/Ibb/Core.hs
@@ -49,7 +49,7 @@ instance ToJSON Book
-- * app data types
-type Routes = Home
+type AppRoutes = Home
type Home = View Action
@@ -82,7 +82,7 @@ notfound = div_ [] [ text "404" ]
goHome :: URI
goHome = linkURI $ safeLink
- (Proxy :: Proxy Routes)
+ (Proxy :: Proxy AppRoutes)
(Proxy :: Proxy Home)
see :: Model -> View Action
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