Text.Printf and monad transformers

(This post is about Haskell, but unrelated to CHP.)

A little while ago, Bryan O’Sullivan was developing his Criterion benchmark suite, and had trouble with using the Text.Printf module in a monad transformer on top of IO. I thought I knew how to solve this, but my first idea didn’t work — and nor did my second or third. Eventually I figured out how to do it, and the patches made it into the new Criterion release. I’m posting about it here in case anyone else has the same trouble in future.

My solution achieves two things. It allows the use of (equivalents to) printf and hPrintf in the monad ReaderT Config IO, but also allows you to decide whether to print based on that Config item — for example, based on a verbosity level stored in the config. If you had StateT Config IO, or various other transformers and combinations thereof, this approach should still work.

So, why is this problematic in the first place? If you are willing to annotate every use of hPrintf with liftIO, you get the first behaviour already:

liftIO $ printf "String: %s, Int: %d" "hello" 42

However, you can’t just define a helper:

myPrintf = liftIO . printf

Because that breaks the magic of printf. Printf works by letting the return type of printf "some string" vary; it can either be IO a, if there are no more arguments to feed to printf, or it can be a -> r, where a is the type of the next argument to printf, and r is again a varying type. So adding liftIO . on the front forces printf to have the IO a type straight away, thus breaking the vararg tricks.

We must add a new type-class with the same basic idea as printf, but with some adjustments. This is made harder because the implementation of printf and hPrintf (which we still want to use, rather than re-implement) is hidden in the Text.Printf module and is unavailable to us.

What we do is construct something a bit like a list fold. Here is the type of the standard foldl function, with some more descriptive type names than usual:

foldl :: (agg -> listItem -> agg) -> agg -> [listItem] -> agg

We can conceive of a slightly different interface:

data Fold agg listItem = Fold agg (listItem -> Fold agg listItem)

foldl :: Fold agg listItem -> [listItem] -> agg

The data-type Fold contains the current aggregate value (the first item of Fold) to use if there are no more list items, and a function that, given the next list item, will return the next Fold instance (the second item of Fold).

We can create an analogous type for printf (if you think of printf doing a left fold over its variable number of arguments):

data PrintfFold = PrintfFold (IO ()) (PrintfArg a => a -> PrintfFold)

(Note that this requires Rank2Types.) The first item, of type IO (), represents the “print now with all the arguments you’ve got so far” item, whereas the second, of type PrintfArg a => a -> PrintfFold is the “here’s one more argument, now give me a new PrintfFold” item. To implement our wrapper around printf that supports varargs, we will need our own type-class that is based around this PrintfFold type:

class PrintfWrapper a where
  wrapPrintf :: (Config -> Bool) -> PrintfFold -> a

The wrapPrintf function takes a decision function (given this config, should the item be printed?), our PrintfFold and becomes the type that is the parameter to the class (this part mirrors printf’s vararg magic). The base instance, for acting in the ReaderT Config IO monad, is:

instance PrintfWrapper (ReaderT Config IO a) where
  wrapPrintf check (PrintfFold now _f)
    = do x <- ask
         when (check x) (liftIO now)
         return undefined

This checks, based on the value of the config, whether to print the item — the printing is done using the now action from our PrintfFold type. Finally, we return an undefined value, which is what printf does too (printf allows its return type to vary to avoid upsetting the type inference). Our instance for when another argument is passed is very simple:

instance (PrintfWrapper r, PrintfArg a) => PrintfWrapper (a -> r) where
  wrapPrintf check (PrintfFold _now f) x = wrapPrintf check (f x)

This just continues the pseudo-fold by adding this argument. The final piece of the puzzle is the top-level new printf function. We can use this one new type-class defined above to write replacements for printf and hPrintf; I’m showing the hPrintf version:

chPrintf :: PrintfWrapper r => (Config -> Bool) -> Handle -> String -> r
chPrintf check h s = wrapPrintf check $ make (hPrintf h s) (hPrintf h s)
  where
    make :: IO () -> (forall a r. (PrintfArg a, HPrintfType r) => a -> r) -> PrintfFold
    make asIs oneMore = PrintfFold asIs (\x -> make (oneMore x) (oneMore x))

The interesting bit here is the make function that constructs a PrintfFold. It takes two arguments: the action to execute if there are no further arguments to printf, and the function to get a new fold when you feed it another argument. These two arguments always come from the same code, but the code can take on the two types because of the way printf can have these two different types.

Our new chPrintf function can be used just like hPrintf, but in the ReaderT Config IO monad:

data Config = Config {decide :: Bool}

main :: IO ()
main = flip runReaderT (Config True) $
  do chPrintf decide stdout "String %s, Int %d" "hello" (42::Int)
     chPrintf decide stdout "No Args"

If you change that True to False, the text will not be printed. It should be easy to see how an instance could be defined to use my approach with the StateT Config IO monad or similar. It is also possible to define an instance to use the exact same chPrintf function in the normal IO monad (which will ignore the check based on the config, since it has no config item available to check):

instance PrintfWrapper (IO a) where
  wrapPrintf _check (PrintfFold now _f) = now >> return undefined

This is useful if in some places in your code you want to use a wrapper function based on the chPrintf function in the IO monad (Criterion does this in a couple of places). Now that you have chPrintf, it becomes easy to define a wrapper function that prints some vararg bits when the verbosity is above a certain level; here is some code from Criterion that does just that:

note :: (PrintfWrapper r) => String -> r
note = chPrintf ((> Quiet) . fromLJ cfgVerbosity) stdout

This can then be used like printf:

note "bootstrapping with %d resamples\n" numResamples

Other variations on the pattern presented here are possible; the Handle could be retrieved from a StateT monad (if you make both the items in the PrintfFold take a Handle as a parameter), or a standard prefix added to all printed text — where the text is similarly taken from some reader or state monad transformer. The good thing from a code standpoint is that I didn’t need to duplicate any of the printing functionality from the Text.Printf module, nor did I need anything more than its normal publicly visible interface; I just needed to arm-wrestle the type system for a while — and use Rank2Types.