co-log: Composable Contravariant Combinatorial Comonadic Configurable Convenient Logging

Date: September 25, 2018
Author: Dmitrii Kovanikov
haskell logging contravariant comonad library

This blog post illustrates the architecture of the co-log library: a composable Haskell logging library that explores an alternative way of logging. I’m not going to cover how to implement the ElasticSearch backend for the logging library or how to make concurrent logging fast. Instead, the blog post explains the core ideas of the new design. I’m going to describe in details and with examples how one can build a flexible, extensible and configurable logging framework using different parts of Haskell — from monad transformers and contravariant functors to comonads and type-level programming with dependent types.

If you want to go straight to the library’s source code, you can follow the link below:

Introduction🔗

There are already several logging frameworks within the Haskell ecosystem and every library has its own idea and architecture:

So you might ask, why create another library? The motivation behind co-log is to explore a new strategy that allows having a composable and combinatorial logging library that is easy to extend and use. This is achieved by decomposing the logging task into smaller pieces:

  • What to log: text, message data type, JSON
  • Where to log: to the terminal, to some file, to an external service
  • How to format the output: coloured text or JSON
  • How to log: with logger rotation, only to stderr or something else
  • What context to work in: pure or some IO
  • How to change context: append logs to in-memory storage or change filesystem

The co-log framework is currently split into two packages:

  • co-log-core: lightweight library with core data types and basic combinators
  • co-log: implementation of a logging library based on co-log-core

In the following sections, I’m going to describe the main ideas behind these two packages alongside with some implementation details.

LogAction🔗

This section introduces the fundamental piece in the co-log design: the LogAction data type.

Data type🔗

The main piece of the co-log logging library is the following structure:

newtype LogAction m msg = LogAction
    { unLogAction :: msg -> m ()
    }

This is a wrapper around a simple function. It has two type variables:

  • m: monad in which the logging is happening
  • msg: the logging message itself

LogAction specifies the type of message you want to log and the context in which you want to perform the logging. So you can tune and configure your action (or, even better: create a compound action by combining smaller pieces) and use it later.

Here is an example of a very straightforward action:

logStringStdout :: LogAction IO String
logStringStdout = LogAction putStrLn

NOTE: For simplicity purposes this blog post uses String data type for logging. In practice, it’s better to use Text or ByteString data types instead of String as they provide better performance. Even better, you can use Backpack and implement a general interface around backpack-str package.

How to use it?🔗

Once you’ve created LogAction, you need to use it in your application. There are multiple ways to use LogAction in your code since it’s just a value:

  • Pass it as an argument to your functions explicitly each time
  • Use Handle design pattern and store LogAction there
  • Store it in a separate ReaderT layer
  • Store it in your own ReaderT environment
  • Use an extensible-effects library like freer-simple
  • Use caps framework
  • Etc.

Every solution has its own advantages and drawbacks. That’s why the LogAction data type is in the co-log-core package: so it’s possible to experiment with different approaches and use the main concepts of the co-log library without bringing extra dependencies to your project.

The simplest solution is to pass LogAction explicitly as an argument to every function where you need logging. The co-log-core library has this helpful combinator:

infix 5 <&
(<&) :: LogAction m msg -> msg -> m ()
(<&) = coerce

So you can pass messages to actions using this operator:

ghci> logStringStdout <& "Foo"
Foo
ghci> logStringStdout <& "Hello" >> logStringStdout <& "World!"
Hello
World!

In the remaining part of the blog post I’m going to use the following approach supported by co-log.

First, let’s introduce a newtype wrapper around ReaderT that stores LogAction in its own environment:

newtype LoggerT msg m a = LoggerT
    { runLoggerT :: ReaderT (LogAction (LoggerT msg m) msg) m a
    } deriving ( Functor, Applicative, Monad, MonadIO
               , MonadReader (LogAction (LoggerT msg m) msg)
               )

This data type looks scary but the idea is simple: it just stores LogAction m msg in the ReaderT environment.

The co-log-core package also has its own lens-like HasLog typeclass that allows to get and set LogAction in your environment (so you can just add LogAction to your ReaderT context instead of using LoggerT monad transformer):

class HasLog env msg m where
    getLogAction :: env -> LogAction m msg
    setLogAction :: LogAction m msg -> env -> env

instance HasLog (LogAction m msg) msg m where
    getLogAction = id
    setLogAction = const

