summaryrefslogtreecommitdiff
path: root/Hero/Server.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Hero/Server.hs')
-rw-r--r--Hero/Server.hs51
1 files changed, 33 insertions, 18 deletions
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