co-log-json-0.0.1.0: Structured messages support in co-log ecosystem.
Safe HaskellNone
LanguageHaskell2010

Colog.Json

Description

Top-level module for structured logging support. Structured logging provides messages in a machine-readable format and passing an additional user data to the messages (context) to the log messages, and tooling that allows keep track of the current context and attach it to all the messages.

Short example:

logic :: LoggerEnv -> Int -> IO ()
logic ctx' entity_id = do                   -- (1)
   logInfo ctx "start processing entity"    -- (2)
   internal ctx entity_id                   -- (3)
   logInfo ctx "finish processing
  where
    ctx = addNamespace "logic"              -- (4)
        . addContext (sl "id" entity_id)    -- (5)
        $ ctx'

Here we:

  • (1) pass initial context (ctx' :: LoggerEnv)
  • (2) log message on InfoS severtity level with new context attached
  • (3) start internal fuction with new context
  • (4) extend initial context with a new namespace
  • (5) extend initial context with a new user data

NOTE You may notice a bit of an extra boilerplate code here. It can be removed by using any effect handling approach, like ReaderT, MTL, various effects system or service pattern. However this library does not commit to any of those approaches and provides simple IO interface, so there can be a light wrapper with the system of your choice. E.g. The library author prefer to use ImplicitParams extension, as you can see in cheops-logger package.

Synopsis

Documentation

For each message we attach additional information

  • thread id — it can be useful to group messages by the thread when debugging, especially in a case if a thread can be associated with the request processing.
  • namespace. delimited text that describes the component that the log was emitted from. It allows simple logs filtering in an external system, or in the logger action.
  • severity — information how urgent the message is.
  • user_data - any user data in a key-value form, the key is a text value, and the value is a JSON-encoded value.

In order to keep track of that information we introduce LoggerEnv handle. It can be used to emit messages with additional information, see writing logs section, and modify current context, see adding context section.

data LoggerEnv Source #

Logger environment is used to keep information about the current context and modify it. When any log message is emitted the current context is added to the message.

mkLogger :: LogAction IO Message -> LoggerEnv Source #

Covert ordinary colog action into LoggerEnv this way we can keep track of the current context and modify it.

let ctx = mkLogger (logToHandle stderr)
in logDebug ctx "message"

emptyLogger :: LoggerEnv Source #

Logger that does nothing. Useful for the testing purpose.

unLogger :: LoggerEnv -> LogAction IO (Severity, LogStr) Source #

Covert LoggerEnv back into colog LogAction, so we can combie it with the rest of the colog ecosystem.

cfilter (\(sev, _) -> sev > DebugS) unLogger ctx

Writing logs

Logs can we written using one of the following helpers. The general pattern is

logDebug logger "message"

Messages has type LogStr. This is an abstraction over a data-type for efficient log concatenation. Currently it uses Builder but it's an implementation detail and may change in the future.

LogStr can be created is several ways:

  • From the string literal using IsString interface
  • From the string like data that can be converted to text, using ls function
  • From the type that has a Show instance using showLS

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

Convert message can be converted.

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

Convert loggable value from any message that has show instance.

data LogStr Source #

Efficient message builder.

Instances

Instances details
IsString LogStr Source # 
Instance details

Defined in Colog.Json.Internal.Structured

Methods

fromString :: String -> LogStr #

Semigroup LogStr Source # 
Instance details

Defined in Colog.Json.Internal.Structured

Monoid LogStr Source # 
Instance details

Defined in Colog.Json.Internal.Structured

Library provides helper for each Severity level.

logInfo :: MonadIO m => LoggerEnv -> LogStr -> m () Source #

logErr :: MonadIO m => LoggerEnv -> LogStr -> m () Source #

logWarn :: MonadIO m => LoggerEnv -> LogStr -> m () Source #

logCrit :: MonadIO m => LoggerEnv -> LogStr -> m () Source #

data Severity Source #

Logger severity.

Constructors

DebugS

Debug level, intended for internal information

InfoS

Info level, that may be interesting to the user

NoticeS

Notice, information that

WarningS

Warning, information possible problem problem of some sort

ErrorS

Error, information about a problem

CriticalS

Critical error, intended for error that may break the system

AlertS

Critical error where immediate actions should be taken

EmergencyS

System wide emergency

Adding context

Messages in the library forms a stack, and you can attach 2 kinds of data to it:

  1. namespace - a list of locations, that allows to tell that the component is it.
  2. context - context is a list of key-value pairs, where key is a text and a value is any JSON value.

When you attach that information to the LoggerContext it will be added to each message that is written in that context. Allowing to analyze data in the external systems. User data is pushed as using PushContext wrapper, that can be created using sl.

addContext Source #

Arguments

:: PushContext

New data to store

-> LoggerEnv

Old context.

-> LoggerEnv 

Helper to update context, by appending another item to the log.

local (addContext (sl "key" "value")) $ do
  ...

sl :: ToJSON a => Text -> a -> PushContext Source #

"Simple logger" adds a key value to the context:

sl "foo" 123

Will add "foo":123 key pair to the current list of the attributes. Submitted value is stored with json encoding.

addNamespace :: Text -> LoggerEnv -> LoggerEnv Source #

Helper to extend current namespace by appending sub-namespace.

local (addNamespace "subcomponent") $ do
  ...