katip-effectful-0.0.1: Katip integration for Effectful
Safe HaskellSafe-Inferred
LanguageGHC2021

Effectful.Katip

Description

 
Synopsis

Framework Types

newtype Namespace #

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

Instances

Instances details
FromJSON Namespace 
Instance details

Defined in Katip.Core

ToJSON Namespace 
Instance details

Defined in Katip.Core

IsString Namespace 
Instance details

Defined in Katip.Core

Monoid Namespace 
Instance details

Defined in Katip.Core

Semigroup Namespace 
Instance details

Defined in Katip.Core

Generic Namespace 
Instance details

Defined in Katip.Core

Associated Types

type Rep Namespace :: Type -> Type #

Read Namespace 
Instance details

Defined in Katip.Core

Show Namespace 
Instance details

Defined in Katip.Core

Eq Namespace 
Instance details

Defined in Katip.Core

Ord Namespace 
Instance details

Defined in Katip.Core

Lift Namespace 
Instance details

Defined in Katip.Core

Methods

lift :: Quote m => Namespace -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => Namespace -> Code m Namespace #

type Rep Namespace 
Instance details

Defined in Katip.Core

type Rep Namespace = D1 ('MetaData "Namespace" "Katip.Core" "katip-0.8.8.0-A73cXeEEvLzBZHfObcg0CB" 'True) (C1 ('MetaCons "Namespace" 'PrefixI 'True) (S1 ('MetaSel ('Just "unNamespace") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [Text])))

newtype Environment #

Application environment, like prod, devel, testing.

Constructors

Environment 

Fields

Instances

Instances details
FromJSON Environment 
Instance details

Defined in Katip.Core

ToJSON Environment 
Instance details

Defined in Katip.Core

IsString Environment 
Instance details

Defined in Katip.Core

Generic Environment 
Instance details

Defined in Katip.Core

Associated Types

type Rep Environment :: Type -> Type #

Read Environment 
Instance details

Defined in Katip.Core

Show Environment 
Instance details

Defined in Katip.Core

Eq Environment 
Instance details

Defined in Katip.Core

Ord Environment 
Instance details

Defined in Katip.Core

type Rep Environment 
Instance details

Defined in Katip.Core

type Rep Environment = D1 ('MetaData "Environment" "Katip.Core" "katip-0.8.8.0-A73cXeEEvLzBZHfObcg0CB" 'True) (C1 ('MetaCons "Environment" 'PrefixI 'True) (S1 ('MetaSel ('Just "getEnvironment") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text)))

data Severity #

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

Instances

Instances details
FromJSON Severity 
Instance details

Defined in Katip.Core

ToJSON Severity 
Instance details

Defined in Katip.Core

Bounded Severity 
Instance details

Defined in Katip.Core

Enum Severity 
Instance details

Defined in Katip.Core

Generic Severity 
Instance details

Defined in Katip.Core

Associated Types

type Rep Severity :: Type -> Type #

Methods

from :: Severity -> Rep Severity x #

to :: Rep Severity x -> Severity #

Read Severity 
Instance details

Defined in Katip.Core

Show Severity 
Instance details

Defined in Katip.Core

Eq Severity 
Instance details

Defined in Katip.Core

Ord Severity 
Instance details

Defined in Katip.Core

Lift Severity 
Instance details

Defined in Katip.Core

Methods

lift :: Quote m => Severity -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => Severity -> Code m Severity #

type Rep Severity 
Instance details

Defined in Katip.Core

type Rep Severity = D1 ('MetaData "Severity" "Katip.Core" "katip-0.8.8.0-A73cXeEEvLzBZHfObcg0CB" 'False) (((C1 ('MetaCons "DebugS" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "InfoS" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "NoticeS" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "WarningS" 'PrefixI 'False) (U1 :: Type -> Type))) :+: ((C1 ('MetaCons "ErrorS" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "CriticalS" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "AlertS" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "EmergencyS" 'PrefixI 'False) (U1 :: Type -> Type))))

data Verbosity #

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 

Instances

Instances details
FromJSON Verbosity 
Instance details

Defined in Katip.Core

ToJSON Verbosity 
Instance details

Defined in Katip.Core

Bounded Verbosity 
Instance details

Defined in Katip.Core

Enum Verbosity 
Instance details

Defined in Katip.Core

Generic Verbosity 
Instance details

Defined in Katip.Core

Associated Types

type Rep Verbosity :: Type -> Type #

Read Verbosity 
Instance details

Defined in Katip.Core

Show Verbosity 
Instance details

Defined in Katip.Core

Eq Verbosity 
Instance details

Defined in Katip.Core

Ord Verbosity 
Instance details

Defined in Katip.Core

Lift Verbosity 
Instance details

Defined in Katip.Core

Methods

lift :: Quote m => Verbosity -> m Exp #

liftTyped :: forall (m :: Type -> Type). Quote m => Verbosity -> Code m Verbosity #

type Rep Verbosity 
Instance details

Defined in Katip.Core

type Rep Verbosity = D1 ('MetaData "Verbosity" "Katip.Core" "katip-0.8.8.0-A73cXeEEvLzBZHfObcg0CB" 'False) ((C1 ('MetaCons "V0" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "V1" 'PrefixI 'False) (U1 :: Type -> Type)) :+: (C1 ('MetaCons "V2" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "V3" 'PrefixI 'False) (U1 :: Type -> Type)))

class ToObject a where #

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 #

Instances

Instances details
ToObject Object 
Instance details

Defined in Katip.Core

Methods

toObject :: Object -> Object #

ToObject SimpleLogPayload 
Instance details

Defined in Katip.Core

ToObject LogContexts 
Instance details

Defined in Katip.Monadic

ToObject () 
Instance details

Defined in Katip.Core

Methods

toObject :: () -> Object #

class ToObject a => LogItem a where #

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 #

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

Instances

Instances details
LogItem SimpleLogPayload 
Instance details

Defined in Katip.Core

LogItem LogContexts 
Instance details

Defined in Katip.Monadic

LogItem () 
Instance details

Defined in Katip.Core

data Item a #

This has everything each log message will contain.

Instances

Instances details
Functor Item 
Instance details

Defined in Katip.Core

Methods

fmap :: (a -> b) -> Item a -> Item b #

(<$) :: a -> Item b -> Item a #

FromJSON a => FromJSON (Item a) 
Instance details

Defined in Katip.Core

ToJSON a => ToJSON (Item a) 
Instance details

Defined in Katip.Core

Generic (Item a) 
Instance details

Defined in Katip.Core

Associated Types

type Rep (Item a) :: Type -> Type #

Methods

from :: Item a -> Rep (Item a) x #

to :: Rep (Item a) x -> Item a #

Show a => Show (Item a) 
Instance details

Defined in Katip.Core

Methods

showsPrec :: Int -> Item a -> ShowS #

show :: Item a -> String #

showList :: [Item a] -> ShowS #

Eq a => Eq (Item a) 
Instance details

Defined in Katip.Core

Methods

(==) :: Item a -> Item a -> Bool #

(/=) :: Item a -> Item a -> Bool #

type Rep (Item a) 
Instance details

Defined in Katip.Core

data Scribe #

Constructors

Scribe 

Fields

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

    How do we write an item to the scribe's output?

  • scribeFinalizer :: IO ()

    Provide a blocking finalizer to call when your scribe is removed. All pending writes should be flushed synchronously. If this is not relevant to your scribe, return () is fine.

  • scribePermitItem :: PermitFunc

    Provide a filtering function to allow the item to be logged, or not. It can check Severity or some string in item's body. The initial value of this is usually created from permitItem. Scribes and users can customize this by ANDing or ORing onto the default with permitAND or permitOR

Instances

Instances details
Monoid Scribe 
Instance details

Defined in Katip.Core

Semigroup Scribe

Combine two scribes. Publishes to the left scribe if the left would permit the item and to the right scribe if the right would permit the item. Finalizers are called in sequence from left to right.

Instance details

Defined in Katip.Core

data LogEnv #

Constructors

LogEnv 

Fields

data SimpleLogPayload #

Instances

Instances details
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.

Instance details

Defined in Katip.Core

Monoid SimpleLogPayload 
Instance details

Defined in Katip.Core

Semigroup SimpleLogPayload 
Instance details

Defined in Katip.Core

LogItem SimpleLogPayload 
Instance details

Defined in Katip.Core

ToObject SimpleLogPayload 
Instance details

Defined in Katip.Core

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

Construct a simple log from any JSON item.

defaultScribeSettings :: ScribeSettings #

Reasonable defaults for a scribe. Buffer size of 4096.

data ScribeSettings #

Instances

Instances details
Show ScribeSettings 
Instance details

Defined in Katip.Core

Eq ScribeSettings 
Instance details

Defined in Katip.Core

lens-Compatible Lenses

itemApp :: forall a f. Functor f => (Namespace -> f Namespace) -> Item a -> f (Item a) #

itemEnv :: forall a f. Functor f => (Environment -> f Environment) -> Item a -> f (Item a) #

itemSeverity :: forall a f. Functor f => (Severity -> f Severity) -> Item a -> f (Item a) #

itemThread :: forall a f. Functor f => (ThreadIdText -> f ThreadIdText) -> Item a -> f (Item a) #

itemHost :: forall a f. Functor f => (HostName -> f HostName) -> Item a -> f (Item a) #

itemProcess :: forall a f. Functor f => (ProcessID -> f ProcessID) -> Item a -> f (Item a) #

itemPayload :: forall a1 a2 f. Functor f => (a1 -> f a2) -> Item a1 -> f (Item a2) #

itemMessage :: forall a f. Functor f => (LogStr -> f LogStr) -> Item a -> f (Item a) #

itemTime :: forall a f. Functor f => (UTCTime -> f UTCTime) -> Item a -> f (Item a) #

itemNamespace :: forall a f. Functor f => (Namespace -> f Namespace) -> Item a -> f (Item a) #

itemLoc :: forall a f. Functor f => (Maybe Loc -> f (Maybe Loc)) -> Item a -> f (Item a) #

Effect

data KatipE m a Source #

A Effect you can use to run logging actions. there is only one effect as we can't have duplicated instances.

Instances

Instances details
type DispatchOf KatipE Source # 
Instance details

Defined in Effectful.Katip

data StaticRep KatipE Source # 
Instance details

Defined in Effectful.Katip

Running The Effect

runKatipE :: forall es a. IOE :> es => LogEnv -> Eff (KatipE : es) a -> Eff es a Source #

Run a KatipE Effect without a Namespace or a LogContexts. This also calls closeScribes

runKatipContextE :: forall es a a1. (LogItem a, IOE :> es) => LogEnv -> a -> Namespace -> Eff (KatipE : es) a1 -> Eff es a1 Source #

Run a KatipE Effect with a Namespace and a LogContexts. this also calls closeScribes

startKatipE :: IOE :> es => Namespace -> Environment -> Eff (KatipE : es) a -> Eff es a Source #

Run a KatipE Effect without a Namespace or a LogContexts and creating a LogEnv

startKatipContextE :: (IOE :> es, LogItem a) => Environment -> a -> Namespace -> Eff (KatipE : es) a1 -> Eff es a1 Source #

Run a KatipE Effect with a Namespace and a LogContexts and creating a LogEnv

Initializing Loggers

registerScribe :: KatipE :> es => Text -> Scribe -> ScribeSettings -> Eff es () Source #

Add a scribe to the list. All future log calls will go to this scribe in addition to the others. Writes will be buffered per the ScribeSettings to prevent slow scribes from slowing down logging. Writes will be dropped if the buffer fills.

Dropping Scribes Temporarily

unregisterScribe #

Arguments

:: Text

Name of the scribe

-> LogEnv 
-> LogEnv 

Remove a scribe from the environment. This does not finalize the scribe. This mainly only makes sense to use with something like MonadReader's local function to temporarily disavow a single logger for a block of code.

clearScribes :: LogEnv -> LogEnv #

Unregister all scribes. Note that this is not for closing or finalizing scribes, use closeScribes for that. This mainly only makes sense to use with something like MonadReader's local function to temporarily disavow any loggers for a block of code.

Finalizing Scribes At Shutdown

closeScribe :: KatipE :> es => Text -> Eff es () Source #

Finalize a scribe early. Note that it isn't necessary to call this as both runKatipE and runKatipContextE call closeScribes

Logging Functions

newtype LogStr #

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

Constructors

LogStr 

Fields

Instances

Instances details
FromJSON LogStr 
Instance details

Defined in Katip.Core

IsString LogStr 
Instance details

Defined in Katip.Core

Methods

fromString :: String -> LogStr #

Monoid LogStr 
Instance details

Defined in Katip.Core

Semigroup LogStr 
Instance details

Defined in Katip.Core

Generic LogStr 
Instance details

Defined in Katip.Core

Associated Types

type Rep LogStr :: Type -> Type #

Methods

from :: LogStr -> Rep LogStr x #

to :: Rep LogStr x -> LogStr #

Show LogStr 
Instance details

Defined in Katip.Core

Eq LogStr 
Instance details

Defined in Katip.Core

Methods

(==) :: LogStr -> LogStr -> Bool #

(/=) :: LogStr -> LogStr -> Bool #

type Rep LogStr 
Instance details

Defined in Katip.Core

type Rep LogStr = D1 ('MetaData "LogStr" "Katip.Core" "katip-0.8.8.0-A73cXeEEvLzBZHfObcg0CB" 'True) (C1 ('MetaCons "LogStr" 'PrefixI 'True) (S1 ('MetaSel ('Just "unLogStr") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Builder)))

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

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 #

Shorthand for logStr

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

Convert any showable type into a LogStr.

Katip Logging Functions

getLogEnv :: forall es. KatipE :> es => Eff es LogEnv Source #

get the KatipE LogEnv

localLogEnv :: forall es a. KatipE :> es => (LogEnv -> LogEnv) -> Eff es a -> Eff es a Source #

temporarily modify the LogEnv

logF :: forall a es. (LogItem a, KatipE :> es) => a -> Namespace -> Severity -> LogStr -> Eff es () Source #

Log with full context, but without any code location.

logMsg :: forall es. KatipE :> es => Namespace -> Severity -> LogStr -> Eff es () Source #

Log a message without any payload/context or code location.

logLoc :: (LogItem a, KatipE :> es, HasCallStack) => a -> Namespace -> Severity -> LogStr -> Eff es () Source #

Loc-tagged logging using Stack when available. This function does not require template-haskell as it automatically uses implicit-callstacks when the code is compiled using GHC > 7.8. Using an older version of the compiler will result in the emission of a log line without any location information, so be aware of it. logLoc obj mempty InfoS "Hello world"

logItem :: (LogItem a, KatipE :> es) => a -> Namespace -> Maybe Loc -> Severity -> LogStr -> Eff es () Source #

Log with everything, including a source code location. This is very low level and you typically can use logT in its place.

logKatipItem :: (LogItem a, KatipE :> es) => Item a -> Eff es () Source #

Log an already constructed Item. This is the lowest level function that other log* functions use. It can be useful when implementing centralised logging services.

logException :: (LogItem a, KatipE :> es) => a -> Namespace -> Severity -> Eff es b -> Eff es b Source #

Perform an action while logging any exceptions that may occur. >>> > logException () mempty ErrorS (error "foo")

KatipContext Logging Functions

localKatipContext :: forall es a. KatipE :> es => (LogContexts -> LogContexts) -> Eff es a -> Eff es a Source #

temporarily modify the LogContexts

localKatipNamespace :: forall es a. KatipE :> es => (Namespace -> Namespace) -> Eff es a -> Eff es a Source #

temporarily modify the Namespace

logFM :: KatipE :> es => Severity -> LogStr -> Eff es () Source #

Log with full context, but without any code location. Automatically supplies payload and namespace.

logLocM :: (KatipE :> es, HasCallStack) => Severity -> LogStr -> Eff es () Source #

Loc-tagged logging when using getCallStack implicit-callstacks. Automatically supplies payload and namespace. Same consideration as logLoc applies By default, location will be logged from the module that invokes logLocM. If you want to use logLocM in a helper, wrap the entire helper in withFrozenCallStack to retain the callsite of the helper in the logs. This function does not require template-haskell. logLocM InfoS "Hello world"

logItemM :: (KatipE :> es, HasCallStack) => Maybe Loc -> Severity -> LogStr -> Eff es () Source #

Log with everything, including a source code location. This is very low level and you typically can use logTM in its place. Automatically supplies payload and namespace.

logExceptionM :: KatipE :> es => Eff es a -> Severity -> Eff es a Source #

Perform an action while logging any exceptions that may occur. >>> > error "foo" logExceptionM ErrorS

data AnyLogContext #

A wrapper around a log context that erases type information so that contexts from multiple layers can be combined intelligently.

data LogContexts #

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 #

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

Temporarily Changing Log Behaviour

katipAddNamespace :: KatipE :> es => Namespace -> Eff es a -> Eff es a Source #

Append a namespace segment to the current namespace for the given monadic action, then restore the previous state afterwards.

katipAddContext :: (KatipE :> es, LogItem i) => i -> Eff es a -> Eff es 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 :: KatipE :> es => Eff es a -> Eff es a Source #

Disable all scribes for the given monadic action, then restore them afterwards.

Included Scribes

mkHandleScribe :: forall es. KatipE :> es => ColorStrategy -> Handle -> PermitFunc -> Verbosity -> Eff es 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][PID 1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:32:7] Started [2016-05-11 21:01:15][MyApp.confrabulation][Debug][myhost.example.com][PID 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][PID 1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:43:7] Namespace and context are back to normal Returns the newly-created Scribe. The finalizer flushes the handle. Handle mode is set to LineBuffering automatically.

mkHandleScribeWithFormatter :: forall es. KatipE :> es => (forall a. LogItem a => ItemFormatter a) -> ColorStrategy -> Handle -> PermitFunc -> Verbosity -> Eff es Scribe Source #

Logs to a file handle such as stdout, stderr, or a file. Takes a custom ItemFormatter that can be used to format Item as needed. Returns the newly-created Scribe. The finalizer flushes the handle. Handle mode is set to LineBuffering automatically.

mkFileScribe :: forall es. KatipE :> es => FilePath -> PermitFunc -> Verbosity -> Eff es Scribe Source #

A specialization of mkHandleScribe that takes a FilePath instead of a Handle. It is responsible for opening the file in AppendMode and will close the file handle on closeScribe/closeScribes. Does not do log coloring. Sets handle to LineBuffering mode.

data ColorStrategy #

Constructors

ColorLog Bool

Whether to use color control chars in log output

ColorIfTerminal

Color if output is a terminal

Instances

Instances details
Show ColorStrategy 
Instance details

Defined in Katip.Scribes.Handle

Eq ColorStrategy 
Instance details

Defined in Katip.Scribes.Handle

type ItemFormatter a = Bool -> Verbosity -> Item a -> Builder #

A custom ItemFormatter for logging Items. Takes a Value indicating whether to colorize the output, Verbosity of output, and an Item to format.

See bracketFormat and jsonFormat for examples.

bracketFormat :: LogItem a => ItemFormatter a #

A traditional bracketed log format. Contexts and other information will be flattened out into bracketed fields. For example:

[2016-05-11 21:01:15][MyApp][Info][myhost.example.com][PID 1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:32:7] Started
[2016-05-11 21:01:15][MyApp.confrabulation][Debug][myhost.example.com][PID 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][PID 1724][ThreadId 1154][main:Helpers.Logging Helpers/Logging.hs:43:7] Namespace and context are back to normal

jsonFormat :: LogItem a => ItemFormatter a #

Logs items as JSON. This can be useful in circumstances where you already have infrastructure that is expecting JSON to be logged to a standard stream or file. For example:

{"at":"2018-10-02T21:50:30.4523848Z","env":"production","ns":["MyApp"],"data":{},"app":["MyApp"],"msg":"Started","pid":"10456","loc":{"loc_col":9,"loc_pkg":"main","loc_mod":"Helpers.Logging","loc_fn":"Helpers\\Logging.hs","loc_ln":44},"host":"myhost.example.com","sev":"Info","thread":"ThreadId 139"}
{"at":"2018-10-02T21:50:30.4523848Z","env":"production","ns":["MyApp","confrabulation"],"data":{"confrab_factor":42},"app":["MyApp"],"msg":"Confrabulating widgets, with extra namespace and context","pid":"10456","loc":{"loc_col":11,"loc_pkg":"main","loc_mod":"Helpers.Logging","loc_fn":"Helpers\\Logging.hs","loc_ln":53},"host":"myhost.example.com","sev":"Debug","thread":"ThreadId 139"}
{"at":"2018-10-02T21:50:30.4523848Z","env":"production","ns":["MyApp"],"data":{},"app":["MyApp"],"msg":"Namespace and context are back to normal","pid":"10456","loc":{"loc_col":9,"loc_pkg":"main","loc_mod":"Helpers.Logging","loc_fn":"Helpers\\Logging.hs","loc_ln":55},"host":"myhost.example.com","sev":"Info","thread":"ThreadId 139"}

Tools For Implementing Scribes

type PermitFunc = forall a. Item a -> IO Bool #

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 lower than the provided Severity. For instance, if the user passes InfoS, DebugS items should be ignored. Katip provides the permitItem utility for this. The user or the scribe may use permitAND and permitOR to further customize this filtering, even dynamically if they wish to.

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

Scribes provide a finalizer IO action (scribeFinalizer) that is meant to synchronously flush any remaining writes and clean up any resources acquired when the scribe was created. Internally, katip keeps a buffer for each scribe's writes. When closeScribe or closeScribes is called, that buffer stops accepting new log messages and after the last item in its buffer is sent to liPush, calls the finalizer. Thus, when the finalizer returns, katip can assume that all resources are cleaned up and all log messages are durably written.

While katip internally buffers messages per ScribeSettings, it sends them one at a time to the scribe. Depending on the scribe itself, it may make sense for that scribe to keep its own internal buffer to batch-send logs if writing items one at a time is not efficient. The scribe implementer must be sure that on finalization, all writes are committed synchronously.

Signature of a function passed to Scribe constructor and mkScribe* functions that decides which messages to be logged. Typically filters based on Severity, but can be combined with other, custom logic with permitAND and permitOR

permitAND :: PermitFunc -> PermitFunc -> PermitFunc #

AND together 2 permit functions

permitOR :: PermitFunc -> PermitFunc -> PermitFunc #

OR together 2 permit functions

permitItem :: Monad m => Severity -> Item a -> m Bool #

Should this item be logged given the user's maximum severity? Most new scribes will use this as a base for their PermitFunc

payloadObject :: LogItem a => Verbosity -> a -> Object #

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 #

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.

Orphan instances

(IOE :> es, KatipE :> es) => Katip (Eff es) Source # 
Instance details

Methods

getLogEnv :: Eff es LogEnv #

localLogEnv :: (LogEnv -> LogEnv) -> Eff es a -> Eff es a #

(IOE :> es, KatipE :> es) => KatipContext (Eff es) Source # 
Instance details