Erstellen einer vollständig abhängigen Verkettung

Eine nette wahre Tatsache über die Verkettung ist, dass, wenn ich zwei Variablen in der Gleichung kenne:

a ++ b = c

Dann kenne ich den dritten.

Ich möchte diese Idee in meinem eigenen Concat festhalten, damit ich eine funktionale Abhängigkeit verwende.

{-# 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

Jetzt zaubere ich eine heterogene Liste wie folgt:

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

Aber wenn ich versuche, diese zu deklarieren, habe Concatableich ein Problem

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)

Ich erfülle meine dritte funktionale Abhängigkeit nicht. Oder besser gesagt, der Compiler glaubt, dass wir das nicht tun. Dies liegt daran, dass der Compiler der Ansicht ist, dass dies in unserer zweiten Instanz der Fall sein könnte bs ~ (a ': cs). Und es könnte der Fall sein, wenn Concatable as (a ': cs) cs.

Wie kann ich meine Instanzen so anpassen, dass alle drei Abhängigkeiten erfüllt sind?

Wie die Kommentare vermuten lassen, wird GHC es nicht alleine herausfinden, aber wir können es mit ein bisschen Programmierung auf Typebene unterstützen. Lassen Sie uns einige vorstellen TypeFamilies. Alle diese Funktionen sind ziemlich einfache Übersetzungen von Listenmanipulationen, die auf die Textebene angehoben wurden:

-- | 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)

Mit diesen Tools können wir tatsächlich das Stundenziel erreichen, aber zuerst definieren wir eine Funktion mit den gewünschten Eigenschaften:

• Fähigkeit, csaus asund abzuleitenbs
• Fähigkeit, asaus bsund abzuleitencs
• Fähigkeit, bsaus asund abzuleitencs

Voila:

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

Testen wir es:

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]

Und schließlich das Endziel:

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]