如何从模板 Haskell 调用构造函数

How to call constructor from Template Haskell

我有一个函数(我们称之为 mkSome),它使用模板 Haskell 构造一些数据类型。它具有典型的签名 Name -> Q [Dec]。 在它的某处 body 我正在提取另一种类型的构造函数 pattern-matching:

case tyCons of
  DataD ctx nm tyVars mbKind cs derivs -> ...

这些构造函数的类型 cs 像这样实例化一些 class:

class MyClass a where
  specialValue :: a

所以,我正在迭代那些 cs 但我想跳过其中之一 等于 specialValue。像这样:

[c | c <- cs, c /= specialValue]

示例:

data OtherData = A | B | C
instance MyClass OtherData where
  specialValue = C
$(mkSome ''OtherData) -- mkSome must skip C-constructor!

如何在模板 Haskell 中执行此操作(使用 Con 类型:c 是吗)?当然,我不能简单地调用构造函数来将创建的值与 specialValue 进行比较,因为它是 AST 节点,而不是真正的构造函数

这完全取决于你想如何使用这个表达式。你可以写例如

mkCons :: Name -> Q Exp
mkCons ty = do
  TyConI (DataD ctx nm tyVars mbKind cs derivs) <- reify ty
  let cons = ListE $ map (\(NormalC c _) -> ConE c) cs
  [| [c | c <- $(pure cons), c /= specialValue] |]

这是一个拼接,其结果是 ty 除了 specialValue.

的构造函数

但是如果你想在拼接中操作结果列表(例如,为除 specialValue 之外的所有构造函数生成一些代码)那么情况要复杂得多。您需要有一个嵌套拼接来操纵上述拼接的结果:

mkSome :: Name -> Q Exp
mkSome ty =
  [| do e1 <- mapM lift $(mkCons ty)
        let mkD (ConE n) = DataD [] (mkName $ "Foo" ++ nameBase n) [] Nothing [] [] -- example function
        pure $ map mkD e1
    |]

还要注意 lift 的用法; $(mkCons ty) 的结果具有类型 [OtherData](在本例中),但 lift 为您提供了与这些构造函数对应的 TH AST。

另请注意,上述函数使用给定类型的 EqLiftMyClass 实例。由于阶段限制,您必须在单独的模块中定义这些实例而不是使用拼接。所以以下将不起作用:

module A where

import TH (mkSome)

data OtherData = A | B | C deriving (Lift, Eq)
instance MyClass OtherData where
  specialValue = C

$( $(mkSome ''OtherData) )

你必须像这样使用它:

-- A.hs
module A where

data OtherData = A | B | C deriving (Lift, Eq)
instance MyClass OtherData where
  specialValue = C

-- B.hs
module B where

import TH (mkSome)
import A

$( $(mkSome ''OtherData) )

结果:

    mkSome ''OtherData
  ======>
    do { e1_adJ0 <- mapM
                      lift [c_adJ2 | c_adJ2 <- [A, B, C], (c_adJ2 /= specialValue)];
         let mkD_adJ1 (ConE n_adJ3)
               = DataD
                   [] (mkName $ ("Foo" ++ (nameBase n_adJ3))) [] Nothing [] [];
         (pure $ (map mkD_adJ1 e1_adJ0)) }


    (do { e1_adJ0 <- mapM
                       lift [c_adJ2 | c_adJ2 <- [A, B, C], (c_adJ2 /= specialValue)];
          let mkD_adJ1 (ConE n_adJ3)
                = DataD
                    [] (mkName $ ("Foo" ++ (nameBase n_adJ3))) [] Nothing [] [];
          (pure $ (map mkD_adJ1 e1_adJ0)) })
  ======>
    data FooA
    data FooB