代码之家 › 专栏 › 技术社区 › ony

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

typeclass ghc types haskell

ony · 技术社区 · 14 年前

我有两个不重叠的类型集,我想创建另一个类型集,它是这两个类型的联合。代码示例:

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

我理解,这一声明导致对 AB a 因为的实例 A a 和 B b 以后可能会出现(我看不出简单的方法来处理)。
我想应该有一些“周围工作”来达到同样的行为。

P.S.变体,如:

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)

而包装这些类型的任何其他类型都不适合我的需要(选择由声明的第三方实现班类型的)

对@camcann的评论: 在flag上添加flag来控制合并/选择类型是个不错的主意,但是我想避免类似重叠实例的竞争。对于对这个答案感兴趣的人,压缩变量:

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

1 回复 | 直到 14 年前

C. A. McCann Ravikant Cherukuri 14 年前

据我所知,要做到这一点,没有“好”的方法。你总是在某个地方添加油垢。因为您不需要包装器类型,所以我可以考虑的另一个选项是处理类定义,这意味着我们将开始输入元编程领域。

现在,这种方法之所以不“好”的原因是类约束基本上是 不可撤销的 . 一旦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 直接在实例头中被解释为谓词总是计算为假,这没有帮助。使用 类型转换 相反,要等到ghc选择最具体的重叠实例之后,这将强制结果为 不 当且仅当找不到更具体的实例时。

我将对类型类本身进行另一个不严格必要的调整:

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

注意,如果两个谓词都为真,我们将显式地选择 A 实例。注释掉的实例执行相同的操作,但使用 B 相反。您也可以同时删除这两个类,在这种情况下,您将得到这两个类的独占分离。这个 bval 这是我使用的 丁字醇 班级。还要注意类型签名以获得正确的类型布尔值——这需要 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 ())
  . . .

这里是 类型转换 代码,由 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