Création d'une concaténation complètement dépendante

Un beau fait vrai sur la concaténation est que si je connais deux variables dans l'équation:

a ++ b = c

Alors je connais le troisième.

Je voudrais capturer cette idée dans mon propre concat donc j'utilise une dépendance fonctionnelle.

{-# Language DataKinds, GADTs, FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, PolyKinds, TypeOperators, UndecidableInstances #-}
import Data.Kind (Type)

class Concatable
   (m  :: k -> Type)
   (as :: k)
   (bs :: k)
   (cs :: k)
   | as bs -> cs
   , as cs -> bs
   , bs cs -> as
   where
     concat' :: m as -> m bs -> m cs

Maintenant, j'évoque une liste hétérogène comme ceci:

data HList ( as :: [ Type ] ) where
  HEmpty :: HList '[]
  HCons  :: a -> HList as -> HList (a ': as)

Mais quand j'essaye de les déclarer car Concatablej'ai un problème

instance Concatable HList '[] bs bs where
  concat' HEmpty bs = bs
instance
  ( Concatable HList as bs cs
  )
    => Concatable HList (a ': as) bs (a ': cs)
  where
    concat' (HCons head tail) bs = HCons head (concat' tail bs)

Je ne satisfait pas ma troisième dépendance fonctionnelle. Ou plutôt le compilateur pense que non. C'est parce que le compilateur pense que dans notre deuxième cas, cela pourrait être le cas bs ~ (a ': cs). Et cela pourrait être le cas si Concatable as (a ': cs) cs.

Comment puis-je ajuster mes instances afin que les trois dépendances soient satisfaites?

Donc, comme le suggèrent les commentaires, GHC ne va pas le comprendre par lui-même, mais nous pouvons l'aider avec un peu de programmation au niveau du type. Présentons-en TypeFamilies. Toutes ces fonctions sont des traductions assez simples de la manipulation de liste élevée au niveau du type:

-- | This will produce the suffix of `cs` without `as`
type family DropPrefix (as :: [Type]) (cs :: [Type]) where
  DropPrefix '[] cs = cs
  DropPrefix (a ': as) (a ': cs) = DropPrefix as cs

-- Similar to the logic in the question itself: list concatenation. 
type family Concat (as :: [Type]) (bs :: [Type]) where
  Concat '[] bs = bs
  Concat (head ': tail) bs = head ': Concat tail bs

-- | Naive list reversal with help of concatenation.
type family Reverse (xs :: [Type]) where
  Reverse '[] = '[]
  Reverse (x ': xs) = Concat (Reverse xs) '[x]

-- | This will produce the prefix of `cs` without `bs`
type family DropSuffix (bs :: [Type]) (cs :: [Type]) where
  DropSuffix bs cs = Reverse (DropPrefix (Reverse bs) (Reverse cs))

-- | Same definition of `HList` as in the question
data HList (as :: [Type]) where
  HEmpty :: HList '[]
  HCons :: a -> HList as -> HList (a ': as)

-- | Definition of concatenation at the value level
concatHList :: (cs ~ Concat as bs) => HList as -> HList bs -> HList cs
concatHList HEmpty bs = bs
concatHList (HCons head tail) bs = HCons head (concatHList tail bs)

Avec ces outils à notre disposition, nous pouvons réellement atteindre l'objectif de l'heure, mais définissons d'abord une fonction avec les propriétés souhaitées:

• Capacité à déduire csde asetbs
• Capacité à déduire asde bsetcs
• Capacité à déduire bsde asetcs

Voila:

concatH ::
     (cs ~ Concat as bs, bs ~ DropPrefix as cs, as ~ DropSuffix bs cs)
  => HList as
  -> HList bs
  -> HList cs
concatH = concatHList

Testons-le:

foo :: HList '[Char, Bool]
foo = HCons 'a' (HCons True HEmpty)

bar :: HList '[Int]
bar = HCons (1 :: Int) HEmpty

λ> :t concatH foo bar
concatH foo bar :: HList '[Char, Bool, Int]
λ> :t concatH bar foo
concatH bar foo :: HList '[Int, Char, Bool]

Et enfin l'objectif final:

class Concatable (m :: k -> Type) (as :: k) (bs :: k) (cs :: k)
  | as bs -> cs
  , as cs -> bs
  , bs cs -> as
  where
  concat' :: m as -> m bs -> m cs

instance (cs ~ Concat as bs, bs ~ DropPrefix as cs, as ~ DropSuffix bs cs) =>
         Concatable HList as bs cs where
  concat' = concatH

λ> :t concat' HEmpty bar
concat' HEmpty bar :: HList '[Int]
λ> :t concat' foo bar
concat' foo bar :: HList '[Char, Bool, Int]
λ> :t concat' bar foo
concat' bar foo :: HList '[Int, Char, Bool]