| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Di
Contents
Description
This module is a highly opinionated, basic, and yet sufficient choice of a concrete stack of logging solutions belonging to the di logging ecosystem—an otherwise rather general ecosystem, flexible and full of choices.
For most logging scenarios out there, the choices made here should suffice, but if you find these are not sufficient for your particular use case, please refer to other libraries of the di logging ecosystem such as di-core, di-monad, di-handle, or di-df1, and you are likely to find a compatible and composable solution there. For this reason, staring with this package rather than one of the those other lower-level packages is always recommended.
The choices made here are:
- We encourage a mtl approach
through a typeclass called
MonadDi, for which all of the monad transformers in transformers and pipes have instances. - We provide our own
DiTmonad transformer which has aMonadDiinstance, as well as instances for all the relevant typeclasses in the base, mtl, and exceptions libraries. All of theMonadDiinstances exported by this package expect aDiTtransformer in the stack somewhere, and defer all work to it. - We embrace the df1 hierarchical
structured logging format, both at the type-level and when rendering the
log lines as text. Most notably, this means that we embrace the df1
importance
Levels. - We commit logs to the outside world by printing them to
stderr. - Exceptions are logged at their throw site (see
onException).
You will notice that some of the functions in this module mention the types
Level, Path and Message, and some other functions
talk about level, path and msg type variables. This is
because even while our particular set of choices require some monomorphic
types, as demonstrated by the Df1 and MonadDf1
type-synonyms, the larger di logging ecosystem treats these values
polymorphically, so they will show up in the types in one way or another,
either in concrete or polymorphic form. This can seem a bit noisy, but the
good news is that if, for example, want to call a third party library that
uses other types for conveying the idea of a “log importance level” or a “log
message”, then you can do so if you can convert between these different
types. You are of course encouraged to use the Df1 and
MonadDf1 type-synonyms yourself. For more information about
this, see Di.Monad and Di.Core, but not today.
The intended usage of this module is:
import qualified Di
Synopsis
- new :: (MonadIO m, MonadMask m) => (Di Level Path Message -> m a) -> m a
- push :: MonadDi level Path msg m => Segment -> m a -> m a
- attr :: (MonadDi level Path msg m, ToValue value) => Key -> value -> m a -> m a
- attr_ :: MonadDi level Path msg m => Key -> Value -> m a -> m a
- debug :: (MonadDi Level path Message m, ToMessage msg) => msg -> m ()
- info :: (MonadDi Level path Message m, ToMessage msg) => msg -> m ()
- notice :: (MonadDi Level path Message m, ToMessage msg) => msg -> m ()
- warning :: (MonadDi Level path Message m, ToMessage msg) => msg -> m ()
- error :: (MonadDi Level path Message m, ToMessage msg) => msg -> m ()
- alert :: (MonadDi Level path Message m, ToMessage msg) => msg -> m ()
- critical :: (MonadDi Level path Message m, ToMessage msg) => msg -> m ()
- emergency :: (MonadDi Level path Message m, ToMessage msg) => msg -> m ()
- debug_ :: MonadDi Level path Message m => Message -> m ()
- info_ :: MonadDi Level path Message m => Message -> m ()
- notice_ :: MonadDi Level path Message m => Message -> m ()
- warning_ :: MonadDi Level path Message m => Message -> m ()
- error_ :: MonadDi Level path Message m => Message -> m ()
- alert_ :: MonadDi Level path Message m => Message -> m ()
- critical_ :: MonadDi Level path Message m => Message -> m ()
- emergency_ :: MonadDi Level path Message m => Message -> m ()
- throw :: (MonadDi level path msg m, Exception e) => e -> m a
- runDiT :: MonadIO m => Di level path msg -> DiT level path msg m a -> m a
- hoistDiT :: (forall x. n x -> m x) -> (forall x. m x -> n x) -> DiT level path msg m a -> DiT level path msg n a
- class Monad m => MonadDi level path msg (m :: Type -> Type) | m -> level path msg where
- type Df1 = Di Level Path Message
- type Df1T = DiT Level Path Message
- type MonadDf1 = MonadDi Level Path Message
- data Level
- data Path
- data Segment
- class ToSegment a where
- data Key
- class ToKey a where
- data Value
- class ToValue a where
- data Message
- class ToMessage a where
Documentation
Arguments
| :: (MonadIO m, MonadMask m) | |
| => (Di Level Path Message -> m a) | This type is the same as Within this scope, you can use the obtained WARNING: Even while |
| -> m a |
Obtain a Di that will write logs in the df1 format to
stderr.
Generally, you will want to call new just once per application, right from
your main function. For example:
main ::IO() main = do -- First you obtain aDi. -- You do this once per application, inmain.new$ \di -> do -- You can start logging right away by acting -- on the on theDiobject, but here -- we encourage usingrunDiTand perforfing -- all your logging from within aMonadDf1.runDiTdi $ do -- Our first log message!notice_"Welcome to my program!" -- You can usepushto separate different -- logging scopes of your program:push"initialization" $ donotice_"Starting web server"alert_"Disk is almost full!!!" -- Yet another scope.push"server" $ do -- You can useattrto add metadata to -- messages logged within a particular scope.attr"port" (80 :: Int) $ doinfo_"Listening for new clients" clientAddress <- do -- This is just an example. Whatever. pure ("10.0.0.8" :: String)push"handler" $ doattr"client-address" clientAddress $ doinfo_"Connection established" -- If you throw an exception with throw, -- it will be logged automatically together -- with its current scope. Isn't that nice?throw(userError "Oops!")
That program will render something like this to stderr:

