haskell - 从generics-sop的ConstructorInfo中提取嵌套类型信息

Question

我正在尝试学习 Haskell 包generics-sop，特别是我使用辅助方法constructorInfo来获取有关数据类型的可处理信息。

作为一个练习，我试图将 ConstructorInfo 类型的信息提取为更易于理解的类型：

module SOPExperiment where

import qualified GHC.Generics as GHC
import Generics.SOP
import Data.Text (Text, pack)

data SimpleTree = Nil
  | Node String SimpleTree SimpleTree
  deriving (Show, GHC.Generic)

instance Generic SimpleTree
instance HasDatatypeInfo SimpleTree

data Exp = Union SimpleTree
  | Intersection SimpleTree
  deriving (Show, GHC.Generic)

instance Generic Exp
instance HasDatatypeInfo Exp

我已经能够拼凑出这个部分解决方案consNames，它列出了以下构造函数Exp：

-- This will give ["Union","Intersection"]
expConsNames = consNames (Proxy :: Proxy Exp)

-- And this ["Nil","Node"]
treeConsNames = consNames (Proxy :: Proxy SimpleTree)

consNames :: HasDatatypeInfo a => Proxy a -> [Text]
consNames p = hcollapse $ hliftA constructorNames cI :: [Text]
  where
  dI = datatypeInfo p
  cI = constructorInfo dI
  constructorNames :: ConstructorInfo xs -> K Text xs
  constructorNames cInfo =
      let cName = case cInfo of
              Constructor n -> n
              Infix n _ _   -> n
              Record n _    -> n
      in K . pack $ cName

1. 但是如何返回一个包含嵌套构造函数名称的列表呢？

-- Should return ["Union","Intersection", "Nil", "Node"]
nestedExpConsNames = undefined

2. 或者稍微好一点，返回一个树数据类型，表示构造函数是如何嵌套在类型中的？

data Tree = Tree String [Tree] deriving Show
expDataStructure :: Tree
expDataStructure = undefined

{- Result should be something akin to (infinite tree): 
expDataStructure' = Tree "Exp" [
  Tree "Union" [
    Tree "SimpleTree" [Tree "Nil" [], Tree "Node" [Tree "SimpleTree" [...]]],
    Tree "SimpleTree" [Tree "Nil" [], Tree "Node" [Tree "SimpleTree" [...]]]
  ],
  Tree "Intersection" [
    Tree "SimpleTree" [Tree "Nil" [], Tree "Node" [Tree "SimpleTree" [...]]],
    Tree "SimpleTree" [Tree "Nil" [], Tree "Node" [Tree "SimpleTree" [...]]]
  ]]
  -}

使用的 GHC 扩展有：OverloadedStrings、ScopedTypeVariables、TypeFamilies、RankNTypes、TypeOperators、ConstraintKinds、MultiParamTypeClasses、TypeSynonymInstances、FlexibleInstances、FlexibleContexts、DefaultSignatures、DataKinds、DeriveGeneric、ExtendedDefaultRules

（可能不需要所有扩展）

标签： haskellgenerics

Answer 1

定义递归版本需要非递归函数的变体，所以让我们从它开始：

conNames_NP :: (Generic a, HasDatatypeInfo a) => Proxy a -> NP (K Text) (Code a)
conNames_NP p =
  map_NP
    (K . pack . constructorName)
    (constructorInfo (datatypeInfo p))

它主要是您编写的内容，但不需要区分大小写，因为constructorName由库提供。

现在让我们定义基于递归树的版本，它通常会返回一个无限树。此外，在您的示例中，数据类型名称突然出现在树结构中。我不清楚它的语义，所以我将生成一个只有构造函数名称的树。

data Tree = Tree Text [Tree]

对于支持此操作的所有数据类型，您需要一个附加类。这是因为，正如评论中已经提到的那样，您不能（或者更好的是，不想）假设每个类型递归都是Genericand的一个实例HasDatatypeInfo。原始类型，例如Char或Text不是这些类的实例，但它们可能会出现在您的数据类型中的某个地方。

所以我们定义

class ConNamesRecursive a where
  conNamesRecursive :: Proxy a -> [Tree]
  default conNamesRecursive ::
    (Generic a, HasDatatypeInfo a, All2 ConNamesRecursive (Code a))
    => Proxy a -> [Tree]
  conNamesRecursive = gconNamesRecursive

