Extensible tuples

Tuples.hs

{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs                  #-}
{-# LANGUAGE KindSignatures         #-}
{-# LANGUAGE PolyKinds              #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators          #-}

module Tuples where

data HList (xs :: [*]) where
  Nil  :: HList '[]
  (:>) :: x -> HList xs -> HList (x ': xs)

infixr 5 :>

type family (++) (xs :: [k]) (ys :: [k]) :: [k] where
  '[] ++ ys = ys
  (x ': xs) ++ ys = x ': (xs ++ ys)

append :: HList xs -> HList ys -> HList (xs ++ ys)
append Nil ys = ys
append (x :> xs) ys = x :> (xs `append` ys)

--------------------------------------------------------------------------------
type family AsTuple (xs :: [*]) = r | r -> xs where
  AsTuple '[a, b]
    = (a, b)
  AsTuple '[a, b, c]
    = (a, b, c)
  AsTuple '[a, b, c, d]
    = (a, b, c, d)
  AsTuple '[a, b, c, d, e]
    = (a, b, c, d, e)
  AsTuple '[a, b, c, d, e, f]
    = (a, b, c, d, e, f)
  AsTuple '[a, b, c, d, e, f, g]
    = (a, b, c, d, e, f, g)
  AsTuple '[a, b, c, d, e, f, g, h]
    = (a, b, c, d, e, f, g, h)
  -- ...

asTuple :: HList xs -> AsTuple xs
asTuple (a :> b :> Nil)
  = (a, b)
asTuple (a :> b :> c :> Nil)
  = (a, b, c)
asTuple (a :> b :> c :> d :> Nil)
  = (a, b, c, d)
asTuple (a :> b :> c :> d :> e :> Nil)
  = (a, b, c, d, e)
asTuple (a :> b :> c :> d :> e :> f :> Nil)
  = (a, b, c, d, e, f)
asTuple (a :> b :> c :> d :> e :> f :> g :> Nil)
  = (a, b, c, d, e, f, g)
asTuple (a :> b :> c :> d :> e :> f :> g :> h :> Nil)
  = (a, b, c, d, e, f, g, h)
  -- ...

class AsList (tup :: *) (xs :: [*]) | tup -> xs, xs -> tup where
  asList :: tup -> HList xs

instance AsList (a, b) '[a, b] where
  asList (a, b)
    = (a :> b :> Nil)

instance AsList (a, b, c) '[a, b, c] where
  asList (a, b, c)
    = (a :> b :> c :> Nil)

instance AsList (a, b, c, d) '[a, b, c, d] where
  asList (a, b, c, d)
    = (a :> b :> c :> d :> Nil)

instance AsList (a, b, c, d, e) '[a, b, c, d, e] where
  asList (a, b, c, d, e)
    = (a :> b :> c :> d :> e :> Nil)

instance AsList (a, b, c, d, e, f) '[a, b, c, d, e, f] where
  asList (a, b, c, d, e, f)
    = (a :> b :> c :> d :> e :> f :> Nil)

instance AsList (a, b, c, d, e, f, g) '[a, b, c, d, e, f, g] where
  asList (a, b, c, d, e, f, g)
    = (a :> b :> c :> d :> e :> f :> g :> Nil)

instance AsList (a, b, c, d, e, f, g, h) '[a, b, c, d, e, f, g, h] where
  asList (a, b, c, d, e, f, g, h)
    = (a :> b :> c :> d :> e :> f :> g :> h :> Nil)

  -- ...

(+++) :: (AsList t1 xs, AsList t2 ys) => t1 -> t2 -> AsTuple (xs ++ ys)
(+++) t1 t2 = asTuple (asList t1 `append` asList t2)

infixr 5 ++

--------------------------------------------------------------------------------
-- * Extensible tuples

myTuple = (1, 2) +++ (3, 4) +++ (5, 6, 7, 8)
-- >>> (1, 2, 3, 4, 5, 6, 7, 8)