3

How to write a template Haskell function such that:

mkFunc "func"

generates

func = "func"

I've tried this

mkFunc x = ValD (VarP x) (NormalB (LitE (StringL x))) []

But it doesn't typecheck:

Couldn't match type ‘Name’ with ‘[Char]’
Expected type: String
  Actual type: Name
In the first argument of ‘StringL’, namely ‘x’
In the first argument of ‘LitE’, namely ‘(StringL x)’

Also, after defining mkFunc, how can I define mkFuncs which makes a list of function definitions?

Cactus
  • 27,075
  • 9
  • 69
  • 149
doofin
  • 508
  • 2
  • 13

1 Answers1

4

You can get help using runQ and see what abstract syntax tree it produces:

λ> runQ [d|func = "func"|]
[ValD (VarP func_4) (NormalB (LitE (StringL "func"))) []]

And then you can just translate that into code:

-- External.hs
{-#LANGUAGE TemplateHaskell#-}

module External where

import Language.Haskell.TH

mkFunc :: String -> Q [Dec]
mkFunc str = return [ValD (VarP str') (NormalB (LitE (StringL str))) []]
    where str' = mkName str

And the other module:

-- Other.hs
{-#LANGUAGE TemplateHaskell#-}
import External

$(mkFunc "haskell")

main = print haskell

Demo in ghci:

λ> main
"haskell"

And creating mkFuncs is straightforward from this:

mkFuncs :: [String] -> Q [Dec]
mkFuncs srt = return decs
    where dec n s = ValD (VarP n) (NormalB (LitE (StringL s))) []
          srt' = map (\x -> (mkName x, x)) srt
          decs = map (\(n,s) -> dec n s) srt'
Sibi
  • 47,472
  • 16
  • 95
  • 163
  • thanks! a little more refined: makeFuncs::[String]->Q [Dec] makeFuncs ss=return $ foldl1 (++) $ mapM (\x->[ValD (VarP (mkName x)) (NormalB (LitE (StringL x))) []]) ss btw, can we use quasiquoters instead of manipulating AST directly? – doofin Sep 02 '15 at 04:43