Initialize Hero database

1 files changed, 21 insertions, 14 deletions

diff --git a/Hero/Server.hs b/Hero/Server.hs
index 4dc80f5..73108be 100644
--- a/Hero/Server.hs
+++ b/Hero/Server.hs
@@ -13,17 +13,19 @@
 --
 -- : exe mmc
 --
+-- : dep acid-state
 -- : dep aeson
 -- : dep clay
 -- : dep containers
--- : dep dhall
 -- : dep envy
 -- : dep http-types
+-- : dep ixset
 -- : dep lucid
 -- : dep miso
 -- : dep mtl
 -- : dep network-uri
 -- : dep protolude
+-- : dep safecopy
 -- : dep servant
 -- : dep servant-lucid
 -- : dep servant-server
@@ -40,6 +42,8 @@ module Hero.Server where
 
 import qualified Clay
 import Data.Aeson
+import Data.Acid (AcidState)
+import qualified Data.Acid.Abstract as Acid
 import Data.Proxy
 import Data.Text (Text)
 import qualified Data.Text.Lazy as Lazy
@@ -74,13 +78,14 @@ main = bracket startup shutdown $ uncurry Warp.run
     say = IO.hPutStrLn IO.stderr
     startup = Envy.decodeEnv >>= \case
       Left e -> Exit.die e
-      Right c -> do
-        db <- Database.dummy
+      Right cfg -> do
+        keep <- Database.openLocal (heroDataDir cfg)
         say "hero"
-        say $ "port: " ++ show (heroPort c)
-        say $ "client: " ++ heroClient c
-        let waiapp = app db c
-        return (heroPort c, waiapp)
+        say $ "port: " ++ show (heroPort cfg)
+        say $ "client: " ++ heroClient cfg
+        say $ "data: " ++ heroDataDir cfg
+        let waiapp = app keep cfg
+        return (heroPort cfg, waiapp)
     shutdown :: a -> IO a
     shutdown = pure . identity
 
@@ -89,22 +94,24 @@ data Config
       { -- | HERO_PORT
         heroPort :: Warp.Port,
         -- | HERO_CLIENT
-        heroClient :: FilePath
+        heroClient :: FilePath,
+        -- | HERO_DATA
+        heroDataDir :: FilePath
       }
   deriving (Generic, Show)
 
 instance Envy.DefConfig Config where
-  defConfig = Config 3000 "_bild/Hero.Client/static"
+  defConfig = Config 3000 "_bild/Hero.Client/static" "_keep"
 
 instance Envy.FromEnv Config
 
-app :: Database.ComicDB -> Config -> Application
-app db cfg =
+app :: AcidState Database.HeroKeep -> Config -> Application
+app keep cfg =
   serve
     (Proxy @AllRoutes)
     ( static
         :<|> cssHandlers
-        :<|> jsonHandlers db
+        :<|> jsonHandlers keep
         :<|> serverHandlers
         :<|> pure heroManifest
         :<|> Tagged handle404
@@ -272,8 +279,8 @@ serverHandlers =
     :<|> discoverHandler
     :<|> chooseExperienceHandler
 
-jsonHandlers :: Database.ComicDB -> Server JsonApi
-jsonHandlers = Database.getComics
+jsonHandlers :: AcidState Database.HeroKeep -> Server JsonApi
+jsonHandlers keep = Acid.query' keep $ Database.GetComics 10
 
 homeHandler :: Handler (HtmlPage (View Action))
 homeHandler = pure . HtmlPage . home $ initModel homeLink