haskell - 我如何以编程方式从另一个生成此数据类型？

Question

我想使用 DSum为了某件事。要使用 DSum，您需要有一个带有一个类型参数的“标签”类型，例如

data Tag a where
  AFirst :: Tag Int
  ASecond :: Tag String

但是，我想在图书馆内部使用它。我希望我向用户公开的界面采用任何旧数据类型，例如

data SomeUserType1 = Foo Int | Bar String

从这里转到上面给出的 Tag a 类型显然是相当机械的。那么，是否可以使用某种通用编程技术在代码中执行此操作？

这是另一个示例，可以清楚地说明我想要生成的映射类型。

data SomeUserType2 = Foo Int | Bar Char | Baz Bool String

应该变成

data Tag2 a where
  AFirst :: Tag2 Int
  ASecond :: Tag2 Char
  AThird :: Tag2 (Bool, String)

这是 Template Haskell 的工作吗？还有别的吗？我什至不知道这里有什么选项。

Answer 1

模板 Haskell 是您想要的，因为您正在尝试生成声明。这是有用的东西。将以下内容放入一个名为 Tag.hs 的文件中:

{-# LANGUAGE TemplateHaskell #-}

module Tag where

import Language.Haskell.TH

makeTag :: Name -> DecsQ
makeTag name = do
    -- Reify the data declaration to get the constructors.
    -- Note we are forcing there to be no type variables...
    (TyConI (DataD _ _ [] _ cons _)) <- reify name

    pure [ DataD [] tagTyName [PlainTV (mkName "a")] Nothing (fmap tagCon cons) [] ]
  where
  -- Generate the name for the new tag GADT type constructor.
  tagTyName :: Name
  tagTyName = mkName ("Tag" ++ nameBase name)

  -- Given a constructor, construct the corresponding constructor for the GADT.
  tagCon :: Con -> Con
  tagCon (NormalC conName args) =
    let tys = fmap snd args
        tagType = foldl AppT (TupleT (length tys)) tys
    in GadtC [mkName ("Tag" ++ nameBase conName)] []
             (AppT (ConT tagTyName) tagType)

然后你可以在另一个文件中测试它:

{-# LANGUAGE TemplateHaskell, GADTs #-}

import Tag

data SomeUserType1 = Foo Int | Bar String
data SomeUserType2 = Fooo Int | Baar Char | Baaz Bool String

makeTag ''SomeUserType1
makeTag ''SomeUserType2

如果您检查 GHCi 中的第二个文件(或通过将 -ddump-splices 传递给 ghci 或 ghc 查看生成的代码) 你会看到生成了以下内容:

data TagSomeUserType1 a where
  TagFoo :: TagSomeUserType1 Int
  TagBar :: TagSomeUserType1 String

data TagSomeUserType3 a where
  TagFooo :: TagSomeUserType2 Int
  TagBaar :: TagSomeUserType2 Char
  TagBaaz :: TagSomeUserType2 (Bool, String)

我必须使用 mkName 而不 newName 因为，如果您希望使用这些生成的 GADT，您将需要它们有你可以写的可预测的名字。从示例中应该清楚，我的约定是将 Tag 添加到类型和数据构造函数之前。