代码之家 › 专栏 › 技术社区 › Damian Nadales

在不遇到重叠实例的情况下定义增量环境

overlapping-instances haskell

Damian Nadales · 技术社区 · 7 年前

如何定义一个可以添加“功能”的环境,而不会遇到重叠的实例?

假设我们有以下数据类型和类型类:

type Name = String

data Fruit = Orange | Pear | Apple

data Vegetable = Cucumber | Carrot | Spinach

data Legume = Lentils | Chickpeas | BlackEyedPeas

class HasFruit e where
    getFruit :: e -> Name -> Maybe Fruit

class HasVegetable e where
    getVegetable :: e -> Name -> Maybe Vegetable

class HasLegume e where
    getLegume :: e -> Name -> Maybe Legume

现在,我们想定义几个需要环境中某些成分的功能:

data Smootie

mkSmoothie :: (HasFruit e, HasVegetable e) => e -> Smootie
mkSmoothie = undefined

data Salad

mkSalad :: (HasVegetable e, HasLegume e) => e -> Salad
mkSalad = undefined

我们定义了 Has* :

instance HasFruit [Fruit] where
    getFruit = undefined

instance HasVegetable [Vegetable] where
    getVegetable = undefined

instance HasLegume [Legume] where
    getLegume = undefined

最后,我们想定义一个函数来准备冰沙和沙拉:

cook :: (Smootie, Salad)
cook = let ingredients = undefined in
    (mkSmoothie ingredients, mkSalad ingredients)

现在,第一个问题是,将什么作为成分传递给可以使用上面定义的实例?我的第一个解决方案是使用元组:

instance HasFruit e0 => HasFruit (e0, e1, e2) where
    getFruit (e0, _, _) = getFruit e0

instance HasVegetable e1 => HasVegetable (e0, e1, e2) where
    getVegetable (_, e1, _) = getVegetable e1

instance HasLegume e2 => HasLegume (e0, e1, e2) where
    getLegume (_, _, e2) = getLegume e2

cook :: (Smootie, Salad)
cook = let ingredients = ([Orange], [Cucumber], [BlackEyedPeas]) in
    (mkSmoothie ingredients, mkSalad ingredients)

这虽然很麻烦,但很有效。但现在假设我们决定添加 mkStew ,这需要一些 HasMeat 例子然后我们必须更改上面的所有实例。此外如果我们想使用 mkSmothie 孤立地说,我们不能通过 ([Orange], [Cucumber]) 因为没有定义实例为了它。

我可以定义:

data Sum a b = Sum a b

实例如下:

instance HasFruit e0 => HasFruit (Sum e0 e1) where
    getFruit (Sum e0 _) = getFruit e0

instance HasVegetable e1 => HasVegetable (Sum e0 e1) where
    getVegetable (Sum _ e1) = getVegetable e1

instance HasLegume e1 => HasLegume (Sum e0 e1) where
    getLegume (Sum _ e1) = getLegume e1

但以下方法行不通(没有 HasVegetable [Legume] ):

cook1 :: (Smootie, Salad)
cook1 = let ingredients = Sum [Orange] (Sum [Cucumber] [BlackEyedPeas]) in
    (mkSmoothie ingredients, mkSalad ingredients)

这个实例将重叠!

instance HasVegetable e0 => HasVegetable (Sum e0 e1) where
    getVegetable (Sum e0 e1) = getVegetable e0

有没有办法优雅地解决这个问题?

1 回复 | 直到 7 年前

Li-yao Xia 7 年前

现在的问题 Sum 例如,我们不知道要找的对象是在左边还是在右边。

计划是这样的:环境的每个组件都应该声明它提供了什么功能,以便我们可以搜索它。

Gist 这个答案。

声明功能

随着环境的组成,我们将需要一个(类型级)数据结构来承载不同部分的功能。我们将使用二叉树,以便保留组件的结构。

-- Tree of capabilities (ingredient categories)
data Tree a = Leaf a | Node (Tree a) (Tree a)

通过此类型族声明与环境关联的功能。

type family Contents basket :: Tree *

type instance Contents [Fruit] = 'Leaf Fruit
type instance Contents [Vegetable] = 'Leaf Vegetable
type instance Contents [Legume] = 'Leaf Legume

-- Pair of environments
data a :& b = a :& b  -- "Sum" was confusing

-- The capabilities of a pair are the pair of their capabilities.
type instance Contents (a :& b) = 'Node (Contents a) (Contents b)

-- e.g., Contents ([Fruit] :& [Vegetable]) = 'Node ('Leaf Fruit) ('Leaf Vegetable)

查找功能

如开头所述,当遇到一对 :& ,我们需要告诉您是在左侧组件中查找功能,还是在右侧组件中查找功能。因此,我们从一个返回 True 如果该功能可以在树中找到。

type family In (x :: *) (ys :: Tree *) :: Bool where
  In x (Leaf y) = x == y
  In x (Node l r) = In x l || In x r

type family x == y :: Bool where
  x == x = 'True
  x == y = 'False

这个 `Has` 班

这个类现在有一个超类约束:我们正在寻找的功能确实可用。

class (In item (Contents basket) ~ 'True)
      => Has item basket where
  get :: basket -> Name -> Maybe item

这似乎是多余的,因为如果找不到该功能,实例解析无论如何都会失败,但精确的超类约束有好处:

防止错误:如果缺少一些东西,编译器会提前投诉;
一种文档形式,通知我们何时可能存在实例。

叶实例

instance Has Fruit [Fruit] where
  get = (...)

instance Has Vegetable [Vegetable] where
  get = (...)

instance Has Legume [Legume] where
  get = (...)

我们不需要编写可疑的实例,例如 Has Fruit [Vegetable] ;我们实际上不能这样做:它们会与超类约束相矛盾。

的实例 `(:&)`

我们需要服从一个新的班级, PairHas 这将对 In 在两侧进行谓词,以确定要放大的环境的哪个部分。

instance PairHas item a b (In item (Contents a)) (In item (Contents b))
         => Has item (a :& b) where
  get = getPair

同样,我们使超类约束对 佩尔哈斯 。 inA 和 inB 只能用实例化 In item (Contents a) 和 In item (Contents b) 它们的析取应该是 真的 ,意思是 item 至少可以在其中一个中找到。

class ( In item (Contents a) ~ inA
      , In item (Contents b) ~ inB
      , (inA || inB) ~ 'True)
      => PairHas item a b inA inB where
  getPair :: (a :& b) -> Name -> Maybe item

当然,我们有两个分别向左和向右的实例,使用递归 有 约束条件(请注意 有 通过其自身的超类约束提供一个等式)。

instance ( Has item a
         , In item (Contents b) ~ 'False)
         => PairHas item a b 'True 'False where
  getPair (a :& _) = get a

instance ( In item (Contents a) ~ 'False
         , Has item b)
         => PairHas item a b 'False 'True where
  getPair (_ :& b) = get b

如果双方都有相同的能力呢?我们将认为这是一个错误,并要求用户通过其他机制显式隐藏其中一个重复功能。我们可以使用 TypeError 在编译时打印自定义错误消息。默认情况下,我们也可以选择任意一方。

instance (TypeError (Text "Duplicate contents")  -- can be more descriptive
         , In item (Contents a) ~ 'True
         , In item (Contents b) ~ 'True)
         => PairHas item a b 'True 'True where
  getPair = undefined

我们还可以为双方都为false的情况编写自定义错误消息。这有点奇怪,因为这与超类约束相矛盾 (inA || inB) ~ 'True ,但信息会打印出来,所以我们不会抱怨。

instance ( TypeError (Text "Not found")  -- can be more descriptive
         , In item (Contents a) ~ 'False
         , In item (Contents b) ~ 'False
         , 'False ~ 'True)
         => PairHas item a b 'False 'False where
  getPair = undefined

我们做饭吧

现在我们可以安全地写了 cook :

cook :: (Smootie, Salad)
cook = let ingredients = [Orange] :& [Cucumber] :& [BlackEyedPeas] in
  (mkSmootie ingredients, mkSalad ingredients)

你也可以看到如果你重复或忘记了一些成分会发生什么

cook :: (Smootie, Salad)
cook = let ingredients = [Orange] :& [Cucumber] :& [BlackEyedPeas] :& [Pear] in
  (mkSmootie ingredients, mkSalad ingredients)

-- error: Duplicate contents

cook :: (Smootie, Salad)
cook = let ingredients = [Orange] :& [Cucumber] in
  (mkSmootie ingredients, mkSalad ingredients)

-- error: Not found