Generate a function using Template Haskell

Question

Is it possible to define a function using Template Haskell? For example

convertStringToValue :: String -> Int
convertStringToValue "three" = 3
convertStringToValue "four" = 4

I also have a Map [Char] Int.

fromList [("five",5),("six",6)]

How can I add functions

convertStringToValue "six" = 6
convertStringToValue "five" = 5

at compile time using Template Haskell and the Map? It appears quite silly to use Template Haskell for this purpose but I would like to know nevertheless.

Answer 1

You can do this using two files:

a "maker" file: Maker.hs:

module Maker where

{-# LANGUAGE TemplateHaskell #-}

import Language.Haskell.TH

maker items = do
    x <- newName "x"
    lamE [varP x] (caseE (varE x) (map (\(a,b) -> match (litP $ stringL a) (normalB $ litE $ integerL b) []) items))

and the main file: Main.hs:

{-# LANGUAGE TemplateHaskell #-}

import Language.Haskell.TH
import Maker

function = $(maker [("five",5),("six",6)])

In that case function will be of the type [Char] -> Int and will be compiled as:

\x -> case x of
    "five" -> 5
    "six" -> 6

It is thus as if you would have written:

function = \x -> case x of
    "five" -> 5
    "six" -> 6

yourself. Evidently that's not going to pay off for two or three cases, but as you have written in the question yourself, when you want to use thousands of cases, or a list of items generated by list comprehension, this starts to pay off.

Making template Haskell yourself

This section aims to briefly describe how to write template Haskell yourself. This tutorial is not "a complete introduction to...": there are other techniques to do this.

In order to write template Haskell, you can first try a few expressions, and then try to generalize them using map, fold, etc.

Analyze the AST tree

First you better take a look on how Haskell would parse a certain expression itself. You can do this with runQ and brackets [| ... |] with ... the expression you wish to analyze. So for instance:

$ ghci -XTemplateHaskell
GHCi, version 7.6.3: http://www.haskell.org/ghc/  :? for help
Loading package ghc-prim ... linking ... done.
Loading package integer-gmp ... linking ... done.
Loading package base ... linking ... done.
Prelude> :m Language.Haskell.TH
Prelude Language.Haskell.TH> runQ [| \x -> case x of "five" -> 5; "six" -> 6 |]
Loading package array-0.4.0.1 ... linking ... done.
Loading package deepseq-1.3.0.1 ... linking ... done.
Loading package containers-0.5.0.0 ... linking ... done.
Loading package pretty-1.1.1.0 ... linking ... done.
Loading package template-haskell ... linking ... done.
LamE [VarP x_0] (CaseE (VarE x_0) [Match (LitP (StringL "five")) (NormalB (LitE (IntegerL 5))) [],Match (LitP (StringL "six")) (NormalB (LitE (IntegerL 6))) []])

The AST is thus:

LamE [VarP x_0] (CaseE (VarE x_0) [Match (LitP (StringL "five")) (NormalB (LitE (IntegerL 5))) [],Match (LitP (StringL "six")) (NormalB (LitE (IntegerL 6))) []])

So now we have derived the Abstract Syntax Tree (AST) from that expression. A hint is to make the expressions generic enough. For instance use multiple cases in the case block, since using a single case doesn't tell you how you should add a second one to your expression. Now we wish to create such abstract syntax tree ourselves.

Create variable names

A first aspect is the variables, like VarP x_0 and VarE x_0. You cannot simply copy-paste them. Here x_0 is a name. In order to make sure you don't use a name that already exists, you can use newName. Now you can construct the following expression to fully replicate it:

maker = do
    x <- newName "x"
    return $ LamE [VarP x] (CaseE (VarE x) [Match (LitP (StringL "five")) (NormalB (LitE (IntegerL 5))) [],Match (LitP (StringL "six")) (NormalB (LitE (IntegerL 6))) []])

Generalize the function

Evidently we are not interested in constructing a fixed abstract syntax tree, otherwise we could have written it ourselves. Now the point is that you introduce one or more variables, and reason about that variables. For every tuple ("five",5), etc. we introduce a Match statement:

Match (LitP (StringL "five")) (NormalB (LitE (IntegerL 5))) []

Now we can easily generalize this with \(a,b):

\(a,b) -> Match (LitP (StringL a)) (NormalB (LitE (IntegerL b))) []

and then use the map to iterate over all items:

map (\(a,b) -> Match (LitP (StringL a)) (NormalB (LitE (IntegerL b))) []) items

with items the list of tuples for which we wish to generate cases. Now we're done:

maker items = do
    x <- newName "x"
    return $ LamE [VarP x] (CaseE (VarE x) (map (\(a,b) -> Match (LitP (StringL a)) (NormalB (LitE (IntegerL b))) []) items))

Now you can simply omit the return because the library has lowercase variants for all these items. You can furthermore try to "cleanup" the code a little bit (like for instance (NormalB (LitE (IntegerL b))) to (NormalB $ LitE $ IntegerL b), etc.); for instance using hlint.

maker items = do
    x <- newName "x"
    lamE [varP x] (caseE (varE x) (map (\(a,b) -> match (litP $ stringL a) (normalB $ litE $ integerL b) []) items))

The maker here is some kind of function that makes/constructs the function.

Careful for infinite lists

Be aware that the compiler will evaluate what it is in between the dollar brackets $(). If you for instance would use an infinite list:

function = $(maker [(show i,i)|i<-[1..]]) -- Don't do this!

This will keep allocating memory for the abstract syntax tree and eventually run out of memory. The compiler does not expand an AST at run time.

Answer 2

Yes

import Language.Haskell.TH

generateDict :: String -> [(String, Int)] -> Q [Dec]
generateDict fname sns = do
    let clauses = map clause sns
    return $ [FunD (mkName fname) clauses]
        where clause (s,n) =
                Clause [LitP . IntegerL $ toInteger  n]
                       (NormalB . LitE $ StringL s )
                       []

And then

generateDict "myDict" $ zip (words "One Two Tree Four") [1..]

myDict 1 -- => "One"