代理是个人喜好问题，因为我将在下面的代码中使用类型应用程序。我喜欢使用代理来提醒您需要类型参数。

的定义gconNamesRecursive很棘手，因为构造函数名称本质上与它们作为构造函数的类型无关，因此我们必须以某种方式正确传递类型信息。我通过引入一些辅助函数来做到这一点：

gconNamesRecursive ::
  forall a . (Generic a, HasDatatypeInfo a, All2 ConNamesRecursive (Code a))
  => Proxy a -> [Tree]
gconNamesRecursive p =
  collapse_NP (cmap_NP (Proxy @(All ConNamesRecursive)) go (conNames_NP p))
  where
    go :: forall xs . All ConNamesRecursive xs => K Text xs -> K Tree xs
    go = mapKK (\ cn -> Tree cn (concat (collapse_NP (conNamesRecursive_NP @xs))))

泛型定义从conNames_NP它开始是一个 n 元乘积，其中包含顶级类型的每个构造函数名称，即 a NP (K Text) (Code a)。如果我们映射这个（使用cmap_NP），我们必须说明如何处理与每个构造函数对应的代码。这是由go. 该函数将名称转换为 a 的根Tree，并通过调用 给出子级conNamesRecursive_NP，其定义如下：

conNamesRecursive_NP :: forall xs . All ConNamesRecursive xs => NP (K [Tree]) xs
conNamesRecursive_NP =
  cpure_NP (Proxy @ConNamesRecursive) go
  where
    go :: forall a . ConNamesRecursive a => K [Tree] a
    go = K (conNamesRecursive (Proxy @a))

这是一个函数，只是再次调用conNamesRecursive构造函数的每个组件。因为这个函数是类型类的成员，所以我们必须在一开始就要求原始数据类型代码中出现的所有组件本身都是这个类的成员。

在我们可以在具体示例类型上使用它之前，我们必须使它们（以及内部某处出现的所有类型）成为ConNamesRecursive.

我们可以通过使用来做到这一点DeriveAnyClass：

data SimpleTree =
    Nil
  | Node Text SimpleTree SimpleTree
  deriving (Show, GHC.Generic, Generic, HasDatatypeInfo, ConNamesRecursive)

data Exp =
    Union SimpleTree
  | Intersection SimpleTree
  deriving (Show, GHC.Generic, Generic, HasDatatypeInfo, ConNamesRecursive)

请注意，我更改String为TextinNode这样我就不必决定如何处理字符列表，而可以将Text其视为抽象类型。抽象类型可以成为ConNamesRecursive类的成员，生成一个空的树列表。

instance ConNamesRecursive Text where
  conNamesRecursive _ = []

最后，为了使这更容易可视化，我unDup在树上实现了一个（天真的）函数，如果构造函数出现在其自身下方，该函数就会停止：

unDup :: [Tree] -> [Tree]
unDup = go Set.empty
  where
    go :: Set.Set Text -> [Tree] -> [Tree]
    go seen ts =
      map
        (\ (Tree cn children) ->
          Tree cn (if cn `Set.member` seen then [] else go (Set.insert cn seen) children)
        )
        ts

现在我们可以测试：

GHCi> unDup $ conNamesRecursive (Proxy @Exp)
[Tree "Union"
  [Tree "Nil" []
  ,Tree "Node"
    [Tree "Nil" []
    ,Tree "Node" []
    ,Tree "Nil" []
    ,Tree "Node" []
    ]
  ]
  ,Tree "Intersection"
    [Tree "Nil" []
    ,Tree "Node"
      [Tree "Nil" []
      ,Tree "Node" []
      ,Tree "Nil" []
      ,Tree "Node" []
    ]
  ]
]

（添加布局以提高可读性。）

当然，在这里可以实现各种变化。

正如我之前所说，这个函数比大多数通用函数更难定义，因为我们既不使用我们分析的类型的值，也不产生我们分析的类型的值，但我们产生的值是一个常量类型[Tree]，因此 GHC 的类型信息很少，这意味着比平常更多的类型参数/具有类型签名的辅助函数。

我希望这能给你一个想法。