Replace Config/Init/Logger with envy and simpler code

Idk what I was thinking, I dodn't need any of that stuff.

5 files changed, 41 insertions, 268 deletions

diff --git a/Com/MusicMeetsComics/Server.hs b/Com/MusicMeetsComics/Server.hs
index 5736688..a1a9981 100644
--- a/Com/MusicMeetsComics/Server.hs
+++ b/Com/MusicMeetsComics/Server.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses      #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -16,26 +17,21 @@
 -- : dep aeson
 -- : dep clay
 -- : dep containers
--- : dep miso
--- : dep protolude
--- : dep servant
--- : dep split
--- : dep string-quote
--- : dep text
 -- : dep dhall
--- : dep ekg
--- : dep fast-logger
+-- : dep envy
 -- : dep http-types
--- : dep katip
 -- : dep lucid
--- : dep monad-logger
--- : dep monad-metrics
+-- : dep miso
 -- : dep mtl
 -- : dep network-uri
--- : dep safe
+-- : dep protolude
+-- : dep servant
 -- : dep servant-lucid
 -- : dep servant-server
 -- : dep split
+-- : dep split
+-- : dep string-quote
+-- : dep text
 -- : dep wai
 -- : dep wai-app-static
 -- : dep wai-extra
@@ -47,10 +43,6 @@ import qualified Clay
 import           Com.MusicMeetsComics.App
 import qualified Com.MusicMeetsComics.Assets   as Assets
 import qualified Com.MusicMeetsComics.Database as Database
-import qualified Com.MusicMeetsComics.Server.Config
-                                               as Config
-import qualified Com.MusicMeetsComics.Server.Init
-                                               as Init
 import qualified Com.MusicMeetsComics.Look     as Look
 import qualified Com.MusicMeetsComics.Look.Typography
                                                as Typography
