Extracting context for tracing/logging via haskell meta programming

Question

In our haskell code base, business logic is interlaved with tracing and logging code. This can obscure the business logic and make it harder to understand and debug. I am looking for ideas how to reduce the code footprint of logging and tracing to make the business logic stick out more.

Our code currently mostly looks roughly like this:

someFunction a b cs = 
  withTaggedSpan tracer "TRACE_someFunction" [("arg_b", show b)] $ do
    logDebug logger $ "someFunction start: " <> show (trimDownC <$> cs)
    result <- do ... some business logic ...
    if isError result then
      logError logger $ "someFunction error: " <> show result
    else
      logDebug logger $ "someFunction success: " <> show (trimDownResult result)

One observation is that whe mostly trace the entire function body and log at beginning and end. This should allow combining tracing and logging into single helper and automatically extract function name and names of captured values via meta programming. I have used AST transforming compile time macros and runtime introspection in other languges before but not Haskell.

What are good ways to do this using Template Haskell, HasCallStack or other options?

(Cross posted at https://www.reddit.com/r/haskell/comments/gdfu52/extracting_context_for_tracinglogging_via_haskell/)

Answer 1

Let's assume for simplicity that the functions in your business logic are of the form:

_foo :: Int -> String -> ReaderT env IO ()
_bar :: Int -> ExceptT String (ReaderT env IO) Int

That is, they return values in a ReaderT transformer over IO, or perhaps also throw errors using ExceptT. (Actually that ReaderT transformer isn't required right now, but it'll come in handy later).

We could define a traced function like this:

{-# LANGUAGE FlexibleInstances #-}
import Data.Void (absurd)
import Control.Monad.IO.Class
import Control.Monad.Reader -- from "mtl"
import Control.Monad.Trans -- from "transformers"
import Control.Monad.Trans.Except

traced :: Traceable t => Name -> t -> t
traced name = _traced name []

type Name = String
type Arg = String

class Traceable t where
  _traced :: Name -> [Arg] -> t -> t

instance Show r => Traceable (ReaderT env IO r) where
  _traced msg args t = either absurd id <$> runExceptT (_traced msg args (lift t))

instance (Show e, Show r) => Traceable (ExceptT e (ReaderT env IO) r) where
  _traced msg args t =
    do
      liftIO $ putStrLn $ msg ++ " invoked with args " ++ show args
      let mapExits m = do
            e <- m
            case e of
              Left err -> do
                liftIO $ putStrLn $ msg ++ " failed with error " ++ show err
                return $ Left err
              Right r -> do
                liftIO $ putStrLn $ msg ++ " exited with value " ++ show r
                return $ Right r
      mapExceptT (mapReaderT mapExits) t

instance (Show arg, Traceable t) => Traceable (arg -> t) where
  _traced msg args f = \arg -> _traced msg (args ++ [show arg]) (f arg)

This solution is still a bit unsatisfactory because, for functions that call other functions, we must decide at the outset if we want the traced version of the called functions or not.

One thing we could try—although more invasive to the code—is to put our functions in a record, and make the environment of the ReaderT equal to that same record. Something like this:

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
import GHC.Generics
-- from "red-black-record"
import Data.RBR (FromRecord (..), IsRecordType, ToRecord (..))

data MyAPI = MyAPI
  { foo :: Int -> String -> ReaderT MyAPI IO (),
    bar :: Int -> ExceptT String (ReaderT MyAPI IO) Int,
    baz :: Bool -> ExceptT String (ReaderT MyAPI IO) ()
  }
  deriving (Generic, FromRecord, ToRecord)

An then use some generics utility library (here red-black-record) to write a function that says: "if every function in your record is Traceable, I will give you another record where all the functions are traced":

import Data.Kind
import Data.Proxy
import Data.Monoid (Endo(..))
import GHC.TypeLits
import Data.RBR
  ( I (..),
    KeyValueConstraints,
    KeysValuesAll,
    Maplike,
    cpure'_Record,
    liftA2_Record,
  )

traceAPI ::
  ( IsRecordType r t,
    Maplike t,
    KeysValuesAll (KeyValueConstraints KnownSymbol Traceable) t
  ) =>
  r ->
  r
traceAPI =
  let transforms =
        cpure'_Record (Proxy @Traceable) $ 
            \fieldName -> Endo (traced fieldName)
      applyTraced (Endo endo) (I v) = I (endo v)
   in fromRecord . liftA2_Record applyTraced transforms . toRecord

-- small helper function to help invoke the functions in the record
call :: MonadReader env m => (env -> f) -> (f -> m r) -> m r
call getter execute = do
  f <- asks getter
  execute f

Alternatively, in order to avoid magic, such function could we written by hand for each particular API record.

Putting it to work:

main :: IO ()
main = do
    let api =
          traceAPI $
            MyAPI
              { foo = \_ _ ->
                  do liftIO $ putStrLn "this is foo",
                bar = \_ ->
                  do
                    liftIO $ putStrLn "this is bar"
                    return 5,
                baz = \_ ->
                  do
                    call foo $ \f -> lift $ f 0 "fooarg"
                    call bar $ \f -> f 23
                    throwE "oops"
              }
    flip runReaderT api $ runExceptT $ baz api False
    pure ()
    -- baz invoked with args ["False"]
    -- foo invoked with args ["0","\"fooarg\""]
    -- this is foo
    -- foo exited with value ()
    -- bar invoked with args ["23"]
    -- this is bar
    -- bar exited with value 5
    -- baz failed with error "oops"

Answer 2

Pure functions are deterministic. If you know what went into them, you can always reproduce the result. Thus, you shouldn't need a lot of logging inside the main parts of a functional code base.

Log the impure actions only, and architect your code into a pure core with a small imperative shell. Log only the impure actions that take place in the shell. I've described the technique in a blog post here.