Определение дополнительных сред без использования перекрывающихся экземпляров

Как определить среду, в которую мы можем добавить "возможности", не сталкиваясь с перекрывающимися экземплярами?

Предположим, у нас есть следующие типы данных и классы типов:

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
Другие вопросы по тегам