summaryrefslogtreecommitdiff
path: root/Com/MusicMeetsComics
diff options
context:
space:
mode:
Diffstat (limited to 'Com/MusicMeetsComics')
-rw-r--r--Com/MusicMeetsComics/Server/Config.hs6
-rw-r--r--Com/MusicMeetsComics/Server/Logger.hs67
2 files changed, 38 insertions, 35 deletions
diff --git a/Com/MusicMeetsComics/Server/Config.hs b/Com/MusicMeetsComics/Server/Config.hs
index 2bbfabc..ac634a2 100644
--- a/Com/MusicMeetsComics/Server/Config.hs
+++ b/Com/MusicMeetsComics/Server/Config.hs
@@ -22,7 +22,7 @@ import Network.Wai.Handler.Warp (Port)
import Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev)
import Protolude
import Safe (readMay)
-import Servant (ServantErr)
+import Servant (ServerError)
import System.Environment (lookupEnv)
import System.Remote.Monitoring (forkServer, serverMetricStore, serverThreadId)
@@ -34,12 +34,12 @@ import System.Remote.Monitoring (forkServer, serverMetricStore, server
-- 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 ServantErr m) a
+ { runApp :: ReaderT Config (ExceptT ServerError m) a
} deriving ( Functor
, Applicative
, Monad
, MonadReader Config
- , MonadError ServantErr
+ , MonadError ServerError
, MonadIO
)
diff --git a/Com/MusicMeetsComics/Server/Logger.hs b/Com/MusicMeetsComics/Server/Logger.hs
index eb37ef6..5091b23 100644
--- a/Com/MusicMeetsComics/Server/Logger.hs
+++ b/Com/MusicMeetsComics/Server/Logger.hs
@@ -3,46 +3,49 @@
module Com.MusicMeetsComics.Server.Logger
( adapt
, defaultLogEnv
- , logMsg
- , runKatipT
- , KatipT(..)
- , Katip(..)
- , LogEnv
- , Severity(..)
- ) where
+ , Katip.logMsg
+ , Katip.runKatipT
+ , Katip.KatipT(..)
+ , Katip.Katip(..)
+ , Katip.LogEnv
+ , Katip.Severity(..)
+ )
+where
-import Control.Monad.Logger
-import qualified Control.Monad.Logger as Logger
-import Katip
+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
+import qualified System.IO as IO
+import qualified System.Log.FastLogger as FastLogger
-defaultLogEnv :: IO LogEnv
+defaultLogEnv :: IO Katip.LogEnv
defaultLogEnv = do
- handleScribe <- mkHandleScribe ColorIfTerminal IO.stdout DebugS V2
- env <- initLogEnv "hero" "production"
- registerScribe "stdout" handleScribe defaultScribeSettings env
+ 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 :: LogLevel -> Severity
-fromLevel LevelDebug = DebugS
-fromLevel LevelInfo = InfoS
-fromLevel LevelWarn = WarningS
-fromLevel LevelError = ErrorS
-fromLevel (LevelOther _) = NoticeS
+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 ::
- (ToLogStr msg, Applicative m, Katip m)
- => (Namespace -> Severity -> Katip.LogStr -> m ())
- -> Loc
- -> LogSource
- -> LogLevel
+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 = Namespace [src]
- -- not sure how fast this is going to be
- logStr' = Katip.logStr . FastLogger.fromLogStr . Logger.toLogStr
+ where
+ ns = Katip.Namespace [src]
+ -- not sure how fast this is going to be
+ logStr' = Katip.logStr . FastLogger.fromLogStr . Logger.toLogStr