diff options
| -rw-r--r-- | apex/Ibb.hs | 31 | ||||
| -rw-r--r-- | lore/Biz/Ibb/Core.hs | 4 | ||||
| -rw-r--r-- | lore/Biz/Ibb/Keep.hs | 30 |
3 files changed, 50 insertions, 15 deletions
diff --git a/apex/Ibb.hs b/apex/Ibb.hs index 7d8a377..6d934f9 100644 --- a/apex/Ibb.hs +++ b/apex/Ibb.hs @@ -11,6 +11,8 @@ import Alpha import Biz.Ibb import qualified Biz.Ibb.Keep as Keep import Data.Maybe (fromMaybe) +import Data.Acid (AcidState) +import qualified Data.Acid.Abstract as Acid import qualified Lucid as L import Lucid.Base import Miso @@ -26,12 +28,13 @@ import System.Environment (lookupEnv) main :: IO () main = do - say "running: ibb" + say "rise: ibb" port <- read <$> fromMaybe "3000" <$> lookupEnv "PORT" :: IO Int + keep <- Keep.openLocal "keep/" say "port: 3000" - run port $ logStdout $ compress $ app + run port $ logStdout $ compress $ app $ keep where compress = gzip def { gzipFiles = GzipCompress } @@ -54,7 +57,7 @@ instance L.ToHtml a => L.ToHtml (HtmlPage a) where , makeAttribute "defer" mempty ] -type ServerRoutes = ToServerRoutes Routes HtmlPage Action +type ServerRoutes = ToServerRoutes AppRoutes HtmlPage Action handle404 :: Application handle404 _ respond = respond @@ -64,19 +67,33 @@ handle404 _ respond = respond $ HtmlPage $ notfound -type Api = "static" :> Raw +type Routes = "static" :> Raw :<|> ServerRoutes + :<|> "api" :> ApiRoutes :<|> Raw -app :: Application -app = serve (Proxy @Api) - $ static :<|> serverHandlers :<|> Tagged handle404 +app :: AcidState Keep.IbbKeep -> Application +app keep = serve + (Proxy @Routes) + $ static + :<|> serverHandlers + :<|> apiHandlers keep + :<|> Tagged handle404 where static = serveDirectoryWith (defaultWebAppSettings "ibb.jsexe") +type ApiRoutes = + "people" :> Get '[JSON] [Person] + serverHandlers :: Server ServerRoutes serverHandlers = homeHandler where send f u = pure $ HtmlPage $ f Model { uri = u, people = NotAsked } homeHandler = send home goHome + +-- | for now we just have one api endpoint, which returns all the people +apiHandlers :: AcidState Keep.IbbKeep -> Server ApiRoutes +apiHandlers keep = do + people <- Acid.query' keep $ Keep.GetPeople 20 + return $ people 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 |