From 752dcc5e1b04c507c67485c137b7ece2208e6f42 Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Thu, 5 Sep 2019 21:42:46 -0700
Subject: [ibb] implement first api route

---
 apex/Ibb.hs          | 31 ++++++++++++++++++++++++-------
 lore/Biz/Ibb/Core.hs |  4 ++--
 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
-- 
cgit v1.2.3