Demonstration of a possible shim to use monad-logger-aeson from rio's Utf8Builder-based logging facilities

monad-logger-aeson-rio-shim.hs

-- | Description: This module demonstrates the foundations of a shim between
-- @monad-logger-aeson@ and the 'Utf8Builder'-based logging system in "RIO".
--
-- Note that this demonstration does not provide the same level of fanciness
-- "RIO"'s logging can provide when making 'LogFunc' values via 'LogOptions'
-- (e.g. sticky logging). The demonstration also digs into
-- @monad-logger-aeson@'s internals in a couple spots.
--
-- Output (when formatted with @jq@) looks like:
-- {
--   "time": "2022-05-19T14:06:09.1465777Z",
--   "level": "debug",
--   "location": {
--     "package": "main",
--     "module": "Main",
--     "file": "app/readme-example.hs",
--     "line": 28,
--     "char": 3
--   },
--   "message": {
--     "text": "Doing stuff",
--     "meta": {
--       "x": 42
--     }
--   }
-- }
-- {
--   "time": "2022-05-19T14:06:09.1466995Z",
--   "level": "info",
--   "location": {
--     "package": "main",
--     "module": "Main",
--     "file": "app/readme-example.hs",
--     "line": 34,
--     "char": 5
--   },
--   "message": {
--     "text": "Done"
--   }
-- }

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Main
  ( main
  ) where

import Control.Monad.Logger.Aeson (Message(..), (.@))
import GHC.Stack (getCallStack)
import RIO
import qualified Control.Monad.Logger.Aeson as MLA
import qualified Control.Monad.Logger.Aeson.Internal as MLA.Internal
import qualified Data.Aeson.Encoding as Aeson.Encoding
import qualified Data.ByteString.Builder as Builder

doStuff :: Int -> RIO MyApp ()
doStuff x = do
  -- The 'Utf8Builder'-based logging interface in RIO requires that we convert
  -- our 'Message' values to 'Utf8Builder' values.
  logDebug $ fromMessage $ "Doing stuff" :# ["x" .@ x]

main :: IO ()
main = do
  runMyApp do
    doStuff 42
    logInfo "Done"

newtype MyApp = MyApp
  { myAppLogFunc :: LogFunc
  }

instance HasLogFunc MyApp where
  logFuncL = lens myAppLogFunc (\x y -> x { myAppLogFunc = y })

runMyApp :: (MonadIO m) => RIO MyApp a -> m a
runMyApp m = do
  -- Just logging to 'stdout' for the example
  let myApp = MyApp { myAppLogFunc = rioLogFunc stdout }
  runRIO myApp m
  where
  rioLogFunc :: Handle -> LogFunc
  rioLogFunc h =
    mkLogFunc \cs logSource logLevel utf8Builder -> do
      MLA.defaultOutput
        h
        (locFromCS cs)
        logSource
        (rioLogLevelToMLA logLevel)
        (utf8BuilderToLogStr utf8Builder)

  locFromCS :: CallStack -> MLA.Loc
  locFromCS cs =
    -- 'reverse' goofiness ensues.
    case reverse $ getCallStack cs of
      [] -> MLA.Loc "<unknown>" "<unknown>" "<unknown>" (0,0) (0,0)
      (_desc, loc) : _ -> MLA.Internal.mkLoggerLoc loc

  rioLogLevelToMLA :: LogLevel -> MLA.LogLevel
  rioLogLevelToMLA = \case
    LevelDebug -> MLA.LevelDebug
    LevelInfo -> MLA.LevelInfo
    LevelWarn -> MLA.LevelWarn
    LevelError -> MLA.LevelError
    LevelOther text -> MLA.LevelOther text

  utf8BuilderToLogStr :: Utf8Builder -> MLA.LogStr
  utf8BuilderToLogStr (Utf8Builder builder) = MLA.toLogStr builder

fromMessage :: Message -> Utf8Builder
fromMessage message =
  Utf8Builder
    $ Builder.lazyByteString
    $ Aeson.Encoding.encodingToLazyByteString
    $ MLA.Internal.messageEncoding message