haskell - 在 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 不允许使用错误消息声明此内容:

    Duplicate instance declarations:      instance (A a) => AB a -- Defined at playground.hs:8:9-19      instance (B b) => AB b -- Defined at playground.hs:9:9-19

I understand, that this declaration leads to loosing control over overlapping instances of AB a because instances for A a and B b may arise later (and I can't see easy way to handle that).
I guess there should be some "work-around" to get the same behaviour.

P.S. Variants like:

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 看到约束，它就会坚持下去，如果它不能满足约束，编译就会失败。这对于类实例的“交集”来说很好，但对于“并集”没有帮助。

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

首先，我们需要一些有趣的语言编译指示:

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

定义一些类型级 bool 值:

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 类的地方。另请注意用于获取正确类型 bool 值的类型签名 - 这需要我们在上面启用的 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 ())
  . . .

<小时/>

这是 TypeCast 代码，由 Oleg 提供.

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