{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Imm.Logger.Simple (module Imm.Logger.Simple, module Reexport) where
import Imm.Logger as Reexport
import Imm.Prelude
import Imm.Pretty
import Control.Concurrent.MVar.Lifted
import Control.Monad.Trans.Reader
import Data.Text.Prettyprint.Doc.Render.Terminal
import System.Log.FastLogger as Reexport
data LoggerSettings = LoggerSettings
{ _loggerSet :: LoggerSet
, _errorLoggerSet :: LoggerSet
, _logLevel :: LogLevel
, _colorizeLogs :: Bool
}
defaultLogger :: IO (MVar LoggerSettings)
defaultLogger = newMVar =<< LoggerSettings
<$> newStdoutLoggerSet defaultBufSize
<*> newStderrLoggerSet defaultBufSize
<*> pure Info
<*> pure True
instance MonadLog (ReaderT (MVar LoggerSettings) IO) where
log l t = do
settings <- readMVar =<< ask
let loggerSet = (if l == Error then _errorLoggerSet else _loggerSet) settings
handleColor = (\c -> if c then id else unAnnotate) $ _colorizeLogs settings
refLevel = _logLevel settings
when (l >= refLevel) $ lift $ pushLogStrLn loggerSet $ toLogStr $ renderLazy $ layoutPretty defaultLayoutOptions $ handleColor t
getLogLevel = _logLevel <$> (readMVar =<< ask)
setLogLevel level = do
mvar <- ask
modifyMVar_ mvar $ \settings -> return (settings { _logLevel = level })
setColorizeLogs value = do
mvar <- ask
modifyMVar_ mvar $ \settings -> return (settings { _colorizeLogs = value })
flushLogs = do
settings <- readMVar =<< ask
lift $ flushLogStr $ _loggerSet settings
lift $ flushLogStr $ _errorLoggerSet settings