Определение дополнительных сред без использования перекрывающихся экземпляров
Как определить среду, в которую мы можем добавить "возможности", не сталкиваясь с перекрывающимися экземплярами?
Предположим, у нас есть следующие типы данных и классы типов:
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 ответ
Проблема с настоящим Sum
Например, мы не знаем, находится ли искомый объект слева или справа.
Вот план: каждый компонент среды должен объявить, какие возможности он предлагает, чтобы мы могли затем найти его.
Суть этого ответа.
Объявление возможностей
Поскольку среды будут скомпонованы, нам потребуется структура данных (на уровне типа) для переноса возможностей из их разных частей. Мы будем использовать бинарное дерево, чтобы сохранить структуру компонентов.
-- 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
Опять же, мы делаем ограничения суперкласса более точными относительно намерения 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
обеспечивает одно равенство через собственное ограничение суперкласса).
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
Мы также можем написать собственное сообщение об ошибке для случая, когда обе стороны ложны. Это немного удивительно, потому что это противоречит ограничению суперкласса (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