summaryrefslogtreecommitdiff
path: root/Com/MusicMeetsComics/Server/Logger.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Com/MusicMeetsComics/Server/Logger.hs')
-rw-r--r--Com/MusicMeetsComics/Server/Logger.hs48
1 files changed, 48 insertions, 0 deletions
diff --git a/Com/MusicMeetsComics/Server/Logger.hs b/Com/MusicMeetsComics/Server/Logger.hs
new file mode 100644
index 0000000..eb37ef6
--- /dev/null
+++ b/Com/MusicMeetsComics/Server/Logger.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Com.MusicMeetsComics.Server.Logger
+ ( adapt
+ , defaultLogEnv
+ , logMsg
+ , runKatipT
+ , KatipT(..)
+ , Katip(..)
+ , LogEnv
+ , Severity(..)
+ ) where
+
+import Control.Monad.Logger
+import qualified Control.Monad.Logger as Logger
+import Katip
+import Protolude
+import qualified System.IO as IO
+import qualified System.Log.FastLogger as FastLogger
+
+defaultLogEnv :: IO LogEnv
+defaultLogEnv = do
+ handleScribe <- mkHandleScribe ColorIfTerminal IO.stdout DebugS V2
+ env <- initLogEnv "hero" "production"
+ registerScribe "stdout" handleScribe defaultScribeSettings env
+
+fromLevel :: LogLevel -> Severity
+fromLevel LevelDebug = DebugS
+fromLevel LevelInfo = InfoS
+fromLevel LevelWarn = WarningS
+fromLevel LevelError = ErrorS
+fromLevel (LevelOther _) = 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
+ -> 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