Слияние/объединение двух классов в один в Haskell

Насколько я знаю, нет "хорошего" способа сделать это. Вы где-то застряли с добавлением хлама. Поскольку вам не нужны типы-оболочки, другой вариант, который я могу придумать, — это вместо этого возиться с определениями классов, что означает, что мы уходим в страну метапрограммирования типов.

Теперь причина, по которой этот подход не будет «хорошим», заключается в том, что ограничения класса в основном безотзывны. Как только 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 — это, конечно же, печально известный класс унификации типов Олега. Код для этого можно найти в конце этого ответа. Здесь необходимо отложить выбор типа результата — fundep говорит, что первый параметр определяет второй, а экземпляры по умолчанию являются полностью универсальными, поэтому размещение No непосредственно в заголовке экземпляра будет интерпретироваться как предикат, всегда оцениваемый как false, что не полезно. Использование TypeCast вместо этого ожидает, пока GHC не выберет наиболее конкретный перекрывающийся экземпляр, что заставляет результат быть No тогда и только тогда, когда более конкретный экземпляр не может быть найден.

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

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 я использую класс TypeBool. Обратите также внимание на сигнатуры типов, чтобы получить правильное логическое значение типа — для этого требуется 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 ())
  . . .

А вот код TypeCast, любезно предоставленный Олегом.

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