module Data.Chatty.Hetero where
infixr 9 :-:
data Cons a b = (:-:) a b
data Nil = Nil
class Append a b ab | a b -> ab where
tappend :: a -> b -> ab
instance Append Nil b b where
tappend Nil b = b
instance Append b c bc => Append (Cons a b) c (Cons a bc) where
tappend (a :-: b) c = a :-: tappend b c
class IntoMaybe a ar | a -> ar where
tjust :: a -> ar
tnothing :: a -> ar
instance IntoMaybe Nil Nil where
tjust Nil = Nil
tnothing a = Nil
instance IntoMaybe (Cons a as) (Cons (Maybe (Cons a as)) Nil) where
tjust a = Just a :-: Nil
tnothing a = Nothing :-: Nil
class Tuplify l t | l -> t where
tuplify :: l -> t
instance Tuplify Nil () where
tuplify Nil = ()
instance Tuplify a ar => Tuplify (Cons a Nil) ar where
tuplify (a :-: Nil) = tuplify a
instance (Tuplify a ar, Tuplify b br) => Tuplify (Cons a (Cons b Nil)) (ar,br) where
tuplify (a :-: b :-: Nil) = (tuplify a, tuplify b)
instance (Tuplify a ar, Tuplify b br, Tuplify c cr) => Tuplify (Cons a (Cons b (Cons c Nil))) (ar,br,cr) where
tuplify (a :-: b :-: c :-: Nil) = (tuplify a, tuplify b, tuplify c)
instance (Tuplify a ar, Tuplify b br, Tuplify c cr, Tuplify d dr) => Tuplify (Cons a (Cons b (Cons c (Cons d Nil)))) (ar,br,cr,dr) where
tuplify (a :-: b :-: c :-: d :-: Nil) = (tuplify a, tuplify b,tuplify c,tuplify d)
instance (Tuplify a ar, Tuplify b br, Tuplify c cr, Tuplify d dr, Tuplify e er) => Tuplify (Cons a (Cons b (Cons c (Cons d (Cons e Nil))))) (ar,br,cr,dr,er) where
tuplify (a :-: b :-: c :-: d :-: e :-: Nil) = (tuplify a,tuplify b,tuplify c,tuplify d,tuplify e)
instance (Tuplify a ar, Tuplify b br, Tuplify c cr, Tuplify d dr, Tuplify e er, Tuplify f fr) => Tuplify (Cons a (Cons b (Cons c (Cons d (Cons e (Cons f Nil)))))) (ar,br,cr,dr,er,fr) where
tuplify (a :-: b :-: c :-: d :-: e :-: f :-: Nil) = (tuplify a,tuplify b,tuplify c,tuplify d,tuplify e,tuplify f)
instance Tuplify Int Int where
tuplify = id
instance Tuplify Char Char where
tuplify = id
instance Tuplify a ar => Tuplify [a] [ar] where
tuplify = map tuplify
instance Tuplify a ar => Tuplify (Maybe a) (Maybe ar) where
tuplify = fmap tuplify
data Titled a = Titled String a
instance Tuplify a ar => Tuplify (Titled a) ar where
tuplify (Titled _ a) = tuplify a