Add Com.MusicMeetsComics

1 files changed, 49 insertions, 0 deletions

diff --git a/Com/MusicMeetsComics/Server/Init.hs b/Com/MusicMeetsComics/Server/Init.hs
new file mode 100644
index 0000000..7ad3ebf
--- /dev/null
+++ b/Com/MusicMeetsComics/Server/Init.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Com.MusicMeetsComics.Server.Init where
+
+import qualified Com.MusicMeetsComics.Server.Config as Config
+import           Control.Concurrent (killThread)
+import           Control.Exception (bracket)
+import qualified Control.Monad.Metrics as M
+import qualified Katip
+import           Lens.Micro ((^.))
+import           Network.Wai (Application, Middleware)
+import           Network.Wai.Handler.Warp (run)
+import           Network.Wai.Metrics (metrics, registerWaiMetrics)
+import           Network.Wai.Middleware.Gzip
+import           Protolude
+import qualified System.IO as IO
+
+-- | An action that creates a WAI 'Application' together with its resources,
+--   runs it, and tears it down on exit
+runApp :: (Config.Config -> Application) -> IO ()
+runApp app = bracket Config.acquire shutdownApp jog
+  where
+    say = IO.hPutStrLn IO.stderr
+    jog config = do
+        say $ "hero"
+        say $ "port: " ++ show (Config.configPort config)
+        run (Config.configPort config) =<< initialize app config
+
+-- | The 'initialize' function accepts the required environment information,
+-- initializes the WAI 'Application' and returns it
+initialize :: (Config.Config -> Application) -> Config.Config -> IO Application
+initialize app cfg = do
+  waiMetrics <- registerWaiMetrics (Config.configMetrics cfg ^. M.metricsStore)
+  let logger = Config.setLogger (Config.configEnv cfg)
+  -- generateJavaScript
+  pure . logger . metrics waiMetrics . app $ cfg
+
+compress :: Middleware
+compress = gzip def { gzipFiles = GzipCompress }
+
+-- | Takes care of cleaning up 'Config.Config' resources
+shutdownApp :: Config.Config -> IO ()
+shutdownApp cfg = do
+  _ <- Katip.closeScribes (Config.configLogEnv cfg)
+    -- Monad.Metrics does not provide a function to destroy metrics store
+    -- so, it'll hopefully get torn down when async exception gets thrown
+    -- at metrics server process
+  killThread (Config.configEkgServer cfg)
+  pure ()