如何捕获此 TH 代码创建的命名值

Question

这是我的模板 Haskell 代码

objectGIDDeclaration :: String -> Integer -> Q [Dec]
objectGIDDeclaration dnameSTR gid = pure fDec
 where
   dname = dnameSTR <> "GID"
   fDec = [fSig]
   Sig = ValD fname objectType []
   fname = VarP (mkName dname)
   objectType = NormalB (AppE constructor value)
   constructor = ConE (mkName "GID")
   value = LitE (IntegerL gid)

这就是它的作用

objectGIDDeclaration "foo" 3

这会创建一个命名值

fooGID

GID {unGID = 3}

我还有一些其他模板 Haskell 代码

objectLabelDeclaration :: String -> Lexeme -> Q [Dec]
objectLabelDeclaration dnameSTR object = pure fDec
  where
    dname = dnameSTR <> "Label"
    fDec = [fSig, value]
    fSig = SigD fname objectType
    vPattern = VarP (mkName dname)
    value = ValD vPattern body []
    constructor = ConE (mkName "ObjectLabel")
    body = NormalB (AppE constructor lexeme)
    lexeme = UnboundVarE (mkName (show object))
    objectType = ConT (mkName "ObjectLabel")
    fname = mkName dname

这就是它的作用

objectLabelDeclaration "foo" CABINET

ghci> fooLabel 对象标签 {_unObjectLabel = CABINET}

这是我想做的，但不知道如何做

mapM someFunction ["foo","bar","baz"]

[(fooLabel,fooGID),(barLabel,barGID),(bazLabel,bazGID)]

第一个值具有以下类型

   newtype ObjectLabel 
      = ObjectLabel {_unObjectLabel :: Lexeme} deriving stock 
         (Eq,Ord,Show)

第二个值具有以下类型

  newtype GID a = GID {unGID :: Int}
      deriving stock (Show, Ord, Eq)

所以我希望生成一个 [(ObjectLabel, GID Object)]

我刚刚尝试过这个

objectLabelDeclaration :: String -> Lexeme -> Q ([Dec],Name)

认为这就是我想要的

Name

。是吗？我应该想出另一种方法来捕捉

Name

吗？

欢迎提示技巧和建议

编辑：我想我需要一个

Exp

而不是

Q [Dec]

。目前正在拉该线程。

编辑：不这么认为

Answer 1

如果我正确理解你的问题，一种选择是简单地将你的两个函数应用于输入：

someFunction x = (objectLabelDeclaration x, objectGIDDeclaration x)

Answer 2

您无需采取任何特殊步骤即可捕获 Template Haskell 代码中的名称。默认情况下会捕获使用

mkName

创建的名称，如下例所示：

{-# LANGUAGE TemplateHaskell #-}
import Language.Haskell.TH

-- foo = 42
$(pure [ValD (VarP (mkName "foo")) (NormalB (LitE (IntegerL 42))) []])

-- main = print foo
main = print $(pure (VarE (mkName "foo")))

所以，它应该像写一样简单：

someFunction :: String -> Q Exp
someFunction tag
  = pure $ TupE [Just (VarE (mkName label)), Just (VarE (mkName gid))]
  where label = tag <> "Label"
        gid = tag <> "GID"