katip-0.1.1.0: A structured logging framework.

Safe HaskellNone
LanguageHaskell2010

Katip

Contents

Description

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 using initLogEnv.
  • Add Scribes using registerScribe.
  • Either use KatipT or KatipContextT for a pre-built transformer stack or add Katip and KatipContext instances to your own transformer stack. If you do the latter, you may want to look in the examples dir for some tips on composing contexts and namespaces.
  • Define some structured log data throughout your application and implement ToObject and LogItem 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.

Synopsis

Framework Types

class MonadIO m => Katip m where Source

Monads where katip logging actions can be performed

Methods

getLogEnv :: m LogEnv Source

Instances

Katip m => Katip (MaybeT m) 
Katip m => Katip (ResourceT m) 
MonadIO m => Katip (KatipT m) 
MonadIO m => Katip (KatipContextT m) 
(Katip m, Monoid s) => Katip (WriterT s m) 
Katip m => Katip (StateT s m) 
Katip m => Katip (ReaderT s m) 
Katip m => Katip (ExceptT s m) 
Katip m => Katip (EitherT s m) 

newtype Namespace Source

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"].

Constructors

Namespace 

Fields

unNamespace :: [Text]
 

newtype Environment Source

Application environment, like prod, devel, testing.

Constructors

Environment 

Fields

getEnvironment :: Text
 

data Severity Source

Constructors

DebugS

Debug messages

InfoS

Information

NoticeS

Normal runtime Conditions

WarningS

General Warnings

ErrorS

General Errors

CriticalS

Severe situations

AlertS

Take immediate action

EmergencyS

System is unusable

data Verbosity Source

Verbosity controls the amount of information (columns) a Scribe emits during logging.

The convention is: - V0 implies no additional payload information is included in message. - V3 implies the maximum amount of payload information. - Anything in between is left to the discretion of the developer.

Constructors

V0 
V1 
V2 
V3 

class ToJSON a => ToObject a where 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

Minimal complete definition

Nothing

Methods

toObject :: a -> Object Source

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.

Methods

payloadKeys :: Verbosity -> a -> PayloadSelection Source

List of keys in the JSON object that should be included in message.

data Item a Source

This has everything each log message will contain.

Instances

Functor Item 
Show a => Show (Item a) 
Generic (Item a) 
ToJSON a => ToJSON (Item a) 
FromJSON a => FromJSON (Item a) 
type Rep (Item a) 

itemApp :: forall a. Lens' (Item a) Namespace Source

itemEnv :: forall a. Lens' (Item a) Environment Source

itemSeverity :: forall a. Lens' (Item a) Severity Source

itemThread :: forall a. Lens' (Item a) ThreadIdText Source

itemHost :: forall a. Lens' (Item a) HostName 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

itemTime :: forall a. Lens' (Item a) UTCTime Source

itemNamespace :: forall a. Lens' (Item a) Namespace Source

itemLoc :: forall a. Lens' (Item a) (Maybe Loc) Source

newtype ThreadIdText Source

Constructors

ThreadIdText 

Fields

getThreadIdText :: Text
 

data PayloadSelection Source

Field selector by verbosity within JSON payload.

Constructors

AllKeys 
SomeKeys [Text] 

data Scribe Source

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:

  1. Pass in the resource when the scribe is created. Handle allocation and release of the resource elsewhere. This is what the Handle scribe does.
  2. Return a finalizing function that tells the scribe to shut down. katip-elasticsearch's mkEsScribe returns a IO (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.

Constructors

Scribe 

Fields

liPush :: forall a. LogItem a => Item a -> IO ()
 

Instances

data LogEnv Source

Constructors

LogEnv 

Fields

_logEnvHost :: HostName
 
_logEnvPid :: ProcessID
 
_logEnvNs :: Namespace
 
_logEnvEnv :: Environment
 
_logEnvTimer :: IO UTCTime

Action to fetch the timestamp. You can use something like AutoUpdate for high volume logs but note that this may cause some output forms to display logs out of order.

_logEnvScribes :: Map Text Scribe
 

logEnvHost :: Lens' LogEnv HostName Source

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.

Instances

(KatipContext m, Katip (MaybeT m)) => KatipContext (MaybeT m) 
(KatipContext m, Katip (ListT m)) => KatipContext (ListT m) 
(KatipContext m, Katip (IdentityT m)) => KatipContext (IdentityT m) 
(KatipContext m, Katip (ResourceT m)) => KatipContext (ResourceT m) 
(Monad m, KatipContext m) => KatipContext (KatipT m) 
MonadIO m => KatipContext (KatipContextT m) 
(Monoid w, KatipContext m, Katip (WriterT w m)) => KatipContext (WriterT w m) 
(Monoid w, KatipContext m, Katip (WriterT w m)) => KatipContext (WriterT w m) 
(KatipContext m, Katip (StateT s m)) => KatipContext (StateT s m) 
(KatipContext m, Katip (StateT s m)) => KatipContext (StateT s m) 
(KatipContext m, Katip (ReaderT r m)) => KatipContext (ReaderT r m) 
(KatipContext m, Katip (ExceptT s m)) => KatipContext (ExceptT s m) 
(KatipContext m, Katip (EitherT e m)) => KatipContext (EitherT e m) 
(Monoid w, KatipContext m, Katip (RWST r w s m)) => KatipContext (RWST r w s m) 
(Monoid w, KatipContext m, Katip (RWST r w s m)) => KatipContext (RWST r w s m) 

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.

