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

Я пытаюсь сделать что-то похожее на расширенный трюк перекрытия, чтобы определить экземпляр с перекрывающимся поведением. Я пытаюсь вывести экземпляр для кортежа, который будет использовать экземпляр для поля fst, если оно существует, в противном случае используйте экземпляр для поля snd, если оно существует. Это в конечном счете приводит к кажущейся неправильной ошибке о перекрывающихся экземплярах.

Начнем с того, что я использую всю кухонную раковину, кроме OverlappingInstances.

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}

Я тоже используя поликинд Proxy и уровень типа или, :||:.

import Data.Proxy

type family (:||:) (a :: Bool) (b :: Bool) :: Bool
type instance (:||:) False a = a
type instance (:||:) True a = True

A это очень простой класс, чтобы играть. ThingA имеет экземпляр A; ThingB Нет.

class A x where
    traceA :: x -> String

data ThingA = ThingA
data ThingB = ThingB

instance A ThingA where
    traceA = const "ThingA"

Цель следующих частей-написать экземпляр A для (x, y), который будет определен до тех пор, пока существует экземпляр A x или A y. Если есть экземпляр A x, он вернет ("fst " ++) . traceA . fst. Если естьне экземпляр A x, но есть экземпляр B x, он вернется ("snd " ++) . traceA . fst. Первым шагом будет создание функциональной зависимости для проверки наличия экземпляра Aпутем сопоставления с заголовком экземпляра. Это обычный подход из статьи advanced overlap.

class APred (flag :: Bool) x | x -> flag

instance APred 'True ThingA
instance (flag ~ 'False) => APred flag x

Если мы можем определить, имеют ли x и y оба экземпляра A, мы можем определить, будет ли у (x, y) один.

instance (APred xflag x, APred yflag y, t ~ (xflag :||: yflag)) => APred t (x, y)

Теперь я собираюсь отойти от простого примера в расширенном перекрытии и ввести вторую функциональную зависимость чтобы выбрать, следует ли использовать экземпляр A x или A y. (Мы могли бы использовать другой вид, чем Bool для Chooses и SwitchA, чтобы избежать путаницы с APred.)

class Chooses (flag :: Bool) x | x -> flag

Если есть экземпляр A x, мы всегда выберем 'True, в противном случае 'False.

instance (APred 'True x) => Chooses 'True (x, y) 
instance (flag ~ 'False) => Chooses flag (x, y)

Затем, как и в расширенном примере перекрытия, я определяю класс, идентичный A, за исключением дополнительной переменной типа для выбора и аргумента Proxy для каждого члена.

class SwitchA (flag :: Bool) x where
    switchA :: Proxy flag -> x -> String

Это легко определить экземпляры ибо

instance (A x) => SwitchA 'True (x, y) where
    switchA _ = ("fst " ++) . traceA . fst

instance (A y) => SwitchA 'False (x, y) where
    switchA _ = ("snd " ++) . traceA . snd

Наконец, если существует экземпляр SwitchA для того же типа, который (x, y) Chooses, мы можем определить экземпляр A (x, y).

instance (Chooses flag (x, y), SwitchA flag (x, y)) => A (x, y) where
    traceA = switchA (Proxy :: Proxy flag)

Все до сих пор прекрасно компилируется. Однако, если я попытаюсь добавить

traceA (ThingA, ThingB)

Я получаю следующую ошибку.

    Overlapping instances for Chooses 'True (ThingA, ThingB)
      arising from a use of `traceA'
    Matching instances:
      instance APred 'True x => Chooses 'True (x, y)
        -- Defined at defaultOverlap.hs:46:10
      instance flag ~ 'False => Chooses flag (x, y)
        -- Defined at defaultOverlap.hs:47:10
    In the first argument of `print', namely
      `(traceA (ThingA, ThingA))'

Что здесь происходит? Почему эти экземпляры перекрываются при поиске экземпляра для Chooses 'True ...; не должен ли экземпляр instance flag ~ 'False => Chooses flag ... не совпадать, когда flag уже известен как 'True?

Наоборот, если я попытаюсь

traceA (ThingB, ThingA)

Я получаю ошибку

    No instance for (A ThingB) arising from a use of `traceA'
    In the first argument of `print', namely
      `(traceA (ThingB, ThingA))'

Любое понимание того, что происходит, когда я пытаюсь заставить компилятор делать то, что он не должен делать, было бы полезно.

Edit-Упрощение

Основываясь на наблюдении из этого ответа , мы можем полностью избавиться от Chooses и написать

instance (APred choice x, SwitchA choice (x, y)) => A (x, y) where
    traceA = switchA (Proxy :: Proxy choice)

Это решает проблему для traceA (ThingB, ThingA)