From 752dcc5e1b04c507c67485c137b7ece2208e6f42 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Thu, 5 Sep 2019 21:42:46 -0700 Subject: [ibb] implement first api route --- lore/Biz/Ibb/Core.hs | 4 ++-- lore/Biz/Ibb/Keep.hs | 30 ++++++++++++++++++++++++------ 2 files changed, 26 insertions(+), 8 deletions(-) (limited to 'lore/Biz/Ibb') 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 -- cgit v1.2.3