Safe Haskell | None |
---|---|
Language | Haskell2010 |
Provides support for treating payloads and namespaces as
composable contexts. The common pattern would be to provide a
KatipContext
instance for your base monad.
- logFM :: (Applicative m, KatipContext m) => Severity -> LogStr -> m ()
- logTM :: ExpQ
- logLocM :: (Applicative m, KatipContext m) => Severity -> LogStr -> m ()
- logItemM :: (Applicative m, KatipContext m) => Maybe Loc -> Severity -> LogStr -> m ()
- logExceptionM :: (KatipContext m, MonadCatch m, Applicative m) => m a -> Severity -> m a
- class Katip m => KatipContext m where
- data AnyLogContext
- data LogContexts
- liftPayload :: LogItem a => a -> LogContexts
- newtype KatipContextT m a = KatipContextT {}
- runKatipContextT :: LogItem c => LogEnv -> c -> Namespace -> KatipContextT m a -> m a
- katipAddNamespace :: Monad m => Namespace -> KatipContextT m a -> KatipContextT m a
- katipAddContext :: (LogItem i, Monad m) => i -> KatipContextT m a -> KatipContextT m a
- katipNoLogging :: Monad m => KatipContextT m a -> KatipContextT m a
- data KatipContextTState = KatipContextTState {
- ltsLogEnv :: !LogEnv
- ltsContext :: !LogContexts
- ltsNamespace :: !Namespace
Monadic variants of logging functions from Katip.Core
:: (Applicative m, KatipContext m) | |
=> Severity | Severity of the message |
-> LogStr | The log message |
-> m () |
Log with full context, but without any code location. Automatically supplies payload and namespace.
Loc
-tagged logging when using template-haskell. Automatically
supplies payload and namespace.
$(logTM) InfoS "Hello world"
logLocM :: (Applicative m, KatipContext m) => Severity -> LogStr -> m () Source
Loc
-tagged logging when using template-haskell. Automatically
supplies payload and namespace.
Same consideration as logLoc
applies.
This function does not require template-haskell as it
automatically uses implicit-callstacks
when the code is compiled using GHC > 7.8. Using an older version of the
compiler will result in the emission of a log line without any location information,
so be aware of it. Users using GHC <= 7.8 may want to use the template-haskell function
logTM
for maximum compatibility.
logLocM InfoS "Hello world"
logItemM :: (Applicative m, KatipContext m) => Maybe Loc -> Severity -> LogStr -> m () Source
Log with everything, including a source code location. This is
very low level and you typically can use logTM
in its
place. Automaticallysupplies payload and namespace.
:: (KatipContext m, MonadCatch m, Applicative m) | |
=> m a | Main action to run |
-> Severity | Severity |
-> m a |
Perform an action while logging any exceptions that may occur.
Inspired by onException
.
>>>
> error "foo" `logExceptionM` ErrorS
Machinery for merging typed log payloads/contexts
class Katip m => KatipContext m where Source
A monadic context that has an inherant way to get logging context and namespace. Examples include a web application monad or database monad.
data AnyLogContext Source
A wrapper around a log context that erases type information so that contexts from multiple layers can be combined intelligently.
data LogContexts Source
Heterogeneous list of log contexts that provides a smart
LogContext
instance for combining multiple payload policies. This
is critical for log contexts deep down in a stack to be able to
inject their own context without worrying about other context that
has already been set. Also note that contexts are treated as a
sequence and <>
will be appended to the right hand side of the
sequence. If there are conflicting keys in the contexts, the /right
side will take precedence/, which is counter to how monoid works
for Map
and HashMap
, so bear that in mind. The reasoning is
that if the user is sequentially adding contexts to the right
side of the sequence, on conflict the intent is to overwrite with
the newer value (i.e. the rightmost value).
Additional note: you should not mappend LogContexts in any sort of infinite loop, as it retains all data, so that would be a memory leak.
liftPayload :: LogItem a => a -> LogContexts Source
Lift a log context into the generic wrapper so that it can combine with the existing log context.
KatipContextT - Utility transformer that provides Katip and KatipContext instances
newtype KatipContextT m a Source
Provides a simple transformer that defines a KatipContext
instance for a fixed namespace and context. You will typically only
use this if you are forced to run in IO but still want to have your
log context. This is the slightly more powerful version of KatipT
in that it provides KatipContext instead of just Katip. For instance:
threadWithLogging = do le <- getLogEnv ctx <- getKatipContext ns <- getKatipNamespace forkIO $ runKatipContextT le ctx ns $ do $(logTM) InfoS "Look, I can log in IO and retain context!" doOtherStuff
runKatipContextT :: LogItem c => LogEnv -> c -> Namespace -> KatipContextT m a -> m a Source
katipAddNamespace :: Monad m => Namespace -> KatipContextT m a -> KatipContextT m a Source
Append a namespace segment to the current namespace for the given monadic action, then restore the previous state afterwards.
katipAddContext :: (LogItem i, Monad m) => i -> KatipContextT m a -> KatipContextT m a Source
Append some context to the current context for the given monadic
action, then restore the previous state afterwards. Important note:
be careful using this in a loop. If you're using something like
forever
or replicateM_
that does explicit sharing to avoid a
memory leak, youll be fine as it will *sequence* calls to
katipAddNamespace
, so each loop will get the same context
added. If you instead roll your own recursion and you're recursing
in the action you provide, you'll instead accumulate tons of
redundant contexts and even if they all merge on log, they are
stored in a sequence and will leak memory.
katipNoLogging :: Monad m => KatipContextT m a -> KatipContextT m a Source
Disable all scribes for the given monadic action, then restore them afterwards.