@@ -70,16 +62,41 @@ import           Network.HTTP.Media             ( (//)
 import           Network.HTTP.Types      hiding ( Header )
 import           Network.Wai
 import           Network.Wai.Application.Static
+import qualified Network.Wai.Handler.Warp      as Warp
 import           Protolude
 import           Servant
+import qualified System.Envy                   as Envy
+import qualified System.Exit                   as Exit
+import qualified System.IO                     as IO
 
 
 main :: IO ()
-main = do
-  db <- Database.dummy
-  Init.runApp (app db)
-
-app :: Database.ComicDB -> Config.Config -> Application
+main = bracket startup shutdown run
+ where
+  say     = IO.hPutStrLn IO.stderr
+  startup = Envy.decodeEnv >>= \case
+    Left  e -> Exit.die e
+    Right c -> do
+      db <- Database.dummy
+      say $ "hero"
+      say $ "port: " ++ (show $ heroPort c)
+      say $ "client: " ++ heroClient c
+      return (db, c)
+  shutdown :: a -> IO a
+  shutdown = pure . identity
+  run (db, config) = Warp.run (heroPort config) (app db config)
+
+data Config = Config
+  { heroPort :: Warp.Port -- ^ HERO_PORT
+  , heroClient :: FilePath -- ^ HERO_CLIENT
+  } deriving (Generic, Show)
+
+instance Envy.DefConfig Config where
+  defConfig = Config 3000 "_bild/Com.MusicMeetsComics.Client/static"
+
+instance Envy.FromEnv Config
+
+app :: Database.ComicDB -> Config -> Application
 app db cfg = serve
   (Proxy @AllRoutes)
   (    static
@@ -89,8 +106,7 @@ app db cfg = serve
   :<|> pure heroManifest
   :<|> Tagged handle404
   )
- where
-  static = serveDirectoryWith $ defaultWebAppSettings $ Config.configClient cfg
+  where static = serveDirectoryWith $ defaultWebAppSettings $ heroClient cfg
 
 
 -- | HtmlPage for setting HTML doctype and header
diff --git a/Com/MusicMeetsComics/Server/Config.hs b/Com/MusicMeetsComics/Server/Config.hs
deleted file mode 100644
index 0de3379..0000000
--- a/Com/MusicMeetsComics/Server/Config.hs
+++ /dev/null
@@ -1,143 +0,0 @@
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-
-module Com.MusicMeetsComics.Server.Config where
-
-import           Com.MusicMeetsComics.Server.Logger
-import           Control.Concurrent             ( ThreadId )
-import           Control.Monad.Except           ( ExceptT
-                                                , MonadError
-                                                )
-import           Control.Monad.IO.Class
-import           Control.Monad.Logger           ( MonadLogger(..) )
-import           Control.Monad.Metrics          ( Metrics
-                                                , MonadMetrics
-                                                , getMetrics
-                                                )
-import qualified Control.Monad.Metrics         as M
-import           Control.Monad.Reader           ( MonadIO
-                                                , MonadReader
-                                                , ReaderT
-                                                , asks
-                                                )
-import           Data.Text                      ( pack )
-import           GHC.Base                       ( String )
-import           Network.Wai                    ( Middleware )
-import           Network.Wai.Handler.Warp       ( Port )
-import           Network.Wai.Middleware.RequestLogger
-                                                ( logStdout
-                                                , logStdoutDev
-                                                )
-import           Protolude
-import           Safe                           ( readMay )
-import           Servant                        ( ServerError )
-import           System.Environment             ( lookupEnv )
-import           System.Remote.Monitoring       ( forkServer
-                                                , serverMetricStore
-                                                , serverThreadId
-                                                )
-
--- | This type represents the effects we want to have for our application.
--- We wrap the standard Servant monad with 'ReaderT Config', which gives us
--- access to the application configuration using the 'MonadReader'
--- interface's 'ask' function.
---
--- By encapsulating the effects in our newtype, we can add layers to the
--- monad stack without having to modify code that uses the current layout.
-newtype AppT m a = AppT
-  { runApp :: ReaderT Config (ExceptT ServerError m) a
-  }
-  deriving (Functor, Applicative, Monad, MonadReader Config, MonadError
-    ServerError, MonadIO)
-
-type App = AppT IO
-
--- | The Config for our application is (for now) the 'Environment' we're
--- running in and a Persistent 'ConnectionPool'.
-data Config = Config
-  { configEnv :: Environment
-  , configMetrics :: Metrics
-  , configEkgServer :: ThreadId
-  , configLogEnv :: LogEnv
-  , configPort :: Port
-  , configClient :: FilePath
-  }
-
-instance Monad m => MonadMetrics (AppT m) where
-  getMetrics = asks configMetrics
-
--- | Katip instance for @AppT m@
-instance MonadIO m => Katip (AppT m) where
-  getLogEnv   = asks configLogEnv
-  localLogEnv = panic "not implemented"
-
--- | MonadLogger instance to use within @AppT m@
-instance MonadIO m => MonadLogger (AppT m) where
-  monadLoggerLog = adapt logMsg
-
--- | MonadLogger instance to use in @makePool@
-instance MonadIO m => MonadLogger (KatipT m) where
-  monadLoggerLog = adapt logMsg
-
--- | Right now, we're distinguishing between three environments. We could
--- also add a @Staging@ environment if we needed to.
-data Environment
-  = Development
-  | Test
-  | Production
-  deriving (Eq, Show, Read)
-
--- | This returns a 'Middleware' based on the environment that we're in.
-setLogger :: Environment -> Middleware
-setLogger Test        = identity
-setLogger Development = logStdoutDev
-setLogger Production  = logStdout
-
--- | Web request logger (currently unimplemented and unused). For inspiration
--- see ApacheLogger from wai-logger package.
-katipLogger :: LogEnv -> Middleware
-katipLogger env app req respond = runKatipT env $ do
-  logMsg "web" InfoS "todo: received some request"
-  -- todo: log proper request data
-  liftIO $ app req respond
-
--- | The number of pools to use for a given environment.
-envPool :: Environment -> Int
-envPool Test        = 1
-envPool Development = 1
-envPool Production  = 8
-
--- | Allocates resources for 'Config'
-acquire :: IO Config
-acquire = do
-  port      <- lookupSetting "PORT" 3001
-  clientDir <- lookupSetting "CLIENT_DIR"
-                             "_bild/Com.MusicMeetsComics.Client/static"
-  env       <- lookupSetting "ENV" Development
-  logEnv    <- defaultLogEnv
-  ekgServer <- forkServer "localhost" 8000
-  let store = serverMetricStore ekgServer
-  metr <- M.initializeWith store
-  pure Config { configEnv       = env
-              , configMetrics   = metr
-              , configLogEnv    = logEnv
-              , configPort      = port
-              , configEkgServer = serverThreadId ekgServer
-              , configClient    = clientDir
-              }
-
--- | Looks up a setting in the environment, with a provided default, and
--- 'read's that information into the inferred type.
-lookupSetting :: Read a => String -> a -> IO a
-lookupSetting env def_ = do
-  maybeValue <- lookupEnv env
-  case maybeValue of
-    Nothing  -> return def_
-    Just str -> maybe (handleFailedRead str) return (readMay str)
- where
-  handleFailedRead str = panic $ mconcat
-    ["Failed to read [[", pack str, "]] for environment variable ", pack env]
diff --git a/Com/MusicMeetsComics/Server/Init.hs b/Com/MusicMeetsComics/Server/Init.hs
deleted file mode 100644
index 04ddc88..0000000
--- a/Com/MusicMeetsComics/Server/Init.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-{-# 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 shutdown 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
-shutdown :: Config.Config -> IO ()
-shutdown 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 ()
diff --git a/Com/MusicMeetsComics/Server/Logger.hs b/Com/MusicMeetsComics/Server/Logger.hs
deleted file mode 100644
index 5091b23..0000000
--- a/Com/MusicMeetsComics/Server/Logger.hs
+++ /dev/null
@@ -1,51 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-module Com.MusicMeetsComics.Server.Logger
-  ( adapt
-  , defaultLogEnv
-  , Katip.logMsg
-  , Katip.runKatipT
-  , Katip.KatipT(..)
-  , Katip.Katip(..)
-  , Katip.LogEnv
-  , Katip.Severity(..)
-  )
-where
-
-import qualified Control.Monad.Logger          as Logger
-import qualified Katip
-import           Protolude
-import qualified System.IO                     as IO
-import qualified System.Log.FastLogger         as FastLogger
-
-defaultLogEnv :: IO Katip.LogEnv
-defaultLogEnv = do
-  handleScribe <- Katip.mkHandleScribe Katip.ColorIfTerminal
-                                       IO.stdout
-                                       (Katip.permitItem Katip.DebugS)
-                                       Katip.V2
-  env <- Katip.initLogEnv "hero" "production"
-  Katip.registerScribe "stdout" handleScribe Katip.defaultScribeSettings env
-
-fromLevel :: Logger.LogLevel -> Katip.Severity
-fromLevel Logger.LevelDebug     = Katip.DebugS
-fromLevel Logger.LevelInfo      = Katip.InfoS
-fromLevel Logger.LevelWarn      = Katip.WarningS
-fromLevel Logger.LevelError     = Katip.ErrorS
-fromLevel (Logger.LevelOther _) = Katip.NoticeS
-
--- | Transforms Katip logMsg into monadLoggerLog to be used inside
--- MonadLogger monad
-adapt
-  :: (FastLogger.ToLogStr msg, Applicative m, Katip.Katip m)
-  => (Katip.Namespace -> Katip.Severity -> Katip.LogStr -> m ())
-  -> Logger.Loc
-  -> Logger.LogSource
-  -> Logger.LogLevel
-  -> msg
-  -> m ()
-adapt f _ src lvl msg = f ns (fromLevel lvl) $ logStr' msg
- where
-  ns      = Katip.Namespace [src]
-  -- not sure how fast this is going to be
-  logStr' = Katip.logStr . FastLogger.fromLogStr . Logger.toLogStr
diff --git a/Com/MusicMeetsComics/Service.nix b/Com/MusicMeetsComics/Service.nix
index 9b8d91d..f0f4227 100644
--- a/Com/MusicMeetsComics/Service.nix
+++ b/Com/MusicMeetsComics/Service.nix
@@ -48,8 +48,8 @@ in
       serviceConfig = {
         KillSignal = "INT";
         Environment = [
-          "CLIENT_DIR=${cfg.client}/static"
-          "PORT=${toString cfg.port}"
+          "HERO_CLIENT=${cfg.client}/static"
+          "HERO_PORT=${toString cfg.port}"
         ];
         Type = "simple";
         Restart = "on-abort";