Now we can write a function that logs messages using LogAction from the context:

type WithLog env msg m = (MonadReader env m, HasLog env msg m)

logMsg :: forall msg env m . WithLog env msg m => msg -> m ()
logMsg msg = do
    LogAction log <- asks getLogAction
    log msg

We now need some way to execute actions with logging:

usingLoggerT :: Monad m => LogAction m msg -> LoggerT msg m a -> m a

After implementing usingLoggerT we can now play with our logging framework.

example :: WithLog env String m => m ()
example = do
    logMsg "Starting application..."
    logMsg "Finishing application..."

main :: IO ()
main = usingLoggerT logStringStdout example

And the output is exactly what we expected:

Starting application...
Finishing application...

Composable🔗

Semigroup🔗

Let’s see how to make our LogAction composable. Currently, we have only one action that prints String to stdout. What if we also want to print the same String to stderr in addition? Or to some file? Of course, we can create a separate LogAction that does just that:

logStringBoth :: LogAction IO String
logStringBoth = LogAction $ \msg -> do
    putStrLn msg
    hPutStrLn stderr msg

We start to notice a pattern: we often want to perform multiple actions over a single message. This is where Semigroup comes in:

instance Applicative m => Semigroup (LogAction m a) where
    (<>) :: LogAction m a -> LogAction m a -> LogAction m a
    LogAction action1 <> LogAction action2 =
        LogAction $ \a -> action1 a *> action2 a

So instead of manually specifying what we want to do on every message, we can create our LogAction by combining different smaller and independent pieces.

logStringStdout :: LogAction IO String
logStringStdout = LogAction putStrLn

logStringStderr :: LogAction IO String
logStringStderr = LogAction $ hPutStrLn stderr

logStringBoth :: LogAction IO String
logStringBoth = logStringStdout <> logStringStderr

Monoid🔗

The Monoid instance is even simpler:

instance Applicative m => Monoid (LogAction m a) where
    mempty :: LogAction m a
    mempty = LogAction $ \_ -> pure ()

It adds the empty LogAction that does nothing to the Semigroup instance. It’s quite straightforward to show that the above instances satisfy associativity and neutrality laws. The nice thing about the Monoid instance is the ability to disable logging. Usually, logging libraries provide some extra transformer with a name like NoLoggingT which you can put on top of your monad transformer tower to disable logging. But with a Monoid instance for LogAction you can just pass mempty as your logging action and that’s all. This approach also works quite well if you want to disable logging only in some specific piece of your code.

Contravariant functors🔗

This section covers the contravariant family of typeclasses regarding LogAction. The typeclasses themselves are implemented in the contravariant package. This section assumes some basic knowledge for Contravariant functors, if you’re not familiar with them, I strongly recommend watching the following talk by George Wilson:

Contravariant🔗

contramap🔗

Let’s first have a look at Contravariant typeclass and its instance for LogAction:

class Contravariant f where
    contramap :: (a -> b) -> f b -> f a

instance Contravariant (LogAction m) where
    contramap :: (a -> b) -> LogAction m b -> LogAction m a
    contramap f (LogAction action) = LogAction (action . f)

Here is how you can think of this instance: if you know how to log messages of type b and you know how to convert messages of type a to type b, then you also know how to log messages of type a. You just need to convert the a message to b and pass it to your action.

Here is an example of how it can be useful. Let’s say that instead of just logging String, you want to log a more complex Message data type:

data Severity = Debug | Info | Warning | Error
    deriving (Eq, Ord, Show)

data Message = Message
    { messageSeverity :: Severity
    , messageText     :: String
    }

But you only have LogAction that prints String. This is no longer a problem! You can write the formatting function:

fmtMessage :: Message -> String
fmtMessage (Message sev txt) = "[" ++ show sev ++ "] " ++ txt

And then you can use contramap to log messages instead of String.

log :: WithLog env Message m => Severity -> String -> m ()
log sev txt = logMsg (Message sev txt)

example :: WithLog env Message m => m ()
example = do
    log Debug "Starting application..."
    log Info  "Finishing application..."

main :: IO ()
main = usingLoggerT (contramap fmtMessage logStringStdout) example

The output is the following:

[Debug] Starting application...
[Info] Finishing application...

The problem of showing the output is handled separately from the problem of providing the input to the loggers. If you want to format the output in a different way (as JSON for example) you can just switch the formatting function to a different one.

cfilter🔗

