diff options
Diffstat (limited to 'Hero/Server.hs')
-rw-r--r-- | Hero/Server.hs | 51 |
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 |