Copyright | (c) Galois Inc. 2020 |
---|---|
Maintainer | kquick@galois.com |
Stability | experimental |
Portability | POSIX |
Safe Haskell | Safe |
Language | Haskell2010 |
|
This module defines a general logging facility that can be used to output log messages to various targets.
Synopsis
- newtype LogAction m msg = LogAction {
- writeLog :: msg -> m ()
- class Monad m => HasLog msg m where
- getLogAction :: m (LogAction m msg)
- class (Monad m, HasLog msg m) => LoggingMonad msg m where
- adjustLogAction :: (forall k. LogAction k msg -> LogAction k msg) -> m a -> m a
- writeLogM :: HasLog msg m => msg -> m ()
- safeLogAction :: MonadCatch m => LogAction m msg -> LogAction m msg
- logFilter :: Applicative m => (msg -> Bool) -> LogAction m msg -> LogAction m msg
- data Severity
- data LogType
- data LogMessage = LogMessage {}
- msgWith :: LogMessage
- type WithLog msg m = HasLog msg m
- withLogTag :: LoggingMonad LogMessage m => Text -> Text -> m a -> m a
- addLogActionTime :: MonadIO m => LogAction m LogMessage -> LogAction m LogMessage
- cvtLogMessageToPlainText :: LogMessage -> Text
- cvtLogMessageToANSITermText :: LogMessage -> Text
- logFunctionCall :: MonadIO m => LogAction m LogMessage -> Text -> m a -> m a
- logFunctionCallM :: (MonadIO m, WithLog LogMessage m) => Text -> m a -> m a
- logProgress :: MonadIO m => LogAction m LogMessage -> Text -> m ()
- logProgressM :: (MonadIO m, WithLog LogMessage m) => Text -> m ()
- tshow :: Show a => a -> Text
- defaultGetIOLogAction :: MonadIO m => LogAction m Text
Interface for Logging
newtype LogAction m msg Source #
The LogAction holds the ability to log a message of type msg
(the second parameter) via a monad m
(the first parameter).
LogActions are semigroup and monoid combineable, which results in both LogActions being taken (or no action in the case of mempty), and contravariant to allow the msg to be modified via function prior to being logged (as well as Divisible and Decidable).
Instances
Contravariant (LogAction m) Source # | |
Applicative m => Divisible (LogAction m) Source # | |
Applicative m => Decidable (LogAction m) Source # | |
Applicative m => Semigroup (LogAction m a) Source # | |
Applicative m => Monoid (LogAction m a) Source # | |
class Monad m => HasLog msg m where Source #
Any monad which will support retrieving or adjusting a LogAction
must support the HasLog
class.
getLogAction :: m (LogAction m msg) Source #
class (Monad m, HasLog msg m) => LoggingMonad msg m where Source #
adjustLogAction :: (forall k. LogAction k msg -> LogAction k msg) -> m a -> m a Source #
writeLogM :: HasLog msg m => msg -> m () Source #
This invokes the LogAction's logging handler in a monadic context
where the logging handler can be retrieved via the HasLog
class's
getLogAction
function.
Logging Utilities
safeLogAction :: MonadCatch m => LogAction m msg -> LogAction m msg Source #
Ensures that the LogAction does not fail if the logging operation itself throws an exception (the exception is ignored).
logFilter :: Applicative m => (msg -> Bool) -> LogAction m msg -> LogAction m msg Source #
The logFilter can be used on a LogAction to determine which messages the LogAction should be invoked for (only those for which the filter function returns True).
Default LogMessage
The Severity indicates the relative importance of the logging message. This can be useful for filtering log messages.
The LogType indicates what type of message this is. These are printed on the log line and can be used for filtering different types of log messages.
data LogMessage Source #
Each logged output is described by a LogMessage object.
Instances
Semigroup LogMessage Source # | |
Defined in Lumberjack (<>) :: LogMessage -> LogMessage -> LogMessage # sconcat :: NonEmpty LogMessage -> LogMessage # stimes :: Integral b => b -> LogMessage -> LogMessage # | |
Monoid LogMessage Source # | |
Defined in Lumberjack mempty :: LogMessage # mappend :: LogMessage -> LogMessage -> LogMessage # mconcat :: [LogMessage] -> LogMessage # | |
Pretty LogMessage Source # | |
Defined in Lumberjack pretty :: LogMessage -> Doc ann # prettyList :: [LogMessage] -> Doc ann # |
msgWith :: LogMessage Source #
Helper routine to return an empty LogMessage, whose fields can then be updated.
type WithLog msg m = HasLog msg m Source #
This type is a Constraint that should be applied to any client
function that will perform logging in a monad context. The msg
is the type of message that will be logged, and the m
is the
monad under which the logging is performed.
withLogTag :: LoggingMonad LogMessage m => Text -> Text -> m a -> m a Source #
Log messages can have any number of key/value tags applied to them. This function establishes a new key/value tag pair that will be in effect for the monadic operation passed as the third argument. withLogTag tname tval op = local (adjustLogAction $ addLogTag tname tval) op
addLogActionTime :: MonadIO m => LogAction m LogMessage -> LogAction m LogMessage Source #
Add the current timestamp to the LogMessage being logged
Output formatting for LogMessage
cvtLogMessageToPlainText :: LogMessage -> Text Source #
Standard function for converting a LogMessage into plain Text (no colors or bolding, just text). This can be used as the default converter for a logger (via contramap).
cvtLogMessageToANSITermText :: LogMessage -> Text Source #
Standard function to convert a LogMessage into Text with ANSI terminal colors and bolding and other styling. This can be used as the default converter for a logger (via contramap).
Helpers and convenience functions
logFunctionCall :: MonadIO m => LogAction m LogMessage -> Text -> m a -> m a Source #
A wrapper for a monadic function call that will log on entry
(Debug) and exit (Info) from the function, and note the total
amount of time taken during execution of the function. Note that
no strictness is applied to the internal monadic operation, so the
time taken may be misleading. Like logFunctionCallM
but needs an
explicit LogAction
whereas logFunctionCallM
will retrieve the
LogAction
from the current monadic context.
logFunctionCallM :: (MonadIO m, WithLog LogMessage m) => Text -> m a -> m a Source #
A wrapper for a monadic function call that will log on entry (Debug) and exit (Info) from the function, and note the total amount of time taken during execution of the function. Note that no strictness is applied to the internal monadic operation, so the time taken may be misleading.
logProgress :: MonadIO m => LogAction m LogMessage -> Text -> m () Source #
Called to output a log message to indicate that some progress has been made.
logProgressM :: (MonadIO m, WithLog LogMessage m) => Text -> m () Source #
Called to output a log message within a Logging monad to indicate that some progress has been made.
tshow :: Show a => a -> Text Source #
This is a helper because the LogMessage normally wants a Text, but show delivers a String.
defaultGetIOLogAction :: MonadIO m => LogAction m Text Source #
When using a simple IO monad, there is no ability to store a
LogAction in the base monad. The client can specify a specific
HasLog instance for IO that is appropriate to that client, and that
HasLog can optionally use the defaultGetIOLogAction
as the
getLogAction
implementation to log pretty messages with ANSI
styling to stdout.
instance HasLog Env Text IO where getLogAction = return defaultGetIOLogAction ...