Насколько я знаю, нет "хорошего" способа сделать это.Вы застряли с добавлением крафт где-то.Поскольку вам не нужны типы-обертки, другой вариант, о котором я могу подумать, - это возиться с определениями классов, а это означает, что мы переходим к типу-метапрограммированию-land.
Теперь, причина, почему этот подходне будет "хорошо", это то, что ограничения класса в основном безотзывные .Как только 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
Обратите внимание, что, если оба предиката имеют значение true, мы явно выбираемA экземпляр.Закомментированный экземпляр делает то же самое, но вместо него использует B.Вы также можете удалить оба, и в этом случае вы получите исключительную дизъюнкцию двух классов.bval здесь я использую класс TypeBool.Обратите внимание также на сигнатуры типов, чтобы получить правильный тип boolean - для этого требуется 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