{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, FlexibleInstances, ExistentialQuantification, TypeFamilies, GeneralizedNewtypeDeriving, StandaloneDeriving, MultiParamTypeClasses, UndecidableInstances, FlexibleContexts, Rank2Types, ScopedTypeVariables #-}
module System.Log.Heavy
(
module System.Log.Heavy.Types,
module System.Log.Heavy.Level,
module System.Log.Heavy.LoggingT,
module System.Log.Heavy.Backends,
module System.Log.Heavy.Backends.Dynamic,
logMessage,
withLogging, withLoggingF, withLoggingT,
isLevelEnabledByBackend, isLevelEnabled
) where
import Control.Monad.Trans
import Control.Monad.Trans.Control
import Control.Exception.Lifted (bracket)
import qualified Data.Text.Lazy as TL
import System.Log.Heavy.Types
import System.Log.Heavy.Level
import System.Log.Heavy.Util
import System.Log.Heavy.LoggingT
import System.Log.Heavy.Backends
import System.Log.Heavy.Backends.Dynamic
withLoggingF :: (MonadBaseControl IO m, MonadIO m)
=> LoggingSettings
-> (forall b. IsLogBackend b => b -> m a)
-> m a
withLoggingF :: LoggingSettings -> (forall b. IsLogBackend b => b -> m a) -> m a
withLoggingF (LoggingSettings LogBackendSettings b
settings) forall b. IsLogBackend b => b -> m a
actions = LogBackendSettings b -> (b -> m a) -> m a
forall b (m :: * -> *) a.
(IsLogBackend b, MonadBaseControl IO m, MonadIO m) =>
LogBackendSettings b -> (b -> m a) -> m a
withLoggingB LogBackendSettings b
settings b -> m a
forall b. IsLogBackend b => b -> m a
actions
withLogging :: (MonadBaseControl IO m, MonadIO m, HasLogger m)
=> LoggingSettings
-> m a
-> m a
withLogging :: LoggingSettings -> m a -> m a
withLogging (LoggingSettings LogBackendSettings b
settings) m a
actions =
m b -> (b -> m ()) -> (b -> m a) -> m a
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ LogBackendSettings b -> IO b
forall b. IsLogBackend b => LogBackendSettings b -> IO b
initLogBackend LogBackendSettings b
settings)
(IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (b -> IO ()) -> b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> IO ()
forall b. IsLogBackend b => b -> IO ()
cleanupLogBackend)
(\b
b -> b -> m a -> m a
forall b (m :: * -> *) a.
(IsLogBackend b, HasLogger m) =>
b -> m a -> m a
applyBackend b
b m a
actions)
withLoggingT :: (MonadBaseControl IO m, MonadIO m)
=> LoggingSettings
-> LoggingT m a
-> m a
withLoggingT :: LoggingSettings -> LoggingT m a -> m a
withLoggingT (LoggingSettings LogBackendSettings b
settings) LoggingT m a
actions =
LogBackendSettings b -> (b -> m a) -> m a
forall b (m :: * -> *) a.
(IsLogBackend b, MonadBaseControl IO m, MonadIO m) =>
LogBackendSettings b -> (b -> m a) -> m a
withLoggingB LogBackendSettings b
settings ((b -> m a) -> m a) -> (b -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \b
backend ->
let logger :: LogMessage -> IO ()
logger = Logger b
forall b. IsLogBackend b => Logger b
makeLogger b
backend
in LoggingT m a -> LoggingTState -> m a
forall (m :: * -> *) a. LoggingT m a -> LoggingTState -> m a
runLoggingT LoggingT m a
actions (LoggingTState -> m a) -> LoggingTState -> m a
forall a b. (a -> b) -> a -> b
$ (LogMessage -> IO ())
-> AnyLogBackend -> LogContext -> LoggingTState
LoggingTState LogMessage -> IO ()
logger (b -> AnyLogBackend
forall b. IsLogBackend b => b -> AnyLogBackend
AnyLogBackend b
backend) []
isLevelEnabledByBackend :: forall m. (Monad m, MonadIO m, HasLogBackend AnyLogBackend m) => LogSource -> Level -> m Bool
isLevelEnabledByBackend :: LogSource -> Level -> m Bool
isLevelEnabledByBackend LogSource
src Level
level = do
AnyLogBackend
backend <- m AnyLogBackend
forall b (m :: * -> *). HasLogBackend b m => m b
getLogBackend :: m AnyLogBackend
let msg :: LogMessage
msg = Level -> LogSource -> Loc -> Text -> () -> LogContext -> LogMessage
forall vars.
ClosedVarContainer vars =>
Level
-> LogSource -> Loc -> Text -> vars -> LogContext -> LogMessage
LogMessage Level
level LogSource
src Loc
forall a. HasCallStack => a
undefined Text
TL.empty () []
IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ AnyLogBackend -> LogMessage -> IO Bool
forall b. IsLogBackend b => b -> LogMessage -> IO Bool
wouldWriteMessage AnyLogBackend
backend LogMessage
msg
isLevelEnabled :: forall m. (Monad m, MonadIO m, HasLogBackend AnyLogBackend m, HasLogContext m) => LogSource -> Level -> m Bool
isLevelEnabled :: LogSource -> Level -> m Bool
isLevelEnabled LogSource
src Level
level = do
let msg :: LogMessage
msg = Level -> LogSource -> Loc -> Text -> () -> LogContext -> LogMessage
forall vars.
ClosedVarContainer vars =>
Level
-> LogSource -> Loc -> Text -> vars -> LogContext -> LogMessage
LogMessage Level
level LogSource
src Loc
forall a. HasCallStack => a
undefined Text
TL.empty () []
AnyLogBackend
backend <- m AnyLogBackend
forall b (m :: * -> *). HasLogBackend b m => m b
getLogBackend :: m AnyLogBackend
Bool
isEnabledByBackend <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ AnyLogBackend -> LogMessage -> IO Bool
forall b. IsLogBackend b => b -> LogMessage -> IO Bool
wouldWriteMessage AnyLogBackend
backend LogMessage
msg
Bool
isEnabledByContext <- LogMessage -> m Bool
forall (m :: * -> *). HasLogContext m => LogMessage -> m Bool
checkContextFilterM LogMessage
msg
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool
isEnabledByContext Bool -> Bool -> Bool
&& Bool
isEnabledByBackend