{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
--------------------------------------------------------------------------------
-- |
-- Module : Database.EventStore.Internal.Logger
-- Copyright : (C) 2017 Yorick Laupa
-- License : (see the file LICENSE)
--
-- Maintainer : Yorick Laupa <yo.eight@gmail.com>
-- Stability : provisional
-- Portability : non-portable
--
--------------------------------------------------------------------------------
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 -> LogSource -> LogLevel -> Bool
toLogPredicate (LoggerFilter LogSource -> LogLevel -> Bool
k)  = LogSource -> LogLevel -> Bool
k
toLogPredicate (LoggerLevel LogLevel
lvl) = \LogSource
_ LogLevel
t -> LogLevel
t forall a. Ord a => a -> a -> Bool
>= LogLevel
lvl

--------------------------------------------------------------------------------
data LoggerRef
  = LoggerRef !TimedFastLogger !LoggerFilter !Bool !(IO ())
  | NoLogger

--------------------------------------------------------------------------------
loggerCallback :: LoggerRef -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
loggerCallback :: LoggerRef -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
loggerCallback LoggerRef
NoLogger = \Loc
_ LogSource
_ LogLevel
_ LogStr
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
loggerCallback (LoggerRef TimedFastLogger
logger LoggerFilter
filt Bool
detailed IO ()
_) = \Loc
loc LogSource
src LogLevel
lvl LogStr
msg ->
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LogSource -> LogLevel -> Bool
predicate LogSource
src LogLevel
lvl) forall a b. (a -> b) -> a -> b
$
    TimedFastLogger -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
loggerFormat TimedFastLogger
logger (if Bool
detailed then Loc
loc else Loc
defaultLoc) LogSource
src LogLevel
lvl LogStr
msg
  where
    predicate :: LogSource -> LogLevel -> Bool
predicate = LoggerFilter -> LogSource -> LogLevel -> Bool
toLogPredicate LoggerFilter
filt

--------------------------------------------------------------------------------
loggerFormat :: TimedFastLogger
             -> (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
loggerFormat :: TimedFastLogger -> Loc -> LogSource -> LogLevel -> LogStr -> IO ()
loggerFormat TimedFastLogger
logger = \Loc
loc LogSource
src LogLevel
lvl LogStr
msg ->
  TimedFastLogger
logger forall a b. (a -> b) -> a -> b
$ \FormattedTime
t ->
    forall msg. ToLogStr msg => msg -> LogStr
toLogStr (FormattedTime
"["forall a. Monoid a => a -> a -> a
`mappend` FormattedTime
t forall a. Monoid a => a -> a -> a
`mappend`FormattedTime
"]") forall a. Monoid a => a -> a -> a
`mappend` LogStr
" eventstore "
                                           forall a. Monoid a => a -> a -> a
`mappend` Loc -> LogSource -> LogLevel -> LogStr -> LogStr
defaultLogStr Loc
loc LogSource
src LogLevel
lvl LogStr
msg

--------------------------------------------------------------------------------
newLoggerRef :: LogType -> LoggerFilter -> Bool -> IO LoggerRef
newLoggerRef :: LogType -> LoggerFilter -> Bool -> IO LoggerRef
newLoggerRef LogType
LogNone LoggerFilter
_ Bool
_ = forall (m :: * -> *) a. Monad m => a -> m a
return LoggerRef
NoLogger
newLoggerRef LogType
typ LoggerFilter
filt Bool
detailed =
  case LogType
typ of
    LogType
LogNone -> forall (m :: * -> *) a. Monad m => a -> m a
return LoggerRef
NoLogger
    LogType
other   -> do
      IO FormattedTime
cache             <- FormattedTime -> IO (IO FormattedTime)
newTimeCache FormattedTime
simpleTimeFormat
      (TimedFastLogger
logger, IO ()
cleanup) <- IO FormattedTime -> LogType -> IO (TimedFastLogger, IO ())
newTimedFastLogger IO FormattedTime
cache LogType
other
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TimedFastLogger -> LoggerFilter -> Bool -> IO () -> LoggerRef
LoggerRef TimedFastLogger
logger LoggerFilter
filt Bool
detailed IO ()
cleanup