Okay, now we would like to discard any Debug messages from the output. It’s easy to do after writing a contravariant filter function:

cfilter :: Applicative m => (msg -> Bool) -> LogAction m msg -> LogAction m msg
cfilter p (LogAction action) = LogAction $ \a -> when (p a) (action a)

Now you can filter out all the Debug messages in the following way:

main :: IO ()
main = usingLoggerT
    ( cfilter (\(Message sev _) -> sev > Debug)
    $ contramap fmtMessage logStringStdout
    )
    example

cmapM🔗

There’s even more! We’re not satisfied with printing only Severity of the message. We would like to print the timestamp of the logging message as well. This is very useful for further log analysis. But with contramap we can’t do that because taking the current time is an impure function. So let’s implement cmapM function and see how it helps:

cmapM :: Monad m => (a -> m b) -> LogAction m b -> LogAction m a
cmapM f (LogAction action) = LogAction (f >=> action)

Look at how similar it is to contramap:

contramap f (LogAction action) = LogAction (action  .  f)
cmapM     f (LogAction action) = LogAction (action <=< f)

Now we can extend our Message data to RichMessage that also stores UTCTime in it.

data RichMessage = RichMessage
    { richMessageMsg  :: Message
    , richMessageTime :: UTCTime
    }

makeRich :: LogAction IO RichMessage -> LogAction IO Message
makeRich = cmapM toRichMessage
  where
    toRichMessage :: Message -> IO RichMessage
    toRichMessage msg = do
        time <- getCurrentTime
        pure $ RichMessage msg time

After writing the formatting function for RichMessage we can enjoy an automatically appended timestamp to every message!

main :: IO ()
main = usingLoggerT
    (makeRich $ contramap fmtRichMessage logStringStdout)
    example

And now we have a more verbose output:

[Info] [11:54:31.809 13 Sep 2018 UTC] Finishing application...

Divisible🔗

The Functor-Applicative-Alternative family of typeclasses is well-known to most Haskellers. But there are similar typeclasses for contravariant data types. Specifically, Contravariant-Divisible-Decidable. Let’s look at the Divisible typeclass definition and its instance for LogAction:

class Contravariant f => Divisible f where
    conquer :: f a
    divide  :: (a -> (b, c)) -> f b -> f c -> f a

instance (Applicative m) => Divisible (LogAction m) where
    conquer :: LogAction m a
    conquer = mempty

    divide :: (a -> (b, c)) -> LogAction m b -> LogAction m c -> LogAction m a
    divide f (LogAction actionB) (LogAction actionC) =
        LogAction $ \(f -> (b, c)) -> actionB b *> actionC c

What this instance means is that if you know how to split some complex data structure into smaller pieces and if you know how to log each piece independently, you can now log the whole data structure.

Decidable🔗

Decidable is similar to Alternative but for the Contravariant family of functors.

import Data.Void (Void, absurd)

class Divisible f => Decidable f where
  lose   :: (a -> Void) -> f a
  choose :: (a -> Either b c) -> f b -> f c -> f a

instance (Applicative m) => Decidable (LogAction m) where
    lose :: (a -> Void) -> LogAction m a
    lose f = LogAction (absurd . f)

    choose :: (a -> Either b c) -> LogAction m b -> LogAction m c -> LogAction m a
    choose f (LogAction actionB) (LogAction actionC) =
        LogAction (either actionB actionC . f)

The meaning of the Decidable instance for LogAction is that you can look at your logging message and decide what exactly you want to log. And if you know how to log every decision independently, you then can log the message.

Combinators🔗

Using the above instances and combinators from the co-log library, we can now have a combinatorial logging library.

Let’s first introduce the data types we want to log:

data Engine = Pistons Int | Rocket

data Car = Car
    { carMake   :: String
    , carModel  :: String
    , carEngine :: Engine
    }

We also need couple helper functions in order to use the contravariant combinators:

engineToEither :: Engine -> Either Int ()
engineToEither e = case e of
    Pistons i -> Left i
    Rocket    -> Right ()

carToTuple :: Car -> (String, (String, Engine))
carToTuple (Car make model engine) = (make, (model, engine))

Then we’re going to introduce some basic logging actions:

stringL :: LogAction IO String
stringL = logStringStdout

-- Combinator that allows to log any showable value
showL :: Show a => LogAction IO a
showL = cmap show stringL

