首先,让我们打开一些扩展:
{-# LANGUAGE FlexibleInstances, TemplateHaskell #-}
import Language.Haskell.TH
现在我将伪造一些数据类型和类以保持与真实世界的交互低:
data Person = Person Int String deriving Show
class SQL a where
fromSql :: String -> a
instance SQL Int where fromSql = read
instance SQL String where fromSql = id -- This is why I needed FlexibleInstances
好的,现在我们需要决定要生成什么代码。紧贴您的示例,我们可以将 makeModel 定义为 lambda 表达式(下面的翻译):
LamE [ListP [VarP id,VarP name]] (AppE (AppE (ConE Person) (AppE (VarE fromSql) (VarE id))) (AppE (VarE fromSql) (VarE name)))
\ [ id, name ] -> ( ( Person ( fromSql id )) ( fromSql name ))
\ [ id, name ] -> Person $ fromSql id $ fromSql name
(我不会说流利Exp
的,我runQ [| \[id,name] -> Person (fromSql id) (fromSql name) |]
在 ghci 中说流利!)
我选择使用字符串来定义标识符id
,name
因为您可以从表中读取它,但您也可以生成名为field_1
etc的标识符。
makeMakeModel qFieldNames qMapFunction qConstructor = -- ["id","name"] 'fromSql 'Person
LamE [ListP (map VarP qFieldNames)] -- \ [id,name]
$ foldl AppE (ConE qConstructor) -- Person
[AppE (VarE qMapFunction) (VarE name)|name <- qFieldNames]
-- $ id $ name
makeModel fieldNames mapFunction constructor = do
names <- mapM newName fieldNames
return $ makeMakeModel names mapFunction constructor
在行动中ghci -XTemplateHaskell
:
*Main> runQ $ makeModel ["id","name"] 'fromSql 'Person
LamE [ListP [VarP id_0,VarP name_1]] (AppE (AppE (ConE Main.Person) (AppE (VarE Main.fromSql) (VarE id_0))) (AppE (VarE Main.fromSql) (VarE name_1)))
*Main> $(makeModel ["id","name"] 'fromSql 'Person) ["1234","James"]
Person 1234 "James"
请注意,我们使用的标识符是如何newName
获得序列号以使其唯一的,而我们传入的标识符前面带有破折号,'fromSql
并'Person
保留为它们的实际定义。
如果您不想使用 lambda 表达式,可以使用
runQ [d| makeModel [id,name] = Person (fromSql id) (fromSql name) |]
作为您的起点 -[d| ... |]
用于函数定义。