diff options
Diffstat (limited to 'Com/MusicMeetsComics/Server/Logger.hs')
-rw-r--r-- | Com/MusicMeetsComics/Server/Logger.hs | 48 |
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 |