Safe Haskell | None |
---|---|
Language | Haskell2010 |
Includes all of the API's youll need to use Katip. Be sure to
check out the included examples
directory for an example of
usage.
To get up and running, the workflow is generally:
- Set up a
LogEnv
usinginitLogEnv
. - Add
Scribe
s usingregisterScribe
. - Either use
KatipT
orKatipContextT
for a pre-built transformer stack or addKatip
andKatipContext
instances to your own transformer stack. If you do the latter, you may want to look in theexamples
dir for some tips on composing contexts and namespaces. - Define some structured log data throughout your application and
implement
ToObject
andLogItem
for them. - Begin logging with
logT
,logTM
, etc. - Define your own
Scribe
if you need to output to some as-yet unsupported format or service. If you think it would be useful to others, consider releasing your own package.
- newtype Namespace = Namespace {
- unNamespace :: [Text]
- newtype Environment = Environment {
- getEnvironment :: Text
- data Severity
- renderSeverity :: Severity -> Text
- textToSeverity :: Text -> Maybe Severity
- data Verbosity
- class ToObject a where
- toObject :: a -> Object
- class ToObject a => LogItem a where
- payloadKeys :: Verbosity -> a -> PayloadSelection
- data Item a = Item {
- _itemApp :: Namespace
- _itemEnv :: Environment
- _itemSeverity :: Severity
- _itemThread :: ThreadIdText
- _itemHost :: HostName
- _itemProcess :: ProcessID
- _itemPayload :: a
- _itemMessage :: LogStr
- _itemTime :: UTCTime
- _itemNamespace :: Namespace
- _itemLoc :: Maybe Loc
- newtype ThreadIdText = ThreadIdText {
- getThreadIdText :: Text
- data PayloadSelection
- data Scribe = Scribe {}
- data LogEnv = LogEnv {
- _logEnvHost :: HostName
- _logEnvPid :: ProcessID
- _logEnvApp :: Namespace
- _logEnvEnv :: Environment
- _logEnvTimer :: IO UTCTime
- _logEnvScribes :: Map Text Scribe
- data SimpleLogPayload
- sl :: ToJSON a => Text -> a -> SimpleLogPayload
- itemApp :: forall a. Lens' (Item a) Namespace
- itemEnv :: forall a. Lens' (Item a) Environment
- itemSeverity :: forall a. Lens' (Item a) Severity
- itemThread :: forall a. Lens' (Item a) ThreadIdText
- itemHost :: forall a. Lens' (Item a) HostName
- itemProcess :: forall a. Lens' (Item a) ProcessID
- itemPayload :: forall a a. Lens (Item a) (Item a) a a
- itemMessage :: forall a. Lens' (Item a) LogStr
- itemTime :: forall a. Lens' (Item a) UTCTime
- itemNamespace :: forall a. Lens' (Item a) Namespace
- itemLoc :: forall a. Lens' (Item a) (Maybe Loc)
- logEnvHost :: Lens' LogEnv HostName
- logEnvPid :: Lens' LogEnv ProcessID
- logEnvApp :: Lens' LogEnv Namespace
- logEnvEnv :: Lens' LogEnv Environment
- logEnvTimer :: Lens' LogEnv (IO UTCTime)
- logEnvScribes :: Lens' LogEnv (Map Text Scribe)
- newtype KatipT m a = KatipT {}
- runKatipT :: LogEnv -> KatipT m a -> m a
- initLogEnv :: Namespace -> Environment -> IO LogEnv
- registerScribe :: Text -> Scribe -> LogEnv -> LogEnv
- unregisterScribe :: Text -> LogEnv -> LogEnv
- clearScribes :: LogEnv -> LogEnv
- newtype LogStr = LogStr {
- unLogStr :: Builder
- logStr :: StringConv a Text => a -> LogStr
- ls :: StringConv a Text => a -> LogStr
- showLS :: Show a => a -> LogStr
- class MonadIO m => Katip m where
- logF :: (Applicative m, LogItem a, Katip m) => a -> Namespace -> Severity -> LogStr -> m ()
- logMsg :: (Applicative m, Katip m) => Namespace -> Severity -> LogStr -> m ()
- logT :: ExpQ
- logItem :: (Applicative m, LogItem a, Katip m) => a -> Namespace -> Maybe Loc -> Severity -> LogStr -> m ()
- logException :: (Katip m, LogItem a, MonadCatch m, Applicative m) => a -> Namespace -> Severity -> m b -> m b
- class Katip m => KatipContext m where
- logFM :: (Applicative m, KatipContext m) => Severity -> LogStr -> m ()
- logTM :: ExpQ
- logItemM :: (Applicative m, KatipContext m) => Maybe Loc -> Severity -> LogStr -> m ()
- logExceptionM :: (KatipContext m, MonadCatch m, Applicative m) => m a -> Severity -> m a
- data AnyLogContext
- data LogContexts
- liftPayload :: LogItem a => a -> LogContexts
- mkHandleScribe :: ColorStrategy -> Handle -> Severity -> Verbosity -> IO Scribe
- data ColorStrategy
- permitItem :: Severity -> Item a -> Bool
- payloadObject :: LogItem a => Verbosity -> a -> Object
- itemJson :: LogItem a => Verbosity -> Item a -> Value
- data KatipContextT m a
- 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
Framework Types
Represents a heirarchy of namespaces going from general to specific. For instance: ["processname", "subsystem"]. Note that single-segment namespaces can be created using IsString/OverloadedStrings, so "foo" will result in Namespace ["foo"].
Namespace | |
|
newtype Environment Source
Application environment, like prod
, devel
, testing
.
Environment | |
|
renderSeverity :: Severity -> Text Source
textToSeverity :: Text -> Maybe Severity Source
Katip requires JSON objects to be logged as context. This
typeclass provides a default instance which uses ToJSON and
produces an empty object if toJSON
results in any type other than
object. If you have a type you want to log that produces an Array
or Number for example, you'll want to write an explicit instance
here. You can trivially add a ToObject instance for something with
a ToJSON instance like:
instance ToObject Foo
Nothing
class ToObject a => LogItem a where Source
Payload objects need instances of this class. LogItem makes it so
that you can have very verbose items getting logged with lots of
extra fields but under normal circumstances, if your scribe is
configured for a lower verbosity level, it will only log a
selection of those keys. Furthermore, each Scribe
can be
configured with a different Verbosity
level. You could even use
registerScribe
, unregisterScribe
, and clearScribes
to at
runtime swap out your existing scribes for more verbose debugging
scribes if you wanted to.
When defining payloadKeys
, don't redundantly declare the same
keys for higher levels of verbosity. Each level of verbosity
automatically and recursively contains all keys from the level
before it.
payloadKeys :: Verbosity -> a -> PayloadSelection Source
List of keys in the JSON object that should be included in message.
This has everything each log message will contain.
Item | |
|
newtype ThreadIdText Source
ThreadIdText | |
|
Eq ThreadIdText Source | |
Ord ThreadIdText Source | |
Show ThreadIdText Source | |
ToJSON ThreadIdText Source | |
FromJSON ThreadIdText Source |
data PayloadSelection Source
Field selector by verbosity within JSON payload.
Scribes are handlers of incoming items. Each registered scribe knows how to push a log item somewhere.
Guidelines for writing your own Scribe
Scribes should always take a Severity
and Verbosity
.
Severity is used to *exclude log messages* that are < the provided
Severity. For instance, if the user passes InfoS, DebugS items
should be ignored. Katip provides the permitItem
utility for this.
Verbosity is used to select keys from the log item's payload. Each
LogItem
instance describes what keys should be retained for each
Verbosity level. Use the payloadObject
utility for extracting the keys
that should be permitted.
There is no built-in mechanism in katip for telling a scribe that
its time to shut down. unregisterScribe
merely drops it from the
LogEnv
. This means there are 2 ways to handle resources as a scribe:
- Pass in the resource when the scribe is created. Handle allocation and release of the resource elsewhere. This is what the Handle scribe does.
- Return a finalizing function that tells the scribe to shut
down.
katip-elasticsearch
'smkEsScribe
returns aIO (Scribe, IO ())
. The finalizer will flush any queued log messages and shut down gracefully before returning. This can be hooked into your application's shutdown routine to ensure you never miss any log messages on shutdown.
LogEnv | |
|
data SimpleLogPayload Source
Monoid SimpleLogPayload Source | |
Semigroup SimpleLogPayload Source | |
ToJSON SimpleLogPayload Source | A built-in convenience log payload that won't log anything on Construct using |
LogItem SimpleLogPayload Source | |
ToObject SimpleLogPayload Source |
sl :: ToJSON a => Text -> a -> SimpleLogPayload Source
Construct a simple log from any JSON item.
lens
-compatible Lenses
itemEnv :: forall a. Lens' (Item a) Environment Source
itemSeverity :: forall a. Lens' (Item a) Severity Source
itemThread :: forall a. Lens' (Item a) ThreadIdText Source
itemProcess :: forall a. Lens' (Item a) ProcessID Source
itemPayload :: forall a a. Lens (Item a) (Item a) a a Source
itemMessage :: forall a. Lens' (Item a) LogStr Source
itemNamespace :: forall a. Lens' (Item a) Namespace Source
logEnvHost :: Lens' LogEnv HostName Source
logEnvEnv :: Lens' LogEnv Environment Source
logEnvTimer :: Lens' LogEnv (IO UTCTime) Source
logEnvScribes :: Lens' LogEnv (Map Text Scribe) Source
A Built-in Monad For Logging
A concrete monad you can use to run logging actions.
MonadTrans KatipT Source | |
MonadTransControl KatipT Source | |
MonadBase b m => MonadBase b (KatipT m) Source | |
MonadBaseControl b m => MonadBaseControl b (KatipT m) Source | |
Monad m => Monad (KatipT m) Source | |
Functor m => Functor (KatipT m) Source | |
Applicative m => Applicative (KatipT m) Source | |
MonadIO m => MonadIO (KatipT m) Source | |
MonadThrow m => MonadThrow (KatipT m) Source | |
MonadMask m => MonadMask (KatipT m) Source | |
MonadCatch m => MonadCatch (KatipT m) Source | |
MonadIO m => Katip (KatipT m) Source | |
(Monad m, KatipContext m) => KatipContext (KatipT m) Source | |
type StT KatipT a = a Source | |
type StM (KatipT m) a = ComposeSt KatipT m a Source |
Initializing Loggers
:: Namespace | A base namespace for this application |
-> Environment | Current run environment (e.g. |
-> IO LogEnv |
Create a reasonable default InitLogEnv. Uses an AutoUdate
with
the default settings as the timer. If you are concerned about
timestamp precision or event ordering in log outputs like
ElasticSearch, you should replace the timer with getCurrentTime
Add a scribe to the list. All future log calls will go to this scribe in addition to the others.
Remove a scribe from the list. All future log calls will no longer use this scribe. If the given scribe doesn't exist, its a no-op.
clearScribes :: LogEnv -> LogEnv Source
Unregister *all* scribes. Logs will go off into space from this
point onward until new scribes are added. Note that you could use
this with local
if you're using a Reader based stack to
temporarily disable log output. See katipNoLogging
for an
example.
Logging Functions
Log message with Builder unerneath; use <>
to concat in O(1).
Katip
LoggingFunctions
These logging functions use the basic Katip
constraint and thus
will require varying degrees of explicit detail such as Namespace
and individual log items to be passed in. These can be described as
the primitives of Katip logging. If you find yourself making multiple
log statements within a logical logging context for your app, you may
want to look into the KatipContext
family of logging functions like
logFM
and logTM
. KatipContext
in most applications should be
considered the default. Here's an example of the pain point:
doDatabaseThings = do connId <- getConnectionId logF (ConnectionIDContext connId) "database" InfoS "Doing database stuff" -- ... logF (ConnectionIDContext connId) "database" InfoS "Wow, passing in the same context is getting tedious"
Another pain point to look out for is nesting actions that log in eachother. Let's say you were writing a web app. You want to capture some detail such as the user's ID in the logs, but you also want that info to show up in doDatabaseThings' logs so you can associate those two pieces of information:
webRequestHandler = do uid <- getUserId logF (UserIDContext uid) "web" InfoS "Starting web request" doDatabaseThings
In the above example, doDatabaseThings would overwrite that
UserIDContext with its own context and namespace. Sometimes this is
what you want and that's why logF
and other functions which only
require Katip
exist. If you are interested in combining log
contexts and namespaces, see KatipContext
.
class MonadIO m => Katip m where Source
Monads where katip logging actions can be performed. Katip is the most basic logging monad. You will typically use this directly if you either don't want to use namespaces/contexts heavily or if you want to pass in specific contexts and/or namespaces at each log site.
For something more powerful, look at the docs for KatipContext
,
which keeps a namespace and merged context. You can write simple
functions that add additional namespacing and merges additional
context on the fly.
Katip m => Katip (MaybeT m) Source | |
Katip m => Katip (ResourceT m) Source | |
MonadIO m => Katip (KatipT m) Source | |
MonadIO m => Katip (KatipContextT m) Source | |
Katip m => Katip (ReaderT s m) Source | |
Katip m => Katip (StateT s m) Source | |
Katip m => Katip (ExceptT s m) Source | |
(Katip m, Monoid s) => Katip (WriterT s m) Source | |
Katip m => Katip (EitherT s m) Source |
:: (Applicative m, LogItem a, Katip m) | |
=> a | Contextual payload for the log |
-> Namespace | Specific namespace of the message. |
-> Severity | Severity of the message |
-> LogStr | The log message |
-> m () |
Log with full context, but without any code location.
logMsg :: (Applicative m, Katip m) => Namespace -> Severity -> LogStr -> m () Source
Log a message without any payload/context or code location.
Loc
-tagged logging when using template-haskell.
$(logT) obj mempty InfoS "Hello world"
logItem :: (Applicative m, LogItem a, Katip m) => a -> Namespace -> Maybe Loc -> Severity -> LogStr -> m () Source
Log with everything, including a source code location. This is
very low level and you typically can use logT
in its place.
:: (Katip m, LogItem a, MonadCatch m, Applicative m) | |
=> a | Log context |
-> Namespace | Namespace |
-> Severity | Severity |
-> m b | Main action being run |
-> m b |
Perform an action while logging any exceptions that may occur.
Inspired by onException
.
>>>
> logException () mempty ErrorS (error "foo")
KatipContext
Logging Functions
These logging functions use the KatipContext
constraint which is a
superclass of Katip
that also has a mechanism for keeping track of
the current context and namespace. This means a few things:
- Functions that use
KatipContext
likelogFM
andlogTM
do not require you to pass inLogItem
s orNamespaces
, they pull them from the monadic environment. - It becomes easy to add functions which add namespaces and/or contexts to the current stack of them. You can (and should) make that action scoped to a monadic action so that when it finishes, the previous context and namespace will be automatically restored.
KatipContextT
provides a simple, ReaderT
-based implementation of
the KatipContext
typeclass, and provides katipAddContext
and
katipAddNamespace
functions to append to the context for the
duration of a block:
main = do le <- initLogEnv MyApp "production" -- set up scribes here runKatipContext le () "main" $ do katipAddNamespace "nextlevel" $ do $(logTM) InfoS "Logs here will have namespace MyApp.main.nextlevel" katipAddContext TrivialContext $ do $(logTM) InfoS "Logs here will have context from TrivialContext" katipAddContext AnotherContext $ do $(logTM) InfoS "Logs here will have context from TrivialContext *merged with* context from AnotherContext!" $(logTM) InfoS "Log context restored to () and namespace to MyApp.main"
katipAddNamespace
and katipAddContext
are one-liners, implemented
in terms of local
from MonadReader
. If you have a custom monad
transformer stack and want to add your own version of these, check out
<https://github.com/Soostone/katip/tree/master/katip/examples these
examples>.
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.
:: (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"
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
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.
Included Scribes
mkHandleScribe :: ColorStrategy -> Handle -> Severity -> Verbosity -> IO Scribe Source
Logs to a file handle such as stdout, stderr, or a file. Contexts and other information will be flattened out into bracketed fields. For example:
[2016-05-11 21:01:15][MyApp][Info][myhost.example.com][1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:32:7] Started [2016-05-11 21:01:15][MyApp.confrabulation][Debug][myhost.example.com][1724][ThreadId 1154][confrab_factor:42.0][main:Helpers.Logging Helpers/Logging.hs:41:9] Confrabulating widgets, with extra namespace and context [2016-05-11 21:01:15][MyApp][Info][myhost.example.com][1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:43:7] Namespace and context are back to normal
data ColorStrategy Source
ColorLog Bool | Whether to use color control chars in log output |
ColorIfTerminal | Color if output is a terminal |
Tools for implementing Scribes
permitItem :: Severity -> Item a -> Bool Source
Should this item be logged given the user's maximum severity?
payloadObject :: LogItem a => Verbosity -> a -> Object Source
Constrain payload based on verbosity. Backends should use this to automatically bubble higher verbosity levels to lower ones.
itemJson :: LogItem a => Verbosity -> Item a -> Value Source
Convert log item to its JSON representation while trimming its payload based on the desired verbosity. Backends that push JSON messages should use this to obtain their payload.
KatipContextT - Utility transformer that provides Katip and KatipContext instances
data 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.