First off I want a monad for the logging itself. It's just a collection of functions taking a LogMsg and returning unit (in a monad).

class Monad m => LoggerActions m where
    debug :: LogMsg -> m ()
    info :: LogMsg -> m ()
    warn :: LogMsg -> m ()
    err :: LogMsg -> m ()
    fatal :: LogMsg -> m ()

In order to provide a default implementation I also need a way to extract the logger itself.

class Monad m => HasLogger m where
    getLogger :: m Logger

Using the two typeclasses above it's now possible to define a type with an implementation of LoggerActions that is usable with deriving via.

newtype StdLoggerActions m a = MkStdZLA (m a)
    deriving (Functor, Applicative, Monad, MonadIO, HasLogger)

And its implementattion of LoggerActions looks like this:

instance (HasLogger m, MonadIO m) => LoggerActions (StdLoggerActions m) where
    debug msg = getLogger >>= flip debugIO msg
    info msg = getLogger >>= flip infoIO msg
    warn msg = getLogger >>= flip warnIO msg
    err msg = getLogger >>= flip errIO msg
    fatal msg = getLogger >>= flip fatalIO msg

Using the definitions above is fairly straight forward. First a type the derives its implementaiton of LoggerActions from StdLoggerActions.

newtype EnvT a = EnvT {runEnvT :: ReaderT Logger IO a}
    deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader Logger)
    deriving (LoggerActions) via (StdLoggerActions EnvT)

In order for it to work, and compile, it needs an implementation of HasLogger too.

instance HasLogger EnvT where
    getLogger = ask

All that's left is a function using a constraint on LoggerActions (doStuff) and a main function creating a logger, constructing an EnvT, and then running doStuff in it.

doStuff :: LoggerActions m => m ()
doStuff = do
    debug "a log line"
    info $ "another log line" #+ ["extras" .= (42 :: Int)]

main :: IO ()
main = withLogger $ \logger ->
    runReaderT (runEnvT doStuff) logger

The logger will be a wrapper around fast-logger's FastLogger, even though that's not really visible.

newtype Logger = Logger (LogMsg -> IO ())

It's nature as a wrapper makes it natural to follow the API of fast-logger, with some calls to liftIO added.

newLogger :: MonadIO m => m (Logger, m ())
newLogger = liftIO $ do
    (fastLogger, cleanUp) <- newFastLogger $ LogStdout defaultBufSize
    pure (Logger (fastLogger . toLogStr @LogMsg), liftIO cleanUp)

The implementation of withLogger is pretty much a copy of what I found in fast-logger, just adapted to the newLogger above.

withLogger :: (MonadMask m, MonadIO m) => (Logger -> m ()) -> m ()
withLogger go = bracket newLogger snd (go . fst)

All logging functions will follow the same pattern so it's easy to break out the common parts.

logIO :: MonadIO m => Text -> Logger -> LogMsg -> m ()
logIO lvl (Logger ls) msg = do
    t <- formatTime defaultTimeLocale "%y-%m-%dT%H:%M:%S%03QZ" <$> liftIO getCurrentTime
    let bmsg = "" :# [ "correlation-id" .= ("no-correlation-id" :: Text)
                     , "timestamp" .= t
                     , "level" .= lvl
                     ]
    liftIO $ ls $ bmsg <> msg

With that in place the logging functions become very short and sweet.

debugIO, infoIO, warnIO, errIO, fatalIO :: MonadIO m => Logger -> LogMsg -> m ()
debugIO = logIO "debug"
infoIO = logIO "info"
warnIO = logIO "warn"
errIO = logIO "error"
fatalIO = logIO "fatal"

A very simple example showing how it could be used would be something like this

main :: IO ()
main = withLogger $ \logger -> do
    debugIO logger "a log line"
    infoIO logger $ "another log line" #+ ["extras" .= (42 :: Int)]

I decided that a log message must always contain the text describing the event. It's the one thing that's sure to be known at the point where the developer writes the code to log an event. All the other mandatory parts can, and probably should as far as possible, be added by the logging library itself. So I ended up with this type.

data LogMsg = Text :# [Pair]
    deriving (Eq, Show)

It should however be easy to add custom parts at the point of logging, so I added an operator for that.

(#+) :: LogMsg -> [Pair] -> LogMsg
(#+) (msg :# ps0) ps1 = msg :# (ps0 <> ps1)

The ordering is important, i.e. ps0 <> ps1, as aeson's object function will take the last value for a field and I want to be able to give keys in a log message new values by overwriting them later on.

The previous logging code used fast-logger and it had worked really well so I decided to stick with it. Making LogMsg and instance of ToLogStr is key, and as the rules require logging of JSON objects it also needs to be an instance of ToJSON.

instance ToJSON LogMsg where
    toJSON (msg :# ps) = object $ ps <> ["message" .= msg]

instance ToLogStr LogMsg where
    toLogStr msg = toLogStr (encode msg) <> "\n"

It's common to just want to log a single string and nothing else, so it's handy if LogMsg is an instance of IsString.

instance IsString LogMsg where
    fromString msg = pack msg :# []

When writing the previous logging code I'd regularly felt pain from the lack of a nice way to combine log messages. With the definition of LogMsg above it's not difficult to come up with reasonable instances for both Semigroup and Monoid.

instance Semigroup LogMsg where
    "" :# ps0 <> msg1 :# ps1 = msg1 :# (ps0 <> ps1)
    msg0 :# ps0 <> "" :# ps1 = msg0 :# (ps0 <> ps1)
    msg0 :# ps0 <> msg1 :# ps1 = (msg0 <> " - " <> msg1) :# (ps0 <> ps1)

instance Monoid LogMsg where
    mempty = ""

What's missing above is the automatic handling of the remaining fields. I'll try to get back to that part soon. For now I'll just say that the log message API above made the implementation nice and straight forward.