5

我有很多这样的代码：

data Post =
    Post
    { postOwner :: Integer
    , postText :: ByteString
    , postDate :: ByteString
    }

sqlToPost :: [SqlValue] -> Post
sqlToPost [owner, text, date] = Post (fromSql owner) (fromSql text) (fromSql date)

（这里使用的库是 HDBC）。未来会有很多类似的数据和类似的Post函数sqlToVal。我可以减少这个样板代码sqlToVal吗？

4

1 回答 1

6

模板 Haskell 代码生成是一个非常高级的话题。不过，如果您掌握了 TH 的艺术，则可以使用所述技术来生成您正在寻找的代码。

请注意，以下代码仅适用于data只有一个构造函数的类型（例如 not data Foo = A String Int | B String Int，它有两个构造函数A和B），因为您没有说明在代码中应该如何处理。

我们将创建一个在编译时运行的 Template Haskell 函数，采用数据类型的名称，并生成一个名为sqlTo<nameofdatatype>. 这个函数看起来像这样：

module THTest where

import Control.Monad (replicateM)

-- Import Template Haskell
import Language.Haskell.TH
-- ...and a representation of Haskell syntax
import Language.Haskell.TH.Syntax

-- A function that takes the name of a data type and generates a list of
-- (function) declarations (of length 1).
makeSqlDeserializer :: Name -> Q [Dec]
makeSqlDeserializer name = do
  -- Look up some information about the name. This gets information about what
  -- the name represents.
  info <- reify name

  case info of
    -- Is the name a type constructor (TyConI) of a data type (DataD), with
    -- only one normal constructor (NormalC)? Then, carry on.
    -- dataName is the name of the type, constrName of the constructor, and
    -- the paramTypes are the constructor parameter types.
    -- So, if we have `data A = B String Int`, we get
    -- dataName = A, constrName = B, paramTypes = [String, Int]
    TyConI (DataD _ dataName _ [NormalC constrName paramTypes] _) -> do

      -- If the dataName has a module name (Foo.Bar.Bla), only return the data
      -- name (Bla)
      let dataBaseName = nameBase dataName

      -- Make a function name like "sqlToBla"
      let funcName = mkName $ "sqlTo" ++ dataBaseName

      -- Also access the "fromSql" function which we need below.
      let fromSqlName = mkName "Database.HDBC.fromSql"

      -- Count how many params our data constructor takes.
      let numParams = length paramTypes

      -- Create numParams new names, which are variable names with random
      -- names.
      -- This could create names like [param1, param2, param3] for example,
      -- but typically they will look like
      -- [param[aV2], param[aV3], param[aV4]]
      paramNames <- replicateM numParams $ newName "param"

      -- The patterns are what's on the left of the `=` in the function, e.g.
      -- sqlToBla >>>[param1, param2, param3]<<< = ...
      -- We make a list pattern here which matches a list of length numParams
      let patterns = [ListP $ map VarP paramNames]

      -- The constructor params are the params that are sent to the
      -- constructor:
      -- ... = Bla >>>(fromSql param1) (fromSql param2) (fromSql param3)<<<
      let constrParams = map (AppE (VarE fromSqlName) . VarE) paramNames

      -- Make a body where we simply apply the constructor to the params
      -- ... = >>>Bla (fromSql param1) (fromSql param2) (fromSql param3)<<<
      let body = NormalB (foldl AppE (ConE constrName) constrParams)

      -- Return a new function declaration that does what we want.
      -- It has only one clause with the patterns that are specified above.
      -- sqlToBla [param1, param2, param3] =
      --   Bla (fromSql param1) (fromSql param2) (fromSql param3)
      return [FunD funcName [Clause patterns body []]]

现在，我们像这样使用这个函数（注意LANGUAGE启用 Template Haskell 的编译指示）：

{-# LANGUAGE TemplateHaskell #-}

-- The module that defines makeSqlDeserializer (must be in a different module!)
import THTest

-- Also import the fromSql function which is needed by the generated function.
import Database.HDBC

-- Declare the data type
data Bla = Bla String Int deriving (Show)

-- Generate the sqlToBla function
makeSqlDeserializer ''Bla

如果要查看生成的函数，只需-ddump-splices在编译时传递给 GHC。输出是这样的：

test.hs:1:1: Splicing declarations
    makeSqlDeserializer 'Bla
  ======>
    test.hs:7:1-25
    sqlToBla [param[aV2], param[aV3]]
      = Bla (Database.HDBC.fromSql param[aV2]) (Database.HDBC.fromSql param[aV3])
于 2012-05-18T14:39:03.197 回答