Here's a practical example of applying Template Haskell to reduce the amount of boilerplate code that is otherwise required. I wrote the below after following this excellent blog post by Matt Parsons. This post will be much higher-level, read Matt's blog for the gorier details.

Liquorice

Liquorice is a toy project of mine from a few years ago that lets you draw 2D geometric structures similar to LOGO. Liquorice offers two interfaces: pure functions that operate on an explicit Context (the pen location: existing lines, etc.), and a second "stateful" interface where the input and output are handled in the background. I prefix the pure ones P. and the stateful ones S. in this blog post for clarity.

The stateful interface can be much nicer to use for larger drawings. Compare example8b.hs, written in terms of the pure functions, and the stateful equivalent example8.hs.

The majority of the stateful functions are "wrapped" versions of the pure functions. For example, the pure function P.step takes two numbers and moves the pen forward and sideways. Its type signature is

P.step :: Int -> Int -> Context -> Context

Here's the signature and implementation of the stateful equivalent:

S.step :: Int -> Int -> State Context ()
S.step x y = modify (P.step x y)

Writing these wrapped functions for the 29 pure functions is boilerplate that can be generated automatically with Template Haskell.

Generating the wrapper functions

Given the Name of a function to wrap, we construct an instance of FunD, the TH data-type representing a function definition. We use the base name of the incoming function as the name for the new one.

mkWrap fn = do
    …
    let name = mkName (nameBase fn)
    return $ FunD name [ Clause (map VarP args) (NormalB rhs) [] ]

To determine how many arguments the wrapper function needs to accept, we need to determine the input function's arity. We use Template Haskell's reify function to get type information about the function, and derive the arity from that. Matt Parson's covers this exactly in his blog.

info    <- reify fn
let ty   = (\(VarI _ t _ ) -> t) info
let n    = arity ty - 1
args    <- replicateM n (newName "arg")

We can use the list "args" directly in the clause part of the function definition, as the data-type expects a list. For the right-hand side, we need to convert from a list of arguments to function application. That's a simple left-fold:

-- mkFnApp f [a,b,c] => ((f a) b) c => f a b c
mkFnApp = foldl (\e -> appE e . varE)
rhs     <- [| modify $(mkFnApp (varE fn) args) :: State Context () |]

We use TH's oxford brackets for the definition of rhs. This permits us to write real Haskell inside the brackets, and get an expression data-type outside them. Within we have a splice (the $(…)), which does the opposite: the code is evaluated at compile time and generates an Exp that is then converted into the equivalent Haskell code and spliced into place.

Finally, we need to apply the above to a list of Names. Sadly, we can't get at the list of exported names from a Module automatically. There is an open request for a TH extension for this. In the meantime, we export a list of the functions to wrap from the Pure module and operate on that

import Liquorice.Pure
wrapPureFunctions = mapM mkWrap pureFns

Finally, we 'call' wrapPureFunctions at the top level in our state module and Template Haskell splices all the function definitions into place.

The final code ended up only around 30 lines of code, and saved about the same number of lines of boilerplate. But in doing this I noticed some missing functions, and it will pay dividends if more pure functions are added.

Limitations

The current implementation has one significant limitation: it cannot handle higher-order functions. An example of a pure higher-order function is place, which moves the pen, performs an operation, and then moves it back:

P.place :: Int -> Int -> (Context -> Context) -> Context -> Context

Wrapping this is not sufficient because the higher-order parameter has the pure function signature Context -> Context. If we wrapped it, the stateful version of the function would accept a pure function as the parameter, but you would expect it to accept another stateful function.

To handle these, at a minimum we would need to detect the function arguments that have type Context -> Context and replace them with State Context (). The right-hand side of the wrapped function would also need to do more work to handle wrapping and unwrapping the parameter. I haven't spent much time thinking about it but I'm not sure that a general purpose wrapper would work for all higher-order functions. For the time being I've just re-implemented the half-dozen of them.


Comments