在 Haskell 中将两个类合并/合并为一个

Question

我有两个不重叠的类型集，并且想要制作其他集，这是这两个的并集。代码示例：

class A a
class B b
class AB ab

instance A a => AB a
instance B b => AB b

GHC 6.12.3 不允许使用错误消息声明这一点：

    重复的实例声明：
      instance (A a) => AB a -- 定义于 playground.hs:8:9-19
      实例 (B b) => AB b -- 在 playground.hs:9:9-19 定义

我明白，这个声明导致失去对重叠实例的控制，AB a因为实例 forA a和B b稍后可能出现（我看不出处理这个的简单方法）。
我想应该有一些“变通办法”来获得相同的行为。

PS 变体如：

newtype A a => WrapA a = WrapA a
newtype B b => WrapB b = WrapB b

instance A a => AB (WrapA a)
instance B b => AB (WrapB b)

和

data WrapAB a b = A a => WrapA a
                | B b => WrapB b

instance AB (WrapAB a b)

和任何其他包装这些类型的东西都不适合我的需要（选择由第三方声明的类型类实现）

对@camccann 的评论： 添加标志来控制标志上的合并/选择类型是个好主意，但我想避免诸如重叠实例的竞争之类的事情。对于对这个答案感兴趣的人，压缩变体：

data Yes
data No

class IsA a flag | a -> flag
class IsB b flag | b -> flag

instance Delay No flag => IsA a flag
instance Delay No flag  => IsB b flag

instance (IsA ab isA, IsB ab isB, AB' isA isB ab) => AB ab

class AB' isA isB ab
instance (A a) => AB' Yes No a
instance (B b) => AB' No Yes b
instance (A a) => AB' Yes Yes a

class Delay a b | a -> b
instance Delay a a

instance IsA Bool Yes
instance A Bool

Answer 1

据我所知，没有“好的”方法可以实现这一点。你被困在某个地方添加垃圾。由于您不需要包装类型，所以我能想到的另一个选择是弄乱类定义，这意味着我们要进入类型元编程领域。

现在，这种方法不会“好”的原因是类约束基本上是不可撤销的。一旦 GHC 看到约束，它就会坚持下去，如果它不能满足约束，编译就会失败。这对于类实例的“交集”来说很好，但对于“并集”没有帮助。

为了解决这个问题，我们需要带有类型级布尔值的类型谓词，而不是直接的类约束。为此，我们使用具有函数依赖性的多参数类型类来创建类型函数，并使用延迟统一的重叠实例来编写“默认实例”。

首先，我们需要一些有趣的语言语法：

{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE UndecidableInstances #-}

定义一些类型级布尔值：

data Yes = Yes deriving Show
data No = No deriving Show

class TypeBool b where bval :: b
instance TypeBool Yes where bval = Yes
instance TypeBool No where bval = No

该类TypeBool并不是绝对必要的——我主要使用它来避免使用undefined.

接下来，我们为要进行并集的类型类编写成员谓词，并使用默认实例作为失败案例：

class (TypeBool flag) => IsA a flag | a -> flag
class (TypeBool flag) => IsB b flag | b -> flag 

instance (TypeBool flag, TypeCast flag No) => IsA a flag
instance (TypeBool flag, TypeCast flag No) => IsB b flag

约束TypeCast当然是 Oleg 臭名昭著的类型统一类。它的代码可以在这个答案的末尾找到。这里有必要延迟选择结果类型——fundep 说第一个参数决定第二个参数，并且默认实例是完全通用的，因此No直接放入实例头将被解释为谓词始终评估为 false，这是没有帮助。相反，使用TypeCast会等到 GHC 选择最具体的重叠实例之后，这会强制结果是No当且仅当找不到更具体的实例时。

我将对类型类本身进行另一个并非严格必要的调整：

class (IsA a Yes) => A a where
    fA :: a -> Bool
    gA :: a -> Int

class (IsB b Yes) => B b where
    fB :: b -> Bool
    gB :: b -> b -> String

类上下文约束确保，如果我们为类编写实例而不编写匹配的谓词实例，我们将立即得到一个神秘的错误，而不是稍后出现非常令人困惑的错误。为了演示目的，我还向类添加了一些函数。

接下来，联合类被分成两部分。第一个有一个通用实例，仅应用成员谓词并调用第二个实例，第二个实例将谓词结果映射到实际实例。

class AB ab where 
    fAB :: ab -> Bool
instance (IsA ab isA, IsB ab isB, AB' isA isB ab) => AB ab where
    fAB = fAB' (bval :: isA) (bval :: isB)

class AB' isA isB ab where fAB' :: isA -> isB -> ab -> Bool
instance (A a) => AB' Yes No a where fAB' Yes No = fA
instance (B b) => AB' No Yes b where fAB' No Yes = fB
instance (A ab) => AB' Yes Yes ab where fAB' Yes Yes = fA
-- instance (B ab) => AB' Yes Yes ab where fAB' Yes Yes = fB

请注意，如果两个谓词都为 true，我们将显式选择实例A。注释掉的实例执行相同的操作，但使用了B替代方法。您也可以删除两者，在这种情况下，您将获得两个类的独占析取。这bval是我使用该类的地方TypeBool。另请注意类型签名以获得正确的类型布尔值——这需要ScopedTypeVariables我们在上面启用的。

总结一下，尝试一些实例：

instance IsA Int Yes
instance A Int where
    fA = (> 0)
    gA = (+ 1)

instance IsB String Yes
instance B String where
    fB = not . null
    gB = (++)

instance IsA Bool Yes
instance A Bool where
    fA = id
    gA = fromEnum

instance IsB Bool Yes
instance B Bool where
    fB = not
    gB x y = show (x && y)

在 GHCi 中尝试一下：

> fAB True
True
> fAB ""
False
> fAB (5 :: Int)
True
> fAB ()
No instance for (AB' No No ())
  . . .

这是代码，由OlegTypeCast提供。

class TypeCast   a b   | a -> b, b->a   where typeCast   :: a -> b
class TypeCast'  t a b | t a -> b, t b -> a where typeCast'  :: t->a->b
class TypeCast'' t a b | t a -> b, t b -> a where typeCast'' :: t->a->b
instance TypeCast'  () a b => TypeCast a b where typeCast x = typeCast' () x
instance TypeCast'' t a b => TypeCast' t a b where typeCast' = typeCast''
instance TypeCast'' () a a where typeCast'' _ x  = x