您可以使用两个文件来执行此操作：
一个“制造商”文件：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))
和主文件：Main.hs:
{-# LANGUAGE TemplateHaskell #-}
import Language.Haskell.TH
import Maker
function = $(maker [("five",5),("six",6)])
在这种情况下function将属于以下类型[Char] -> Int并将被编译为：
\x -> case x of
"five" -> 5
"six" -> 6
因此，就好像你会写：
function = \x -> case x of
"five" -> 5
"six" -> 6
你自己。显然，这对于两三个案例来说不会有回报，但正如您自己在问题中所写的那样，当您想要使用数千个案例或由列表理解生成的项目列表时，这开始得到回报。
自己制作Haskell模板
本节旨在简要描述如何自己编写 Haskell 模板。本教程不是“关于……的完整介绍”：还有其他技术可以做到这一点。
为了编写Haskell模板，你可以先尝试一些表达式，然后尝试概括他们使用map, fold, etc.
分析 AST 树
首先你最好看看 Haskell 如何解析某个表达式本身。你可以这样做runQ和括号[| ... |] https://stackoverflow.com/a/7489277/67579 with ...您想要分析的表达式。例如：
$ 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))) []])
因此 AST 是：
LamE [VarP x_0] (CaseE (VarE x_0) [Match (LitP (StringL "five")) (NormalB (LitE (IntegerL 5))) [],Match (LitP (StringL "six")) (NormalB (LitE (IntegerL 6))) []])
所以现在我们有derived the 抽象语法树 (AST)从那个表情。一个提示是使表达式足够通用。例如，在case块，因为使用单个案例并不会告诉您应该如何将第二个案例添加到表达式中。现在我们希望自己创建这样的抽象语法树。
创建变量名
第一个方面是变量，例如VarP x_0 and VarE x_0。你不能简单地复制粘贴他们。这里x_0是一个名字。为了确保您不使用已经存在的名称，您可以使用newName。现在您可以构造以下表达式来完全复制它：
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))) []])
概括函数
显然我们对构建固定的抽象语法树不感兴趣，否则我们可以自己编写它。现在的重点是引入一个或多个变量，并对这些变量进行推理。对于每个元组("five",5)等我们介绍一个Match陈述：
Match (LitP (StringL "five")) (NormalB (LitE (IntegerL 5))) []
现在我们可以轻松地概括这一点\(a,b):
\(a,b) -> Match (LitP (StringL a)) (NormalB (LitE (IntegerL b))) []
然后使用map迭代所有项目：
map (\(a,b) -> Match (LitP (StringL a)) (NormalB (LitE (IntegerL b))) []) items
with items我们希望为其生成案例的元组列表。现在我们完成了：
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))
现在您可以简单地省略return因为该库对所有这些项目都有小写变体。您还可以尝试“cleanup“代码一点点（例如(NormalB (LitE (IntegerL b))) to (NormalB $ LitE $ IntegerL b)， ETC。）;例如使用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这是某种创建/构造函数的函数。
小心无限列表
请注意，编译器将评估美元括号之间的内容$()。例如，如果您要使用无限列表：
function = $(maker [(show i,i)|i<-[1..]]) -- Don't do this!
这将不断为抽象语法树分配内存并最终耗尽内存。编译器做了not在运行时扩展 AST。
