| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Blammo.Logging
Synopsis
- data LogSettings
- data LogLevel
- data LogDestination
- data LogFormat
- data LogColor
- defaultLogSettings :: LogSettings
- setLogSettingsLevels :: LogLevels -> LogSettings -> LogSettings
- setLogSettingsDestination :: LogDestination -> LogSettings -> LogSettings
- setLogSettingsFormat :: LogFormat -> LogSettings -> LogSettings
- setLogSettingsColor :: LogColor -> LogSettings -> LogSettings
- data Logger
- class HasLogger env where
- newLogger :: MonadIO m => LogSettings -> m Logger
- runLoggerLoggingT :: (MonadIO m, HasLogger env) => env -> LoggingT m a -> m a
- data Message = Text :# [SeriesElem]
- (.=) :: (KeyValue kv, ToJSON v) => Key -> v -> kv
- data Series
- class MonadCatch m => MonadMask (m :: Type -> Type)
- withThreadContext :: (MonadIO m, MonadMask m) => [Pair] -> m a -> m a
- myThreadContext :: (MonadIO m, MonadThrow m) => m (KeyMap Value)
- type Pair = (Key, Value)
- class Monad m => MonadLogger (m :: Type -> Type) where
- monadLoggerLog :: ToLogStr msg => Loc -> LogSource -> LogLevel -> msg -> m ()
- class (MonadLogger m, MonadIO m) => MonadLoggerIO (m :: Type -> Type) where
- data LoggingT (m :: Type -> Type) a
- logDebug :: (HasCallStack, MonadLogger m) => Message -> m ()
- logInfo :: (HasCallStack, MonadLogger m) => Message -> m ()
- logWarn :: (HasCallStack, MonadLogger m) => Message -> m ()
- logError :: (HasCallStack, MonadLogger m) => Message -> m ()
- logOther :: (HasCallStack, MonadLogger m) => LogLevel -> Message -> m ()
- type LogSource = Text
- logDebugNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m ()
- logInfoNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m ()
- logWarnNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m ()
- logErrorNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m ()
- logOtherNS :: (HasCallStack, MonadLogger m) => LogSource -> LogLevel -> Message -> m ()
Documentation
data LogSettings Source #
Constructors
| LevelDebug | |
| LevelInfo | |
| LevelWarn | |
| LevelError | |
| LevelOther Text |
data LogDestination Source #
Constructors
| LogFormatJSON | |
| LogFormatTerminal |
Constructors
| LogColorAuto | |
| LogColorAlways | |
| LogColorNever |
setLogSettingsColor :: LogColor -> LogSettings -> LogSettings Source #
Re-exports from Control.Monad.Logger.Aeson
Messages
A Message captures a textual component and a metadata component. The
metadata component is a list of SeriesElem to support tacking on arbitrary
structured data to a log message.
With the OverloadedStrings extension enabled, Message values can be
constructed without metadata fairly conveniently, just as if we were using
Text directly:
logDebug "Some log message without metadata"
Metadata may be included in a Message via the :# constructor:
logDebug$ "Some log message with metadata":#[ "bloorp".=(42 ::Int) , "bonk".=("abc" ::Text) ]
The mnemonic for the :# constructor is that the # symbol is sometimes
referred to as a hash, a JSON object can be thought of as a hash map, and
so with :# (and enough squinting), we are cons-ing a textual message onto
a JSON object. Yes, this mnemonic isn't well-typed, but hopefully it still
helps!
Since: monad-logger-aeson-0.1.0.0
Constructors
| Text :# [SeriesElem] infixr 5 |
Instances
| IsString Message | |
Defined in Control.Monad.Logger.Aeson.Internal Methods fromString :: String -> Message # | |
| ToLogStr Message | |
Defined in Control.Monad.Logger.Aeson.Internal | |
A series of values that, when encoded, should be separated by
commas. Since 0.11.0.0, the .= operator is overloaded to create
either (Text, Value) or Series. You can use Series when
encoding directly to a bytestring builder as in the following
example:
toEncoding (Person name age) = pairs ("name" .= name <> "age" .= age)Thread Context
class MonadCatch m => MonadMask (m :: Type -> Type) #
A class for monads which provide for the ability to account for all possible exit points from a computation, and to mask asynchronous exceptions. Continuation-based monads are invalid instances of this class.
Instances should ensure that, in the following code:
fg = f `finally` g
The action g is called regardless of what occurs within f, including
async exceptions. Some monads allow f to abort the computation via other
effects than throwing an exception. For simplicity, we will consider aborting
and throwing an exception to be two forms of "throwing an error".
If f and g both throw an error, the error thrown by fg depends on which
errors we're talking about. In a monad transformer stack, the deeper layers
override the effects of the inner layers; for example, ExceptT e1 (Except
e2) a represents a value of type Either e2 (Either e1 a), so throwing both
an e1 and an e2 will result in Left e2. If f and g both throw an
error from the same layer, instances should ensure that the error from g
wins.
Effects other than throwing an error are also overriden by the deeper layers.
For example, StateT s Maybe a represents a value of type s -> Maybe (a,
s), so if an error thrown from f causes this function to return Nothing,
any changes to the state which f also performed will be erased. As a
result, g will see the state as it was before f. Once g completes,
f's error will be rethrown, so g' state changes will be erased as well.
This is the normal interaction between effects in a monad transformer stack.
By contrast, lifted-base's
version of finally always discards all of g's non-IO effects, and g
never sees any of f's non-IO effects, regardless of the layer ordering and
regardless of whether f throws an error. This is not the result of
interacting effects, but a consequence of MonadBaseControl's approach.
Minimal complete definition
Instances
| MonadMask IO | |
| e ~ SomeException => MonadMask (Either e) | Since: exceptions-0.8.3 |
Defined in Control.Monad.Catch | |
| MonadMask m => MonadMask (MaybeT m) | Since: exceptions-0.10.0 |
Defined in Control.Monad.Catch | |
| MonadMask m => MonadMask (NoLoggingT m) | |
Defined in Control.Monad.Logger Methods mask :: ((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b) -> NoLoggingT m b # uninterruptibleMask :: ((forall a. NoLoggingT m a -> NoLoggingT m a) -> NoLoggingT m b) -> NoLoggingT m b # generalBracket :: NoLoggingT m a -> (a -> ExitCase b -> NoLoggingT m c) -> (a -> NoLoggingT m b) -> NoLoggingT m (b, c) # | |
| MonadMask m => MonadMask (WriterLoggingT m) | |
Defined in Control.Monad.Logger Methods mask :: ((forall a. WriterLoggingT m a -> WriterLoggingT m a) -> WriterLoggingT m b) -> WriterLoggingT m b # uninterruptibleMask :: ((forall a. WriterLoggingT m a -> WriterLoggingT m a) -> WriterLoggingT m b) -> WriterLoggingT m b # generalBracket :: WriterLoggingT m a -> (a -> ExitCase b -> WriterLoggingT m c) -> (a -> WriterLoggingT m b) -> WriterLoggingT m (b, c) # | |
| MonadMask m => MonadMask (LoggingT m) | |
Defined in Control.Monad.Logger Methods mask :: ((forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b) -> LoggingT m b # uninterruptibleMask :: ((forall a. LoggingT m a -> LoggingT m a) -> LoggingT m b) -> LoggingT m b # generalBracket :: LoggingT m a -> (a -> ExitCase b -> LoggingT m c) -> (a -> LoggingT m b) -> LoggingT m (b, c) # | |
| MonadMask m => MonadMask (ResourceT m) | |
Defined in Control.Monad.Trans.Resource.Internal Methods mask :: ((forall a. ResourceT m a -> ResourceT m a) -> ResourceT m b) -> ResourceT m b # uninterruptibleMask :: ((forall a. ResourceT m a -> ResourceT m a) -> ResourceT m b) -> ResourceT m b # generalBracket :: ResourceT m a -> (a -> ExitCase b -> ResourceT m c) -> (a -> ResourceT m b) -> ResourceT m (b, c) # | |
| MonadMask m => MonadMask (IdentityT m) | |
Defined in Control.Monad.Catch Methods mask :: ((forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b) -> IdentityT m b # uninterruptibleMask :: ((forall a. IdentityT m a -> IdentityT m a) -> IdentityT m b) -> IdentityT m b # generalBracket :: IdentityT m a -> (a -> ExitCase b -> IdentityT m c) -> (a -> IdentityT m b) -> IdentityT m (b, c) # | |
| (MonadMask m, Monoid w) => MonadMask (WriterT w m) | |
Defined in Control.Monad.Catch Methods mask :: ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b # uninterruptibleMask :: ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b # generalBracket :: WriterT w m a -> (a -> ExitCase b -> WriterT w m c) -> (a -> WriterT w m b) -> WriterT w m (b, c) # | |
| (MonadMask m, Monoid w) => MonadMask (WriterT w m) | |
Defined in Control.Monad.Catch Methods mask :: ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b # uninterruptibleMask :: ((forall a. WriterT w m a -> WriterT w m a) -> WriterT w m b) -> WriterT w m b # generalBracket :: WriterT w m a -> (a -> ExitCase b -> WriterT w m c) -> (a -> WriterT w m b) -> WriterT w m (b, c) # | |
| MonadMask m => MonadMask (StateT s m) | |
Defined in Control.Monad.Catch Methods mask :: ((forall a. StateT s m a -> StateT s m a) -> StateT s m b) -> StateT s m b # uninterruptibleMask :: ((forall a. StateT s m a -> StateT s m a) -> StateT s m b) -> StateT s m b # generalBracket :: StateT s m a -> (a -> ExitCase b -> StateT s m c) -> (a -> StateT s m b) -> StateT s m (b, c) # | |
| MonadMask m => MonadMask (StateT s m) | |
Defined in Control.Monad.Catch Methods mask :: ((forall a. StateT s m a -> StateT s m a) -> StateT s m b) -> StateT s m b # uninterruptibleMask :: ((forall a. StateT s m a -> StateT s m a) -> StateT s m b) -> StateT s m b # generalBracket :: StateT s m a -> (a -> ExitCase b -> StateT s m c) -> (a -> StateT s m b) -> StateT s m (b, c) # | |
| MonadMask m => MonadMask (ReaderT r m) | |
Defined in Control.Monad.Catch Methods mask :: ((forall a. ReaderT r m a -> ReaderT r m a) -> ReaderT r m b) -> ReaderT r m b # uninterruptibleMask :: ((forall a. ReaderT r m a -> ReaderT r m a) -> ReaderT r m b) -> ReaderT r m b # generalBracket :: ReaderT r m a -> (a -> ExitCase b -> ReaderT r m c) -> (a -> ReaderT r m b) -> ReaderT r m (b, c) # | |
| (Error e, MonadMask m) => MonadMask (ErrorT e m) | |
Defined in Control.Monad.Catch Methods mask :: ((forall a. ErrorT e m a -> ErrorT e m a) -> ErrorT e m b) -> ErrorT e m b # uninterruptibleMask :: ((forall a. ErrorT e m a -> ErrorT e m a) -> ErrorT e m b) -> ErrorT e m b # generalBracket :: ErrorT e m a -> (a -> ExitCase b -> ErrorT e m c) -> (a -> ErrorT e m b) -> ErrorT e m (b, c) # | |
| MonadMask m => MonadMask (ExceptT e m) | Since: exceptions-0.9.0 |
Defined in Control.Monad.Catch Methods mask :: ((forall a. ExceptT e m a -> ExceptT e m a) -> ExceptT e m b) -> ExceptT e m b # uninterruptibleMask :: ((forall a. ExceptT e m a -> ExceptT e m a) -> ExceptT e m b) -> ExceptT e m b # generalBracket :: ExceptT e m a -> (a -> ExitCase b -> ExceptT e m c) -> (a -> ExceptT e m b) -> ExceptT e m (b, c) # | |
| (MonadMask m, Monoid w) => MonadMask (RWST r w s m) | |
Defined in Control.Monad.Catch Methods mask :: ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b) -> RWST r w s m b # uninterruptibleMask :: ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b) -> RWST r w s m b # generalBracket :: RWST r w s m a -> (a -> ExitCase b -> RWST r w s m c) -> (a -> RWST r w s m b) -> RWST r w s m (b, c) # | |
| (MonadMask m, Monoid w) => MonadMask (RWST r w s m) | |
Defined in Control.Monad.Catch Methods mask :: ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b) -> RWST r w s m b # uninterruptibleMask :: ((forall a. RWST r w s m a -> RWST r w s m a) -> RWST r w s m b) -> RWST r w s m b # generalBracket :: RWST r w s m a -> (a -> ExitCase b -> RWST r w s m c) -> (a -> RWST r w s m b) -> RWST r w s m (b, c) # | |
withThreadContext :: (MonadIO m, MonadMask m) => [Pair] -> m a -> m a #
This function lets us register structured, contextual info for the duration of the provided action. All messages logged within the provided action will automatically include this contextual info. This function is thread-safe, as the contextual info is scoped to the calling thread only.
This function is additive: if we nest calls to it, each nested call will add
to the existing thread context. In the case of overlapping keys, the nested
call's Pair value(s) will win. Whenever the inner action completes, the
thread context is rolled back to its value set in the enclosing action.
If we wish to include the existing thread context from one thread in another
thread, we must register the thread context explicitly on that other thread.
myThreadContext can be leveraged in this case.
Registering thread context for messages can be useful in many scenarios. One
particularly apt scenario is in wai middlewares. We can generate an ID for
each incoming request then include it in the thread context. Now all messages
subsequently logged from our endpoint handler will automatically include that
request ID:
import Control.Monad.Logger.Aeson ((.=), withThreadContext)
import Network.Wai (Middleware)
import qualified Data.UUID.V4 as UUID
addRequestId :: Middleware
addRequestId app = \request sendResponse -> do
uuid <- UUID.nextRandom
withThreadContext ["requestId" .= uuid] do
app request sendResponseIf we're coming from a Java background, it may be helpful for us to draw
parallels between this function and log4j2's ThreadContext (or perhaps
log4j's MDC). They all enable the same thing: setting some thread-local
info that will be automatically pulled into each logged message.
Since: monad-logger-aeson-0.1.0.0
myThreadContext :: (MonadIO m, MonadThrow m) => m (KeyMap Value) #
This function lets us retrieve the calling thread's thread context. For
more detail, we can consult the docs for withThreadContext.
Note that even though the type signature lists MonadThrow as a required
constraint, the library guarantees that myThreadContext will never throw.
Since: monad-logger-aeson-0.1.0.0
Transformer
class Monad m => MonadLogger (m :: Type -> Type) where #
A Monad which has the ability to log messages in some manner.
Minimal complete definition
Nothing
Instances
class (MonadLogger m, MonadIO m) => MonadLoggerIO (m :: Type -> Type) where #
An extension of MonadLogger for the common case where the logging action
is a simple IO action. The advantage of using this typeclass is that the
logging function itself can be extracted as a first-class value, which can
make it easier to manipulate monad transformer stacks, as an example.
Since: monad-logger-0.3.10
Minimal complete definition
Nothing
Methods
askLoggerIO :: m (Loc -> LogSource -> LogLevel -> LogStr -> IO ()) #
Request the logging function itself.
Since: monad-logger-0.3.10
Instances
data LoggingT (m :: Type -> Type) a #
Monad transformer that adds a new logging function.
Since: monad-logger-0.2.2
Instances
Common logging functions
Import Control.Monad.Logger.Aeson if you want more
Implicit call stack, no LogSource
logDebug :: (HasCallStack, MonadLogger m) => Message -> m () #
logInfo :: (HasCallStack, MonadLogger m) => Message -> m () #
See logDebug
Since: monad-logger-aeson-0.1.0.0
logWarn :: (HasCallStack, MonadLogger m) => Message -> m () #
See logDebug
Since: monad-logger-aeson-0.1.0.0
logError :: (HasCallStack, MonadLogger m) => Message -> m () #
See logDebug
Since: monad-logger-aeson-0.1.0.0
logOther :: (HasCallStack, MonadLogger m) => LogLevel -> Message -> m () #
See logDebug
Since: monad-logger-aeson-0.1.0.0
Implicit call stack, with LogSource
logDebugNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m () #
See logDebugCS
Since: monad-logger-aeson-0.1.0.0
logInfoNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m () #
See logDebugNS
Since: monad-logger-aeson-0.1.0.0
logWarnNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m () #
See logDebugNS
Since: monad-logger-aeson-0.1.0.0
logErrorNS :: (HasCallStack, MonadLogger m) => LogSource -> Message -> m () #
See logDebugNS
Since: monad-logger-aeson-0.1.0.0
logOtherNS :: (HasCallStack, MonadLogger m) => LogSource -> LogLevel -> Message -> m () #
See logDebugNS
Since: monad-logger-aeson-0.1.0.0