Copyright | Copyright (c) 2014-2015 PivotCloud, Inc. |
---|---|
License | Apache License, Version 2.0 |
Maintainer | Lars Kuhtz <lkuhtz@pivotmail.com> |
Stability | experimental |
Safe Haskell | None |
Language | Haskell2010 |
- data LogLevel
- logLevelText :: IsString a => LogLevel -> a
- readLogLevel :: (MonadError e m, Eq a, Show a, FoldCase a, IsString a, IsString e, Monoid e) => a -> m LogLevel
- pLogLevel :: Parser LogLevel
- data LogPolicy
- logPolicyText :: IsString s => LogPolicy -> s
- readLogPolicy :: (MonadError e m, Eq a, Show a, FoldCase a, IsText a, IsString e, Monoid e) => a -> m LogPolicy
- pLogPolicy :: Parser LogPolicy
- type LogLabel = (Text, Text)
- type LogScope = [LogLabel]
- data LogMessage a = LogMessage {
- _logMsg :: !a
- _logMsgLevel :: !LogLevel
- _logMsgScope :: !LogScope
- logMsg :: Lens' (LogMessage a) a
- logMsgLevel :: Lens' (LogMessage a) LogLevel
- logMsgScope :: Lens' (LogMessage a) LogScope
- type LoggerBackend a = Either (LogMessage Text) (LogMessage a) -> IO ()
- type LogFunction a m = LogLevel -> a -> m ()
- type LogFunctionIO a = LogLevel -> a -> IO ()
- class LoggerCtx ctx msg | ctx -> msg where
- loggerFunIO :: (Show msg, Typeable msg, NFData msg) => ctx -> LogFunctionIO msg
- setLoggerLevel :: Setter' ctx LogLevel
- setLoggerScope :: Setter' ctx LogScope
- setLoggerPolicy :: Setter' ctx LogPolicy
- withLoggerLevel :: LogLevel -> ctx -> (ctx -> α) -> α
- withLoggerLabel :: LogLabel -> ctx -> (ctx -> α) -> α
- withLoggerPolicy :: LogPolicy -> ctx -> (ctx -> α) -> α
- data LoggerCtxT ctx m α
- runLoggerCtxT :: LoggerCtxT ctx m α -> ctx -> m α
- class Monad m => MonadLog a m | m -> a where
- logg :: LogFunction a m
- withLevel :: LogLevel -> m α -> m α
- withPolicy :: LogPolicy -> m α -> m α
- localScope :: (LogScope -> LogScope) -> m α -> m α
- withLabel :: MonadLog a m => LogLabel -> m α -> m α
- clearScope :: MonadLog a m => m α -> m α
- popLabel :: MonadLog a m => m α -> m α
- class MonadLog a m => MonadLogIO a m where
- logFunIO :: m (LogFunctionIO a)
LogLevel
logLevelText :: IsString a => LogLevel -> a Source
readLogLevel :: (MonadError e m, Eq a, Show a, FoldCase a, IsString a, IsString e, Monoid e) => a -> m LogLevel Source
LogPolicy
Policy that determines how the case of a congested logging pipeline is addressed.
logPolicyText :: IsString s => LogPolicy -> s Source
readLogPolicy :: (MonadError e m, Eq a, Show a, FoldCase a, IsText a, IsString e, Monoid e) => a -> m LogPolicy Source
LogLabel
Logger Backend
data LogMessage a Source
The Internal log message type.
The type parameter a
is expected to provide intances
of Show
, Typeable
, and NFData
.
If we need to support different backends, we may consider including the backend here...
LogMessage | |
|
Eq a => Eq (LogMessage a) | |
Ord a => Ord (LogMessage a) | |
Read a => Read (LogMessage a) | |
Show a => Show (LogMessage a) | |
Generic (LogMessage a) | |
NFData a => NFData (LogMessage a) | |
Typeable (* -> *) LogMessage | |
type Rep (LogMessage a) |
logMsg :: Lens' (LogMessage a) a Source
logMsgLevel :: Lens' (LogMessage a) LogLevel Source
logMsgScope :: Lens' (LogMessage a) LogScope Source
type LoggerBackend a = Either (LogMessage Text) (LogMessage a) -> IO () Source
This is given to logger when it is created. It formats and delivers individual log messages synchronously.
The type parameter a
is expected to provide instances for Show
Typeable
, and NFData
.
The Left
values of the argument allows the generation of log messages
that are independent of the parameter a
. The motivation for this is
reporting issues in Logging system itself, like a full logger queue
or providing statistics about the fill level of the queue. There may
be other uses of this, too.
TODO there may be scenarios where chunked processing is beneficial. While this can be done in a closure of this function a more direct support might be desirable.
Logger Frontend
type LogFunction a m = LogLevel -> a -> m () Source
type LogFunctionIO a = LogLevel -> a -> IO () Source
This function is provided by the logger.
LoggerCtx
class LoggerCtx ctx msg | ctx -> msg where Source
Abstraction of a logger context that can be used without dependening on a specific monadic context.
The loggerFunIO
incorporates a LoggerBackend
. An instance of a LoggerCtx
is free to use a hard coded LoggerBackend
or to be usable with different
LoggerBackend
functions. The latter is recommended but not required.
You don't have to provide an instance of this for your logger. Instead you
may just provide an instance of MonadLog
directly.
If this doesn't fit your needs you may use a newtype wrapper and define your own instances.
loggerFunIO :: (Show msg, Typeable msg, NFData msg) => ctx -> LogFunctionIO msg Source
setLoggerLevel :: Setter' ctx LogLevel Source
setLoggerScope :: Setter' ctx LogScope Source
setLoggerPolicy :: Setter' ctx LogPolicy Source
withLoggerLevel :: LogLevel -> ctx -> (ctx -> α) -> α Source
withLoggerLabel :: LogLabel -> ctx -> (ctx -> α) -> α Source
withLoggerPolicy :: LogPolicy -> ctx -> (ctx -> α) -> α Source
data LoggerCtxT ctx m α Source
MonadState a m => MonadState a (LoggerCtxT ctx m) | |
Monad m => MonadReader ctx (LoggerCtxT ctx m) | |
MonadWriter a m => MonadWriter a (LoggerCtxT ctx m) | |
MonadError a m => MonadError a (LoggerCtxT ctx m) | |
MonadBase a m => MonadBase a (LoggerCtxT ctx m) | |
MonadBaseControl b m => MonadBaseControl b (LoggerCtxT ctx m) | |
(Monad m, MonadTrace t m) => MonadTrace t (LoggerCtxT ctx m) | |
(Show a, Typeable * a, NFData a, MonadIO m, LoggerCtx ctx a) => MonadLogIO a (LoggerCtxT ctx m) | |
(Show a, Typeable * a, NFData a, MonadIO m, LoggerCtx ctx a) => MonadLog a (LoggerCtxT ctx m) | |
MonadTrans (LoggerCtxT ctx) | |
MonadTransControl (LoggerCtxT ctx) | |
Monad m => Monad (LoggerCtxT ctx m) | |
Functor m => Functor (LoggerCtxT ctx m) | |
Applicative m => Applicative (LoggerCtxT ctx m) | |
MonadIO m => MonadIO (LoggerCtxT ctx m) | |
type StT (LoggerCtxT ctx) a = StT (ReaderT ctx) a | |
type StM (LoggerCtxT ctx m) a = ComposeSt (LoggerCtxT ctx) m a |
runLoggerCtxT :: LoggerCtxT ctx m α -> ctx -> m α Source
MonadLog
class Monad m => MonadLog a m | m -> a where Source
logg :: LogFunction a m Source
withLevel :: LogLevel -> m α -> m α Source
withPolicy :: LogPolicy -> m α -> m α Source
localScope :: (LogScope -> LogScope) -> m α -> m α Source
MonadLog a m => MonadLog a (EitherT σ m) | |
MonadLog a m => MonadLog a (StateT σ m) | |
MonadLog a m => MonadLog a (ExceptT ε m) | |
(Monoid σ, MonadLog a m) => MonadLog a (WriterT σ m) | |
(Show a, Typeable * a, NFData a, MonadIO m, LoggerCtx ctx a) => MonadLog a (LoggerCtxT ctx m) | |
MonadLog a m => MonadLog a (TraceT t e m) |
clearScope :: MonadLog a m => m α -> m α Source
class MonadLog a m => MonadLogIO a m where Source
Instances of MonadLog
that allow to obtain a LogFunctionIO
as plain
value. This is helpful when dealing with frameworks that take a logging
function in IO
as parameter.
An instance of this class should apply the LogLevel
, LogScope
, and
LogPolicy
at the time when logFunIO
is called and not when the returned
action is excecuted. If the returned action is excecuted after the logger
got released or otherwise invalidated the behavior should match the behavior
on a congested logging pipeling accorrding to the log-policy that was in
scope when logFunIO
was called.
Even though it can be very convenient, instances of this class must be used
with care. The action may contain in its closure a reference to some
internal state of the MonadLog
instance. Beside of being a source of
potential memory leaks, there also is nothing that prevents a programer to
call this action outside of the valid scope of the MonadLog
instance. In
case that the context of the MonadLog
instance depends on some state that
gets explicitely deallocated this action may have unexectped behavior.
logFunIO :: m (LogFunctionIO a) Source
MonadLogIO a m => MonadLogIO a (EitherT σ m) | |
MonadLogIO a m => MonadLogIO a (StateT σ m) | |
MonadLogIO a m => MonadLogIO a (ExceptT ε m) | |
(Monoid σ, MonadLogIO a m) => MonadLogIO a (WriterT σ m) | |
(MonadLog a (ReaderT σ m), MonadLogIO a m) => MonadLogIO a (ReaderT σ m) | |
(Show a, Typeable * a, NFData a, MonadIO m, LoggerCtx ctx a) => MonadLogIO a (LoggerCtxT ctx m) | |
MonadLogIO a m => MonadLogIO a (TraceT t e m) |