How to write a family of printf functions (debug print, etc.) in Haskell

Question

This is a challenge problem more than a useful problem (I've spent a few hours on it). Given some functions,

put_debug, put_err :: String -> IO ()
put_foo :: String -> StateT [String] m ()

I want to write a generalized printf function, call it gprint, such that I can write

pdebug = gprint put_debug
perr = gprint put_err
pfoo = gprint put_foo

and then use pdebug, perr, and pfoo like printf, for example,

pdebug "Hi"
pdebug "my value: %d" 1
pdebug "two values: %d, %d" 1 2

I can't manage to come up with a sufficiently general class. My attempts have been things like (for those familiar with Printf, or Oleg's variadic function approach)

class PrintfTyp r where
    type AppendArg r a :: *
    spr :: (String -> a) -> String -> [UPrintf] -> AppendArg r a

or

class PrintfTyp r where
    type KRetTyp r :: *
    spr :: (String -> KRetTyp r) -> String -> [UPrintf] -> r

Both are too difficult to write base instances for: there's no good choice for r for the first approach (and, its type is not reflected in the non-injective indexed type family AppendArg), and in the second approach, one ends up writing instance PrintfTyp a which looks wrong (matches too many types).

Again, it's just a challenge problem: do it only if it's fun. I would definitely be curious to know the answer though. Thanks!!

Answer 1

Here's one approach that tries to let the existing Text.Printf to do as much of the work as possible. First off, we'll need some extensions:

{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}

-- To avoid having to write some type signatures.
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ExtendedDefaultRules #-}

import Control.Monad.State
import Text.Printf

The idea is to feed the arguments one at a time into printf to get the formatted String, then take that and give it to the action we were given at the start.

gprint :: GPrintType a => (String -> EndResult a) -> String -> a
gprint f s = gprint' f (printf s)

class PrintfType (Printf a) => GPrintType a where
  type Printf a :: *
  type EndResult a :: *
  gprint' :: (String -> EndResult a) -> Printf a -> a

The recursive step takes an argument, and feeds it to the printf call we're building up in g.

instance (PrintfArg a, GPrintType b) => GPrintType (a -> b) where
  type Printf (a -> b) = a -> Printf b
  type EndResult (a -> b) = EndResult b
  gprint' f g x = gprint' f (g x)

The base cases just feed the resulting string into f:

instance GPrintType (IO a) where
  type Printf (IO a) = String
  type EndResult (IO a) = IO a
  gprint' f x = f x

instance GPrintType (StateT s m a) where
  type Printf (StateT s m a) = String
  type EndResult (StateT s m a) = StateT s m a
  gprint' f x = f x

Here's the test program I used:

put_debug, put_err :: String -> IO ()
put_foo :: Monad m => String -> StateT [String] m ()

put_debug = putStrLn . ("DEBUG: " ++)
put_err   = putStrLn . ("ERR: " ++)
put_foo x = modify (++ [x])

pdebug = gprint put_debug
perr = gprint put_err
pfoo = gprint put_foo

main = do
  pdebug "Hi"
  pdebug "my value: %d" 1
  pdebug "two values: %d, %d" 1 2
  perr "ouch"
  execStateT (pfoo "one value: %d" 42) [] >>= print

And the output:

DEBUG: Hi
DEBUG: my value: 1
DEBUG: two values: 1, 2
ERR: ouch
["one value: 42"]

Answer 2

Classes are for type-based dispatch. So, for put_foo, the Text.Printf architecture is already satisfactory (though it doesn't export PrintfType, sadly). For example, the following seems to work well:

{-# LANGUAGE TypeFamilies #-} -- for ~ syntax
import Control.Monad.State
import Data.Default

-- copy and paste source of Text.Printf here

put_foo :: String -> StateT [String] m ()
put_foo = undefined

instance (Default a, Monad m, s ~ [String]) => PrintfType (StateT s m a) where
    spr s us = put_foo (spr s us) >> return def

For put_debug and put_err, you can generalize the PrintfType in the same way HPrintfType does, but taking a String -> IO () function instead of a handle. Then you would write

pdebug  = funPrintf put_debug
perr    = funPrintf put_err
printf' = funPrintf putStr -- just for fun
pfoo    = printf