用数据族替换单例数据类型

Question

所以在我当前的项目中，我发现自己用单例类型做了一堆类型级逻辑。

例如：

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
module TypeBools where

type family (||) (a :: Bool) (b :: Bool) :: Bool where
  'False  || 'False = 'False
  'False  || 'True  = 'True
  'True   || 'False = 'True
  'True   || 'True  = 'True

data OrProof (a :: Bool) (b :: Bool) (c :: Bool) where
  OrProof :: SBool (a || b) -> OrProof a b (a || b)

data SBool (b :: Bool) where
  SFalse  :: SBool 'False
  STrue   :: SBool 'True

class Boolean b where
  sBool :: SBool b
instance Boolean 'False where
  sBool = SFalse
instance Boolean 'True where
  sBool = STrue

orProof :: (Boolean a, Boolean b) => OrProof a b (a || b)
orProof = go sBool sBool where

  go :: SBool a -> SBool b -> OrProof a b (a || b)
  go SFalse SFalse = OrProof SFalse
  go SFalse STrue = OrProof STrue
  go STrue SFalse = OrProof STrue
  go STrue STrue = OrProof STrue

这对我来说效果很好。我喜欢不必四处兜风手动输入单例，必要时可以通过 typeclass 调用它们（例如上面的 Boolean class），但这导致了一堆相当相似的 typeclasses 仅用于将类型具体化为单例数据。

我想也许我可以将那些多种类型class抽象成一个单一的类型族，例如，将上面的 SBool 和 Boolean 替换为：

{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ConstraintKinds #-}
-- ...
class Singleton (t :: k) where
  data Sing t
  sing :: Sing t

instance Singleton 'False where
  data Sing 'False = SFalse
  sing = SFalse

instance Singleton 'True where
  data Sing 'True = STrue
  sing = STrue

type SBool b = Sing (b :: Bool)

type Boolean b = Singleton (b :: Bool)
sBool :: Boolean b => SBool b
sBool = sing

但随后出现模式匹配错误：

TypeBools2.hs:42:13:
    Couldn't match type ‘b1’ with ‘'True’
      ‘b1’ is a rigid type variable bound by
           the type signature for
             go :: SBool a1 -> SBool b1 -> OrProof a1 b1 (a1 || b1)
           at TypeBools2.hs:40:9
    Expected type: SBool b1
      Actual type: Sing 'True
    Relevant bindings include
      go :: SBool a1 -> SBool b1 -> OrProof a1 b1 (a1 || b1)
        (bound at TypeBools2.hs:41:3)
    In the pattern: STrue
    In an equation for ‘go’: go SFalse STrue = OrProof STrue
    In an equation for ‘orProof’:
        orProof
          = go sBool sBool
          where
              go :: SBool a -> SBool b -> OrProof a b (a || b)
              go SFalse SFalse = OrProof SFalse
              go SFalse STrue = OrProof STrue
              go STrue SFalse = OrProof STrue
              go STrue STrue = OrProof STrue

我不确定是否还有更多的东西可以说服编译器 b1 应该有种类 Bool，或者如果我只是在这里吠叫错误的树。

Answer 1

您可以在 singletons 中找到您请求的功能以及更多内容。很长一段时间以来，它一直是类型级编程的权威模板。您应该使用它或复制实现。不管怎样，我将在这里简要展示一个简化的 singletons 解决方案。

您的模式匹配不起作用，因为 STrue 和 SFalse 处于不同的数据定义中，并且它们一开始就不是 GADT。模式匹配只有在正确的 GADT-s 上完成时才会改进类型。我们需要按种类进行分派，以便能够将一种类型的所有单例构造函数组合在一起。

我们可以使用适当的种类 class 或顶级数据系列来做到这一点。后者现在对我们的目的来说更简单，所以让我们这样做：

data family Sing (x :: k)

data instance Sing (b :: Bool) where
  STrue :: Sing True
  SFalse :: Sing False

使用 sing 我们不需要 kind dispatch 因为我们只用它来获取特定的提升值，所以下面的工作：

class SingI (x :: k) where
   sing :: Sing x

instance SingI True  where sing = STrue
instance SingI False where sing = SFalse

至于 orProof，我们想要的是类型级别 (||) 的单例，这可以通过以下类型最直接地实现：Sing b1-> Sing b2 -> Sing (b1 || b2)。我们将根据象形文字 singletons 命名惯例将其命名为 (%:||)。

type family (:||) (b1 :: Bool) (b2 :: Bool) :: Bool where
  True  :|| b = True
  False :|| b = b

(%:||) :: Sing b1 -> Sing b2 -> Sing (b1 :|| b2)
(%:||) STrue  b2 = STrue
(%:||) SFalse b2 = b2

OrProof 不是很有用，因为它只是一个专门的相等类型以及 SingI 约束或普通的 Sing c:

type OrProof a b c = SingI c => c :~: (a :|| b)
type OrProof' a b c = (Sing c, c :~: (a :|| b))

用数据族替换单例数据类型

Replacing singleton data types with a data family

haskell

type-families

dependent-type