You get the nice colors only if the output is going to a TTY. Otherwise, you get the same, but without any colors.
2019-11-15T18:05:54.949470902Z NOTICE Welcome to my program! 2019-11-15T18:05:54.949623731Z /initialization NOTICE Starting web server 2019-11-15T18:05:54.949630205Z /initialization ALERT Disk is almost full!!! 2019-11-15T18:05:54.949640299Z /server port=80 INFO Listening for new clients 2019-11-15T18:05:54.949652133Z /server port=80 /handler client-address=10.0.0.8 INFO Connection established 2019-11-15T18:05:54.949664482Z /server port=80 /handler client-address=10.0.0.8 WARNING user error (Oops!)
Notice that by default, all exceptions thrown using throw
are logged at their throw site with Warning level. You can change
that if you care using onException.
Unrelated: df1 escapes conflicting punctuation characters as necessary.
Hierarchy
Metadata
Logging
debug :: (MonadDi Level path Message m, ToMessage msg) => msg -> m () #
Log a message intended to be useful only when deliberately debugging a program.
notice :: (MonadDi Level path Message m, ToMessage msg) => msg -> m () #
Log a condition that is not an error, but should possibly be handled specially.
warning :: (MonadDi Level path Message m, ToMessage msg) => msg -> m () #
Log a warning condition, such as an exception being gracefully handled or some missing configuration setting being assigned a default value.
error :: (MonadDi Level path Message m, ToMessage msg) => msg -> m () #
Log an error condition, such as an unhandled exception.
alert :: (MonadDi Level path Message m, ToMessage msg) => msg -> m () #
Log a condition that should be corrected immediately, such as a corrupted database.
critical :: (MonadDi Level path Message m, ToMessage msg) => msg -> m () #
Log a critical condition that could result in system failure, such as a disk running out of space.
emergency :: (MonadDi Level path Message m, ToMessage msg) => msg -> m () #
Log a message stating that the system is unusable.
Better type-inference
Exceptions
throw :: (MonadDi level path msg m, Exception e) => e -> m a #
Throw an Exception, but not without logging it first according to the
rules established by onException, and further restricted by the rules
established by filter.
If the exception doesn't need to be logged, according to the policy set with
onException, then this function behaves just as
throwSTM.
WARNING: Note that when m is STM, or ultimately runs on STM, then
throw will not log the exception, just throw it. This might change in
the future if we figure out how to make it work safely.
Support for MonadDi and DiT
Run a DiT.
forall di.runDiTdi (diT(\nat' di' -> pure (nat', di'))) ==pure(natSTM, di)
This is like runDiT', but specialized to run with an underlying MonadIO.
runDiT==runDiT'(liftIO.atomically)
Please notice that runDiT doesn't perform a flush on the given Di
before returning. You are responsible for doing that (or, more likely,
new will do it for you).
Also, notice that runDiT is a monad morphism from to DiT mm.
Arguments
| :: (forall x. n x -> m x) | Natural transformation from |
| -> (forall x. m x -> n x) | Monad morphism from |
| -> DiT level path msg m a | |
| -> DiT level path msg n a |
Lift a monad morphism from m to n to a monad morphism from
to DiT level path msg m.DiT level path msg n
Notice that DiT itself is not a functor in the category of monads,
so it can't be an instance of MFunctor from the
mmorph package.
However, it becomes one if you pair it with a natural transformation
. That is:nat :: forall x. n x -> m x
forall nat. such thatnatis a natural transformationhoistDiTnat ==hoist
In practical terms, it means that most times you can “hoist” a DiT
anyway, just not through hoist.
class Monad m => MonadDi level path msg (m :: Type -> Type) | m -> level path msg where #
A MonadDi allows interacting with a Di through a
mtl-like monadic API, rather
than through the “bare” API proposed by Di.Core.
Nevertheless, be aware that these two APIs are compatible, so you may
choose to use the monadic API for some parts of your application, the
“bare” API for some other parts, and everything will compose and behave
as expected. Usually, runDiT is the boundary between these two APIs,
although not necessarily.
Semantically, is a “reader monad” that carries as its
environment a MonadDi mDi and natural transformation from STM to m.
Minimal complete definition
Methods
ask :: m (Di level path msg) #
local :: (Di level path msg -> Di level path msg) -> m a -> m a #
Run m a with a modified Di:
local(constx)ask==purex
Identity law:
localidx == x
Distributive law:
localf.localg ==local(f.g)
Idempotence law:
localf (pure())>>x == x
Natural transformation from STM to m.
Notice that it is not necessary for this natural transformation to be a
monad morphism as well. That is, atomically is acceptable.
Instances
| MonadDi level path msg m => MonadDi level path msg (MaybeT m) | |
| MonadDi level path msg m => MonadDi level path msg (ListT m) | |
| (Monoid w, MonadDi level path msg m) => MonadDi level path msg (WriterT w m) | |
| (Monoid w, MonadDi level path msg m) => MonadDi level path msg (WriterT w m) | |
| MonadDi level path msg m => MonadDi level path msg (StateT s m) | |
| MonadDi level path msg m => MonadDi level path msg (StateT s m) | |
| MonadDi level path msg m => MonadDi level path msg (SelectT r m) | |
| MonadDi level path msg m => MonadDi level path msg (IdentityT m) | |
| MonadDi level path msg m => MonadDi level path msg (ExceptT e m) | |
| (Monoid w, MonadDi level path msg m) => MonadDi level path msg (AccumT w m) | |
| MonadDi level path msg m => MonadDi level path msg (ReaderT r m) | |
| MonadDi level path msg m => MonadDi level path msg (ContT r m) | |
| (Monoid w, MonadDi level path msg m) => MonadDi level path msg (RWST r w s m) | |
| (Monoid w, MonadDi level path msg m) => MonadDi level path msg (RWST r w s m) | |
| Monad m => MonadDi level path msg (DiT level path msg m) | |
| MonadDi level path msg m => MonadDi level path msg (Proxy a' a b' b m) | |
Convenient type-synonyms
type Df1 = Di Level Path Message #
Convenience type-synonym for a Di restricted to all the df1
monomorphic types.
Df1==DiLevelPathMessage:: *
This type-synonym is not used within the di-df1 library itself because
all functions exposed in the library have more general types. However,
users are encouraged to use Df1 if they find it useful to reduce
boilerplate and improve type inference.
type Df1T = DiT Level Path Message #
Convenience type-synonym for a DiT restricted to all the df1
monomorphic types.
Df1T==DiTLevelPathMessage:: (* -> *) -> * -> *Df1Tm ==DiTLevelPathMessagem :: * -> *Df1Tm a ==DiTLevelPathMessagem a :: *
This type-synonym is not used within the di-df1 library itself because
all functions exposed in the library have more general types. However,
users are encouraged to use MonadDf1 if they find it useful to reduce
boilerplate and improve type inferrence.
type MonadDf1 = MonadDi Level Path Message #
Convenience type-synonym for a MonadDi restricted to all the df1
monomorphic types.
MonadDf1==MonadDiLevelPathMessage:: (* -> *) ->ConstraintMonadDf1m ==MonadDiLevelPathMessagem ::Constraint
This type-synonym is not used within the di-df1 library itself because
all functions exposed in the library have more general types. However,
users are encouraged to use MonadDf1 if they find it useful to reduce
boilerplate and improve type inferrence.
Types from Df1
Importance of the logged message.
These levels, listed in increasing order of importance, correspond to the levels used by syslog(3).
Path represents the hierarchical structure of logged messages.
For example, consider a df1 log line as like the following:
1999-12-20T07:11:39.230553031Z /foo x=a y=b /bar /qux z=c z=d WARNING Something
For that line, the log_path attribute of the Log datatype will contain
the following:
[Push(segment"foo") ,Attr(key"x") (value"a") ,Attr(key"y") (value"b") ,Push(segment"bar") ,Push(segment"qux") ,Attr(key"z") (value"c") ,Attr(key"z") (value"d") ] ::SeqPath
Please notice that [] :: is a valid path insofar as df1
is concerned, and that Seq PathAttr and Push can be juxtapositioned in any order.
A path segment.
If you have the OverloadedStrings GHC extension enabled, you can build a
Segment using a string literal:
"foo" :: Segment
Otherwise, you can use fromString or segment.
Notice that "" :: is acceptable, and will be correctly rendered
and parsed back.Segment
Convert an arbitrary type to a Segment.
You are encouraged to create custom ToSegment instances for your types
making sure you avoid rendering sensitive details such as passwords, so that
they don't accidentally end up in logs.
Any characters that need to be escaped for rendering will be automatically escaped at rendering time. You don't need to escape them here.
An attribute key (see Attr).
If you have the OverloadedStrings GHC extension enabled, you can build a
Key using a string literal:
"foo" :: Key
Otherwise, you can use fromString or key.
Notice that "" :: is acceptable, and will be correctly rendered and
parsed back.Key
Convert an arbitrary type to a Key.
You are encouraged to create custom ToKey instances for your types
making sure you avoid rendering sensitive details such as passwords, so that
they don't accidentally end up in logs.
Any characters that need to be escaped for rendering will be automatically escaped at rendering time. You don't need to escape them here.
An attribute value (see Attr).
If you have the OverloadedStrings GHC extension enabled, you can build a
Value using a string literal:
"foo" :: Value
Otherwise, you can use fromString or value.
Notice that "" :: is acceptable, and will be correctly rendered
and parsed back.Value
Convert an arbitrary type to a Value.
You are encouraged to create custom ToValue instances for your types
making sure you avoid rendering sensitive details such as passwords, so that
they don't accidentally end up in logs.
Any characters that need to be escaped for rendering will be automatically escaped at rendering time. You don't need to escape them here.
Instances
| ToValue Bool | |
| ToValue Double | |
| ToValue Float | |
| ToValue Int | |
| ToValue Int8 | |
| ToValue Int16 | |
| ToValue Int32 | |
| ToValue Int64 | |
| ToValue Integer | |
| ToValue Natural | |
| ToValue Word | |
| ToValue Word8 | |
| ToValue Word16 | |
| ToValue Word32 | |
| ToValue Word64 | |
| ToValue Text | x :: |
| ToValue Text | x :: |
| ToValue String | x :: |
| ToValue SomeException | |
Defined in Df1.Types Methods value :: SomeException -> Value # | |
| ToValue Value | Identity. |
A message text.
If you have the OverloadedStrings GHC extension enabled, you can build a
Message using a string literal:
"foo" :: Message
Otherwise, you can use fromString or message.
Notice that "" :: is acceptable, and will be correctly rendered
and parsed back.Message
Convert an arbitrary type to a Message.
You are encouraged to create custom ToMessage instances for your types
making sure you avoid rendering sensitive details such as passwords, so that
they don't accidentally end up in logs.
Any characters that need to be escaped for rendering will be automatically escaped at rendering time. You don't need to escape them here.