From 37062e1ca6c479b7cf773931aa0e797ebcfafe8b Mon Sep 17 00:00:00 2001
From: Ben Sima <ben@bsima.me>
Date: Fri, 5 Jun 2020 22:27:14 -0700
Subject: Add user datatype to keep

I also restructured some types so that I could grab a handle on the keep to
close it on shutdown, otherwise the database would be locked and I can't do
anything about it. This might mean I have to delete and start the database from
scratch when I deploy, but that's okay because I haven't stored anything yet.

I also renamed some stuff like 'deck' and 'beam' just for fun. I could make
these into more general interfaces like I always planned to.

Also I haven't really tested this yet, so... next commit will implement the user
login.
---
 Hero/Server.hs | 51 +++++++++++++++++++++++++++++++++------------------
 1 file changed, 33 insertions(+), 18 deletions(-)

(limited to 'Hero/Server.hs')

diff --git a/Hero/Server.hs b/Hero/Server.hs
index d663c37..351e839 100644
--- a/Hero/Server.hs
+++ b/Hero/Server.hs
@@ -41,9 +41,9 @@
 module Hero.Server where
 
 import qualified Clay
-import Data.Aeson
 import Data.Acid (AcidState)
 import qualified Data.Acid.Abstract as Acid
+import Data.Aeson
 import Data.Proxy
 import Data.Text (Text)
 import qualified Data.Text.Lazy as Lazy
@@ -73,30 +73,45 @@ import qualified System.Exit as Exit
 import qualified System.IO as IO
 
 main :: IO ()
-main = bracket startup shutdown $ uncurry Warp.run
+main = bracket startup shutdown run
   where
+    run (cfg, app, _) = Warp.run (heroPort cfg) app
     say = IO.hPutStrLn IO.stderr
     startup = Envy.decodeEnv >>= \case
       Left e -> Exit.die e
       Right cfg -> do
-        keep <- Keep.openLocal (heroDataDir cfg)
+        keep <- Keep.open (heroKeep cfg)
         say "hero"
         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
+        say $ "beam: " ++ heroBeam cfg
+        say $ "keep: " ++ heroKeep cfg
+        let waiapp = mkApp keep cfg
+        return (cfg, waiapp, keep)
+    shutdown :: App -> IO ()
+    shutdown (_, _, keep) = do
+      Keep.close keep
+      return ()
+
+-- This part is a little confusing. I have:
+--
+--   - 'App' which encapsulates the entire runtime state
+--   - 'Config' has stuff I can set at startup
+--   - 'HeroKeep' is the database and any other persistance
+--   - 'mkApp' take the second two and makes a 'Wai.Application', should really be
+--     called 'serve', and might need to be Servant's 'hoistServer' thing
+--
+-- I'm sure this can be cleaned up with a monad stack of some sort, but I
+-- haven't the brain power to think through that. For now, just try and keep
+-- things named clearly so I don't get confused.
+
+-- | This can be generalized I think, put in Biz.App, or something
+type App = (Config, Application, AcidState Keep.HeroKeep)
 
 data Config
   = Config
-      { -- | HERO_PORT
-        heroPort :: Warp.Port,
-        -- | HERO_CLIENT
-        heroClient :: FilePath,
-        -- | HERO_DATA
-        heroDataDir :: FilePath
+      { heroPort :: Warp.Port,
+        heroBeam :: FilePath,
+        heroKeep :: FilePath
       }
   deriving (Generic, Show)
 
@@ -105,8 +120,8 @@ instance Envy.DefConfig Config where
 
 instance Envy.FromEnv Config
 
-app :: AcidState Keep.HeroKeep -> Config -> Application
-app keep cfg =
+mkApp :: AcidState Keep.HeroKeep -> Config -> Application
+mkApp keep cfg =
   serve
     (Proxy @AllRoutes)
     ( static
@@ -117,7 +132,7 @@ app keep cfg =
         :<|> Tagged handle404
     )
   where
-    static = serveDirectoryWith $ defaultWebAppSettings $ heroClient cfg
+    static = serveDirectoryWith $ defaultWebAppSettings $ heroBeam cfg
 
 -- | HtmlPage for setting HTML doctype and header
 newtype HtmlPage a = HtmlPage a
-- 
cgit v1.2.3