liftPayload :: LogItem a => a -> LogContexts Source

Lift a log context into the generic wrapper so that it can combine with the existing log context.

data SimpleLogPayload Source

Instances

Monoid SimpleLogPayload 
ToJSON SimpleLogPayload

A built-in convenience log payload that won't log anything on V0, but will log everything in any other level of verbosity. Intended for easy in-line usage without having to define new log types.

Construct using sl and combine multiple tuples using <> from Monoid.

LogItem SimpleLogPayload 
ToObject SimpleLogPayload 

sl :: ToJSON a => Text -> a -> SimpleLogPayload Source

Construct a simple log from any JSON item.

A Built-in Monad For Logging

newtype KatipT m a Source

A concrete monad you can use to run logging actions.

Constructors

KatipT 

Fields

unKatipT :: ReaderT LogEnv m a
 

Instances

MonadTrans KatipT 
MonadTransControl KatipT 
MonadBase b m => MonadBase b (KatipT m) 
MonadBaseControl b m => MonadBaseControl b (KatipT m) 
Monad m => Monad (KatipT m) 
Functor m => Functor (KatipT m) 
Applicative m => Applicative (KatipT m) 
MonadThrow m => MonadThrow (KatipT m) 
MonadMask m => MonadMask (KatipT m) 
MonadCatch m => MonadCatch (KatipT m) 
MonadIO m => MonadIO (KatipT m) 
MonadIO m => Katip (KatipT m) 
(Monad m, KatipContext m) => KatipContext (KatipT m) 
type StT KatipT a = a 
type StM (KatipT m) a = ComposeSt KatipT m a 

runKatipT :: LogEnv -> KatipT m a -> m a Source

Execute KatipT on a log env.

Initializing Loggers

initLogEnv Source

Arguments

:: Namespace

A base namespace for this application

-> Environment

Current run environment (e.g. prod vs. devel)

-> 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

registerScribe Source

Arguments

:: Text

Name the scribe

-> Scribe 
-> LogEnv 
-> LogEnv 

Add a scribe to the list. All future log calls will go to this scribe in addition to the others.

unregisterScribe Source

Arguments

:: Text

Name of the scribe

-> LogEnv 
-> LogEnv 

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.

Logging Functions

newtype LogStr Source

Log message with Builder unerneath; use <> to concat in O(1).

Constructors

LogStr 

Fields

unLogStr :: Builder
 

logStr :: StringConv a Text => a -> LogStr Source

Pack any string-like thing into a LogStr. This will automatically work on String, 'ByteString, Text and any of the lazy variants.

ls :: StringConv a Text => a -> LogStr Source

Shorthand for logMsg

showLS :: Show a => a -> LogStr Source

Convert any showable type into a LogStr.

logF Source

Arguments

:: (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.

logT :: ExpQ Source

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.

logException Source

Arguments

:: (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")

logFM Source

Arguments

:: (Applicative m, KatipContext m, Katip 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.

logTM :: ExpQ Source

Loc-tagged logging when using template-haskell. Automatically supplies payload and namespace.

$(logt) InfoS "Hello world"

logItemM :: (Applicative m, KatipContext m, Katip 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.

logExceptionM Source

Arguments

:: (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

Included Scribes

mkHandleScribe :: ColorStrategy -> Handle -> Severity -> Verbosity -> IO Scribe Source

Logs to a file handle such as stdout, stderr, or a file.

data ColorStrategy Source

Constructors

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

Instances

MonadTrans KatipContextT 
MonadTransControl KatipContextT 
MonadBase b m => MonadBase b (KatipContextT m) 
MonadBaseControl b m => MonadBaseControl b (KatipContextT m) 
MonadWriter w m => MonadWriter w (KatipContextT m) 
MonadState s m => MonadState s (KatipContextT m) 
MonadReader r m => MonadReader r (KatipContextT m) 
MonadError e m => MonadError e (KatipContextT m) 
Alternative m => Alternative (KatipContextT m) 
Monad m => Monad (KatipContextT m) 
Functor m => Functor (KatipContextT m) 
MonadFix m => MonadFix (KatipContextT m) 
MonadPlus m => MonadPlus (KatipContextT m) 
Applicative m => Applicative (KatipContextT m) 
MonadThrow m => MonadThrow (KatipContextT m) 
MonadMask m => MonadMask (KatipContextT m) 
MonadCatch m => MonadCatch (KatipContextT m) 
MonadIO m => MonadIO (KatipContextT m) 
MonadIO m => Katip (KatipContextT m) 
MonadIO m => KatipContext (KatipContextT m) 
type StT KatipContextT a = StT (ReaderT KatipContextTState) a 
type StM (KatipContextT m) a = ComposeSt KatipContextT m a