{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Database.EventStore.Internal.Logger
( LoggerRef
, LoggerFilter(..)
, newLoggerRef
, loggerCallback
, module Control.Monad.Logger
, module Data.String.Interpolate.IsString
, module System.Log.FastLogger
) where
import Control.Monad.Logger
import Data.String.Interpolate.IsString
import System.Log.FastLogger hiding (check)
import Database.EventStore.Internal.Prelude
data LoggerFilter
= LoggerFilter (LogSource -> LogLevel -> Bool)
| LoggerLevel LogLevel
toLogPredicate :: LoggerFilter -> (LogSource -> LogLevel -> Bool)
toLogPredicate (LoggerFilter k) = k
toLogPredicate (LoggerLevel lvl) = \_ t -> t >= lvl
data LoggerRef
= LoggerRef !TimedFastLogger !LoggerFilter !Bool !(IO ())
| NoLogger
loggerCallback :: LoggerRef -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
loggerCallback NoLogger = \_ _ _ _ -> return ()
loggerCallback (LoggerRef logger filt detailed _) = \loc src lvl msg ->
when (predicate src lvl) $
loggerFormat logger (if detailed then loc else defaultLoc) src lvl msg
where
predicate = toLogPredicate filt
loggerFormat :: TimedFastLogger
-> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
loggerFormat logger = \loc src lvl msg ->
logger $ \t ->
toLogStr ("["`mappend` t `mappend`"]") `mappend` " eventstore "
`mappend` defaultLogStr loc src lvl msg
newLoggerRef :: LogType -> LoggerFilter -> Bool -> IO LoggerRef
newLoggerRef LogNone _ _ = return NoLogger
newLoggerRef typ filt detailed =
case typ of
LogNone -> return NoLogger
other -> do
cache <- newTimeCache simpleTimeFormat
(logger, cleanup) <- newTimedFastLogger cache other
return $ LoggerRef logger filt detailed cleanup