从组合上将异构提升类型反映回值

Reflecting Heterogeneous Promoted Types back to Values, Compositionally

我最近一直在玩 -XDataKinds,并且想使用类型族构建提升的结构并将其拉回值级别。我相信这是可能的,因为组成部分非常简单,而且终端表达式也很简单。

背景

我想降级/反映 Strings 的简单玫瑰树,它们成为种类 Tree Symbol 的类型(当使用 GHC.TypeLits.Symbol 作为类型级字符串时)。这是我的样板代码:

{-# LANGUAGE DataKinds #-}

import GHC.TypeLits
import Data.Proxy

data Tree a = Node a [Tree a]

type TestInput = '[ 'Node "foo" '[ 'Node "bar" '[]
                                 , 'Node "baz" '[]
                                 ]
                  , 'Node "bar" '[]
                  ]

这是一个简单的类型级玫瑰林,看起来像这个非常详细的图表:

 *-- "foo" -- "bar"
 |         \_ "baz"
  \_ "bar"

尝试的解决方案

理想情况下,我想遍历这个结构并给出一个一对一的映射返回 values of kind *,但是如何做并不是很明显异类地执行此操作,同时由于过载仍保留(必要的)实例。

vanila 在 #haskell 上建议我使用类型 类 来绑定两个世界,但这似乎比我想象的要复杂一些。我的第一次尝试尝试通过实例头约束对类型级模式匹配的内容进行编码,但我的关联类型(对映射的 *-kinded 类型结果进行编码)重叠 - 显然 instance heads are somewhat ignored by GHC .

理想情况下,我还希望列表和树的反射是通用的,这似乎会导致问题 - 就像使用类型 类 来组织 type/kind 层。

这是我想要的非功能性示例:

class Reflect (a :: k) where
  type Result :: *
  reflect :: Proxy a -> Result

class ReflectEmpty (empty :: [k]) where
  reflectEmpty :: forall q. Proxy empty -> [q]
  reflectEmpty _ = []

instance ReflectEmpty '[] where

instance ReflectEmpty a => Reflect a where
  type Result = forall q. [q]
  reflect = reflectEmpty

-- | The superclass constraint is where we get compositional
class Reflect (x :: k) => ReflectCons (cons :: [x]) where
  reflectCons :: PostReflection x ~ c => Proxy cons -> [c]

instance ( Reflect x
         , ReflectCons xs ) => ReflectCons (x ': xs) where
  reflectCons _ = reflect (Proxy :: Proxy x) :
    reflectCons (Proxy :: Proxy xs)

instance ( Reflect x
         , ReflectEmpty e ) => ReflectCons (x ': e) where
  reflectCons _ = reflect (Proxy :: Proxy x) :
    reflectEmpty (Proxy :: Proxy e)

...

这段代码通常有几处错误。这是我看到的:

但是,这种类型类层次结构感觉像是捕获异构语法的唯一方法,所以这可能仍然是一个开始。对此的任何帮助都是巨大的!

惰性解决方案

安装 singletons 软件包:

{-# LANGUAGE
  TemplateHaskell, DataKinds, PolyKinds, TypeFamilies,
  ScopedTypeVariables, FlexibleInstances, UndecidableInstances, GADTs #-}

import GHC.TypeLits
import Data.Singletons.TH
import Data.Singletons.Prelude
import Data.Proxy

$(singletons [d|
  data Tree a = Node a [Tree a] deriving (Eq, Show)
  |])

reflect ::
  forall (a :: k).
  (SingI a, SingKind ('KProxy :: KProxy k)) =>
  Proxy a -> Demote a
reflect _ = fromSing (sing :: Sing a)

-- reflect (Proxy :: Proxy (Node "foo" '[])) == Node "foo" []

我们完成了。

不幸的是,这个库的文档很少而且也很复杂。我建议查看 project homepage 以获得一些额外的文档。我试着解释下面的基础知识。

Sing 是定义单例表示的数据族。单例在结构上与未提升的类型相同,但它们的值由相应的提升值索引。例如,data Nat = Z | S Nat 的单例将是

data instance Sing (n :: Nat) where
  SZ :: Sing Z
  SS :: Sing n -> Sing (S n)

singletons 是生成单例的模板函数(它还提升派生实例,也可以提升函数)。

SingKind 本质上是一种 类型 class,它为我们提供了 Demote 类型和 fromSingDemote 为我们提供了提升值对应的未提升类型。例如,Demote FalseBool,而 Demote "foo"SymbolfromSing 将单例值转换为相应的未提升值。所以 fromSing SZ 等于 Z

SingI 是一个 class,它将提升的值反映为单一值。 sing是它的方法,sing :: Sing x给了我们x的单例值。这几乎就是我们想要的;要完成 reflect 的定义,我们只需要在 sing 上使用 fromSing 来获得未提升的值。

KProxyData.Proxy 的导出。它允许我们从环境中捕获类型变量并在定义中使用它们。请注意,任何类型的可提升数据类型 (* -> *) 都可以用来代替 KProxy。有关数据类型提升的详细信息 see this.

请注意,尽管有一种较弱的种类调度形式,它不需要 KProxy:

type family Demote (a :: k)
type instance Demote (s :: Symbol) = String
type instance Demote (b :: Bool)   = Bool

到目前为止一切顺利,但我们如何为提升列表编写实例?

type instance Demote (xs :: [a]) = [Demote ???] 

Demote a当然是不行的,因为a是一种,不是类型。所以我们需要 KProxy 以便能够在右侧使用 a

自己动手解决

这与 singletons 解决方案类似,但我们故意跳过单例表示并直接进行反射。这应该会更高效一些,我们甚至可能会在此过程中学到一些东西(我当然做到了!)。

import GHC.TypeLits
import Data.Proxy

data Tree a = Node a [Tree a] deriving (Eq, Show)

我们将种类分派实现为一个开放类型家族,并为方便起见提供了一个类型同义词:

type family Demote' (kparam :: KProxy k) :: *  
type Demote (a :: k) = Demote' ('KProxy :: KProxy k)  

一般的模式是,每当我们想提及一种k时,我们都使用'KProxy :: KProxy k

type instance Demote' ('KProxy :: KProxy Symbol) = String
type instance Demote' ('KProxy :: KProxy (Tree a)) = Tree (Demote' ('KProxy :: KProxy a))
type instance Demote' ('KProxy :: KProxy [a]) = [Demote' ('KProxy :: KProxy a)]

现在进行反射非常简单:

class Reflect (a :: k) where
  reflect :: Proxy (a :: k) -> Demote a

instance KnownSymbol s => Reflect (s :: Symbol) where
  reflect = symbolVal

instance Reflect ('[] :: [k]) where
  reflect _ = []

instance (Reflect x, Reflect xs) => Reflect (x ': xs) where
  reflect _ = reflect (Proxy :: Proxy x) : reflect (Proxy :: Proxy xs)

instance (Reflect n, Reflect ns) => Reflect (Node n ns) where
  reflect _ = Node (reflect (Proxy :: Proxy n)) (reflect (Proxy :: Proxy ns))