-- Returns a log action that logs a given string ignoring its input.
constL :: String -> LogAction IO a
constL s = s >$ stringL

intL :: LogAction IO Int
intL = showL

And then, we can add combinators:

(>$<) :: Contravariant f => (b -> a) -> f a -> f b
(>*<) :: Divisible     f => f a -> f b -> f (a, b)
(>|<) :: Decidable     f => f a -> f b -> f (Either a b)
(>*)  :: Divisible     f => f a -> f () -> f a
(*<)  :: Divisible     f => f () -> f a -> f a

So we can log our Car data type in the following way:

-- log action that logs a single car module
carL :: LogAction IO Car
carL = carToTuple
    >$< (constL "Logging make..." *< stringL >* constL "Finished logging make...")
    >*< (constL "Logging model.." *< stringL >* constL "Finished logging model...")
    >*< ( engineToEither
      >$< constL "Logging pistons..." *< intL
      >|< constL "Logging rocket..."
        )

main :: IO ()
main = usingLoggerT carL $ logMsg $ Car "Toyota" "Corolla" (Pistons 4)

And the output is:

Logging make...
Toyota
Finished logging make...
Logging model..
Corolla
Finished logging model...
Logging pistons...
4

This example might look not so convincing. But the approach becomes more useful when you want to log sophisticated data structures as it allows you to divide the message into smaller pieces and decide what to log.

Comonads🔗

Now, let’s talk about one of the most interesting parts of the co-log library. There is the Comonad typeclass which is dual to Monad. It’s implemented in the comonad package:

class Functor w => Comonad w where
    extract :: w a -> a
    extend  :: (w a -> b) -> w a -> w b

And there’s a Comonad instance for the Traced data type:

newtype Traced m a = Traced { runTraced :: m -> a }

instance Monoid m => Comonad (Traced m) where
    extract :: Traced m a -> a
    extract (Traced ma) = ma mempty

    extend :: (Traced m a -> b) -> Traced m a -> Traced m b
    extend f (Traced ma) = Traced $ \m -> f $ Traced $ \m' -> ma (m <> m')

If you look closely at Traced data type, you might recognise similarities with LogAction. Indeed, LogAction can be defined as a special case of the Traced data type.

type LogAction m msg = Traced msg (m ())

Since LogAction is just a special case of the Traced comonad, we can implement the extract and extend functions for LogAction.

extract :: Monoid msg => LogAction m msg -> m ()
extract (LogAction action) = action mempty

extend
    :: Semigroup msg
    => (LogAction m msg -> m ())
    -> LogAction m msg
    -> LogAction m msg
extend f (LogAction action) =
    LogAction $ \m -> f $ LogAction $ \m' -> action (m <> m')

Unfortunately, we can’t implement the Comonad instance for LogAction due to the interface mismatch. It would be possible only if LogAction was defined as a specialized version of the Traced comonad. However, by doing so we would lose other useful properties of defining LogAction as a separate newtype. However, we can still use the comonadic aspect of the LogAction structure. Here is a couple of simple examples of LogAction comonad usage:

ghci> logToStdout = LogAction putStrLn
ghci> f (LogAction l) = l ".f1" *> l ".f2"
ghci> g (LogAction l) = l ".g"
ghci> unLogAction logToStdout "foo"
foo
ghci> unLogAction (extend f logToStdout) "foo"
foo.f1
foo.f2
ghci> unLogAction (extend g $ extend f logToStdout) "foo"
foo.g.f1
foo.g.f2

What this comonadic aspect of the interface means is that you can extend the existing LogAction by passing an additional payload to every message. This only works if your message is a Semigroup (or Monoid) and preferably a commutative Semigroup (or Monoid). For example, Map String String. If you log key-value pairs, you might want to add additional entries depending on the local context. Turns out this is extremely useful for structured logging: if you log JSON values, you might want to add extra keys or tags or values for specific functions and here is where the comonadic interface becomes helpful.

Configurable & Convenient🔗

This section covers how dependent map, type-level programming and the -XOverloadedLabels language extension are used to implement a flexible and extensible interface for logging configuration.

Earlier I’ve introduced the RichMessage data type that allows to extend a simple Message with the result of an IO action:

data RichMessage = RichMessage
    { richMessageMsg  :: Message
    , richMessageTime :: UTCTime
    }

