将没有 运行 的增量环境定义为重叠实例
Defining incremental environments without running into overlapping instances
如何定义一个环境,我们可以将 "capabilities" 添加到没有 运行 的重叠实例中?
假设我们有以下数据类型和类型-类:
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
,我们不能只
pass ([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
有没有办法优雅地解决这个问题?
目前Sum
个实例的问题是我们不知道我们要找的对象是在左边还是右边。
计划如下:环境的每个组件都应声明它提供的功能,以便我们随后可以搜索它。
Gist 这个答案。
声明功能
随着环境的组合,我们将需要一个 (type-level) 数据结构来承载来自不同部分的功能。我们将使用二叉树,因此我们可以保留组件的结构。
-- 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)
查找功能
如开头所说,当遇到一对:&
时,我们需要判断是在左分量还是右分量中寻找能力。因此,我们从一个函数(在类型级别)开始 returns 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
这个class现在有一个超级class约束:我们正在寻找的能力确实可用。
class (In item (Contents basket) ~ 'True)
=> Has item basket where
get :: basket -> Name -> Maybe item
这似乎是多余的,因为如果找不到该功能,实例解析无论如何都会失败,但是精确的 superclass 约束有好处:
防止错误:编译器会在有缺失的时候提前报错;
一种文档形式,通知我们实例可能存在的时间。
叶子实例
instance Has Fruit [Fruit] where
get = (...)
instance Has Vegetable [Vegetable] where
get = (...)
instance Has Legume [Legume] where
get = (...)
我们不需要编写像Has Fruit [Vegetable]
这样的可疑实例;我们实际上不能:它们会与 superclass 约束相矛盾。
(:&)
的实例
我们需要遵从新的 class、PairHas
来区分两侧的 In
谓词的结果,以确定要放大环境的哪一部分.
instance PairHas item a b (In item (Contents a)) (In item (Contents b))
=> Has item (a :& b) where
get = getPair
同样,我们使 superclass 约束更加精确地体现了 PairHas
的意图。 inA
和inB
只能分别用In item (Contents a)
和In item (Contents b)
实例化,它们的析取应该是True
,也就是说可以找到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
当然,我们有两个实例分别向左和向右移动,使用递归 Has
约束(请注意,Has
通过其自身的 superclass 约束提供一个相等性)。
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
在 compile-time 处打印自定义错误消息。我们也可以默认选择任一侧。
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
我们还可以为双方都为假的情况编写自定义错误消息。这有点令人惊讶,因为这与 superclass 约束 (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
如何定义一个环境,我们可以将 "capabilities" 添加到没有 运行 的重叠实例中?
假设我们有以下数据类型和类型-类:
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
,我们不能只
pass ([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
有没有办法优雅地解决这个问题?
目前Sum
个实例的问题是我们不知道我们要找的对象是在左边还是右边。
计划如下:环境的每个组件都应声明它提供的功能,以便我们随后可以搜索它。
Gist 这个答案。
声明功能
随着环境的组合,我们将需要一个 (type-level) 数据结构来承载来自不同部分的功能。我们将使用二叉树,因此我们可以保留组件的结构。
-- 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)
查找功能
如开头所说,当遇到一对:&
时,我们需要判断是在左分量还是右分量中寻找能力。因此,我们从一个函数(在类型级别)开始 returns 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
这个class现在有一个超级class约束:我们正在寻找的能力确实可用。
class (In item (Contents basket) ~ 'True)
=> Has item basket where
get :: basket -> Name -> Maybe item
这似乎是多余的,因为如果找不到该功能,实例解析无论如何都会失败,但是精确的 superclass 约束有好处:
防止错误:编译器会在有缺失的时候提前报错;
一种文档形式,通知我们实例可能存在的时间。
叶子实例
instance Has Fruit [Fruit] where
get = (...)
instance Has Vegetable [Vegetable] where
get = (...)
instance Has Legume [Legume] where
get = (...)
我们不需要编写像Has Fruit [Vegetable]
这样的可疑实例;我们实际上不能:它们会与 superclass 约束相矛盾。
(:&)
的实例
我们需要遵从新的 class、PairHas
来区分两侧的 In
谓词的结果,以确定要放大环境的哪一部分.
instance PairHas item a b (In item (Contents a)) (In item (Contents b))
=> Has item (a :& b) where
get = getPair
同样,我们使 superclass 约束更加精确地体现了 PairHas
的意图。 inA
和inB
只能分别用In item (Contents a)
和In item (Contents b)
实例化,它们的析取应该是True
,也就是说可以找到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
当然,我们有两个实例分别向左和向右移动,使用递归 Has
约束(请注意,Has
通过其自身的 superclass 约束提供一个相等性)。
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
在 compile-time 处打印自定义错误消息。我们也可以默认选择任一侧。
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
我们还可以为双方都为假的情况编写自定义错误消息。这有点令人惊讶,因为这与 superclass 约束 (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