Currently, it stores only the timestamp of the logged message. But in real life we might want to display more information on every logging message:

  • Id of the current thread
  • Id of the current process
  • File size of the file where we currently write logs
  • Application memory usage
  • Number of currently active users (why not?)
  • Any other thing you can imagine

If we only have a simple plain Haskell record we can’t easily extend it. Of course, you can always implement your own RichMessage and format in any way you want, but usually developers expect at least some configuration capabilities from a logging library. And configuring your output through boolean flags is not that convenient. That’s why co-log provides an extensible record interface to make it easier to add or remove some fields and I’m going to describe the implementation below.

The idea behind this solution is the following: let’s use some map to store the actions that extract the required information. So instead of specifying control options for some predefined set of possible message fields, we can just modify the map by adding or removing actions we want to execute on every call to the logging function. But since the actions might return values of different types, we need to use some dependent map.

The assumption here is that usually we configure logging for our application only once at the start of our application and then we only query those actions. So we need some map where construction and modification operations should be supported but their performance is not that important. The efficiency of the lookup function, on the other hand, should be quite high. Fortunately, there’s a structure that implements the required interface. The data structure itself is implemented in the typerep-map package. If you want to learn about the implementation details of the typerep-map library, you can read the following blog post:

We can build extensible records on top of the typerep-map, and I’m going to explain how it’s done in co-log.

First, let’s introduce a type family that maps arbitrary string tags to types.

type family FieldType (fieldName :: Symbol) :: Type
type instance FieldType "threadId" = ThreadId
type instance FieldType "utcTime"  = UTCTime

The type family is open, so users can extend it with anything they want.

Now let’s introduce a data type that stores values of type FieldType inside some monad.

newtype MessageField (m :: Type -> Type) (fieldName :: Symbol) = MessageField
    { unMessageField :: m (FieldType fieldName)
    }

We can now parametrize TypeRepMap with MessageField:

type FieldMap (m :: Type -> Type) = TypeRepMap (MessageField m)

So FieldMap is a mapping from type level string to runtime value inside some monad m, where the type of the runtime value is defined by the value of the type-level string.

There is an existential wrapper in the typerep-map library that allows to create TypeRepMap from a list due to IsList instance:

defaultFieldMap :: MonadIO m => FieldMap m
defaultFieldMap = fromList
    [ WrapTypeable $ MessageField @_ @"threadId" (liftIO myThreadId)
    , WrapTypeable $ MessageField @_ @"utcTime"  (liftIO getCurrentTime)
    ]

Now we can extract monadic actions that return us values by doing lookup @"threadId". Since it’s just a map, you can configure the output by putting additional actions in the map with the insert function or by removing some actions with the delete function. You only need to implement the formatting function for your FieldMap or use the default one from the co-log library.

But that’s not all. There’s the OverloadedLabels extension since GHC 8.0.1 that allows us to specify such FieldMaps in a more convenient way. After writing the following instance:

instance (KnownSymbol fieldName, a ~ m (FieldType fieldName))
      => IsLabel fieldName (a -> WrapTypeable (MessageField m)) where
    fromLabel field = WrapTypeable $ MessageField @_ @fieldName field

The OveloadedLabels extension allows to write #foo instead of fromLabel @"foo". So, by having the above instance for the function we can pass arguments to labels. We’re now able to define defaultFieldMap in a more concise way:

defaultFieldMap :: MonadIO m => FieldMap m
defaultFieldMap = fromList
    [ #threadId (liftIO myThreadId)
    , #utcTime  (liftIO getCurrentTime)
    ]

Here is how the output looks like with ThreadId and without it, for example from the library’s playground:

Logging example

The solution described above is currently implemented only for the IO part of the message extension. But there are plans to make the Message data type extensible as well (see issue below):

Conclusion & unexplored opportunities🔗

The LogAction data type is very simple on its own, but together with different instances, it brings a lot of power:

  • Semigroup: perform multiple actions for the same message
  • Monoid: the action that does nothing
  • Contravariant: the ability to consume action of the different type
  • Divisible: log both types of messages if you know how to log all of them
  • Decidable: decide what to log depending on the message
  • Comonad: add an extra monoidal payload to message possibly using context

There’s also the ComonadApply typeclass which purpose in application to LogAction is yet to be explored. And it would be really great to implement different logging backends for the co-log library (ElasticSearch, PostgreSQL, etc.).

Acknowledgement🔗

If you want to play with this approach in PureScript, there is a library that implements a similar idea: