{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE StandaloneDeriving #-}

-- | Heterogeneous list
module Haskus.Utils.HList
   ( HList (..)
   , hHead
   , hTail
   , hLength
   , hAppend
   , HFoldr' (..)
   , HFoldl' (..)
   , HTuple (..)
   , Apply (..)
   , HZipList
   , hZipList
   , HFoldr
   , hFoldr
   , HFoldl
   , hFoldl
   , HReverse (..)
   )
where

import Haskus.Utils.Tuple
import Haskus.Utils.Types
import qualified Data.List as List

-- | Heterogeneous list
data family HList (l :: [Type])
data instance HList '[]       = HNil
data instance HList (x ': xs) = x `HCons` HList xs

infixr 2 `HCons`

deriving instance Eq (HList '[])
deriving instance (Eq x, Eq (HList xs)) => Eq (HList (x ': xs))

deriving instance Ord (HList '[])
deriving instance (Ord x, Ord (HList xs)) => Ord (HList (x ': xs))

class ShowHList a where
  show_hlist :: HList a -> [String]

instance ShowHList '[] where
    show_hlist :: HList '[] -> [String]
show_hlist HList '[]
_ = []

instance (Show e, ShowHList l) => ShowHList (e ': l) where
    show_hlist :: HList (e : l) -> [String]
show_hlist (HCons e
x HList l
l) = e -> String
forall a. Show a => a -> String
show e
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: HList l -> [String]
forall (a :: [*]). ShowHList a => HList a -> [String]
show_hlist HList l
l

instance ShowHList l => Show (HList l) where
    show :: HList l -> String
show HList l
l = String
"H[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
List.intersperse String
"," (HList l -> [String]
forall (a :: [*]). ShowHList a => HList a -> [String]
show_hlist HList l
l)) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"

-- | Head
hHead :: HList (e ': l) -> e
hHead :: forall e (l :: [*]). HList (e : l) -> e
hHead (HCons e
x HList l
_) = e
x

-- | Tail
hTail :: HList (e ': l) -> HList l
hTail :: forall e (l :: [*]). HList (e : l) -> HList l
hTail (HCons e
_ HList l
l) = HList l
l

-- | Length
hLength :: forall xs. (KnownNat (Length xs)) => HList xs -> Word
hLength :: forall (xs :: [*]). KnownNat (Length xs) => HList xs -> Word
hLength HList xs
_ = forall (n :: Nat). KnownNat n => Word
natValue' @(Length xs)

class HAppendList l1 l2 where
  hAppend :: HList l1 -> HList l2 -> HList (Concat l1 l2)

instance HAppendList '[] l2 where
  hAppend :: HList '[] -> HList l2 -> HList (Concat '[] l2)
hAppend HList '[]
R:HList[]
HNil HList l2
l = HList l2
HList (Concat '[] l2)
l

instance HAppendList l l' => HAppendList (x ': l) l' where
  hAppend :: HList (x : l) -> HList l' -> HList (Concat (x : l) l')
hAppend (HCons x
x HList l
l) HList l'
l' = x -> HList (Concat l l') -> HList (x : Concat l l')
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
HCons x
x (HList l -> HList l' -> HList (Concat l l')
forall (l1 :: [*]) (l2 :: [*]).
HAppendList l1 l2 =>
HList l1 -> HList l2 -> HList (Concat l1 l2)
hAppend HList l
l HList l'
l')


-- | Apply the function identified by the data type f from type a to type b.
class Apply f a b where
  apply :: f -> a -> b

--------------------------------------
-- Folding
--------------------------------------

class HFoldr f v (l :: [Type]) r where
    hFoldr :: f -> v -> HList l -> r

instance (v ~ v') => HFoldr f v '[] v' where
    hFoldr :: f -> v -> HList '[] -> v'
hFoldr f
_ v
v HList '[]
_   = v
v'
v

instance
      ( Apply f (e, r) r'
      , HFoldr f v l r
      ) => HFoldr f v (e ': l) r'
   where
      hFoldr :: f -> v -> HList (e : l) -> r'
hFoldr f
f v
v (HCons e
x HList l
l)    = f -> (e, r) -> r'
forall f a b. Apply f a b => f -> a -> b
apply f
f (e
x, f -> v -> HList l -> r
forall f v (l :: [*]) r. HFoldr f v l r => f -> v -> HList l -> r
hFoldr f
f v
v HList l
l :: r)


-- | Like HFoldr but only use types, not values!
--
-- It allows us to foldr over a list of types, without any associated hlist of
-- values.
class HFoldr' f v (l :: [Type]) r where
   hFoldr' :: f -> v -> HList l -> r

instance (v ~ v') => HFoldr' f v '[] v' where
   hFoldr' :: f -> v -> HList '[] -> v'
hFoldr' f
_ v
v HList '[]
_   = v
v'
v

instance
      ( Apply f (e, r) r'
      , HFoldr' f v l r
      ) => HFoldr' f v (e ': l) r'
   where
      -- compared to hFoldr, we pass undefined values instead of the values
      -- supposedly in the list (we don't have a real list associated to HList l)
      hFoldr' :: f -> v -> HList (e : l) -> r'
hFoldr' f
f v
v HList (e : l)
_ = f -> (e, r) -> r'
forall f a b. Apply f a b => f -> a -> b
apply f
f (e
forall a. HasCallStack => a
undefined :: e, f -> v -> HList l -> r
forall f v (l :: [*]) r. HFoldr' f v l r => f -> v -> HList l -> r
hFoldr' f
f v
v (HList l
forall a. HasCallStack => a
undefined :: HList l) :: r)

class HFoldl f (z :: Type) xs (r :: Type) where
    hFoldl :: f -> z -> HList xs -> r

instance forall f z z' r x zx xs.
      ( zx ~ (z,x)
      , Apply f zx z'
      , HFoldl f z' xs r
      ) => HFoldl f z (x ': xs) r
   where
      hFoldl :: f -> z -> HList (x : xs) -> r
hFoldl f
f z
z (x
x `HCons` HList xs
xs) = f -> z' -> HList xs -> r
forall f z (xs :: [*]) r.
HFoldl f z xs r =>
f -> z -> HList xs -> r
hFoldl f
f (f -> (z, x) -> z'
forall f a b. Apply f a b => f -> a -> b
apply f
f (z
z,x
x) :: z') HList xs
xs

instance (z ~ z') => HFoldl f z '[] z' where
    hFoldl :: f -> z -> HList '[] -> z'
hFoldl f
_ z
z HList '[]
_ = z
z'
z

-- | Like HFoldl but only use types, not values!
--
-- It allows us to foldl over a list of types, without any associated hlist of
-- values.
class HFoldl' f (z :: Type) xs (r :: Type) where
    hFoldl' :: f -> z -> HList xs -> r

instance forall f z z' r x zx xs.
      ( zx ~ (z,x)
      , Apply f zx z'
      , HFoldl' f z' xs r
      ) => HFoldl' f z (x ': xs) r
   where
      hFoldl' :: f -> z -> HList (x : xs) -> r
hFoldl' f
f z
z (x
_ `HCons` HList xs
xs) = f -> z' -> HList xs -> r
forall f z (xs :: [*]) r.
HFoldl' f z xs r =>
f -> z -> HList xs -> r
hFoldl' f
f (f -> (z, x) -> z'
forall f a b. Apply f a b => f -> a -> b
apply f
f (z
z,(x
forall a. HasCallStack => a
undefined :: x)) :: z') HList xs
xs

instance (z ~ z') => HFoldl' f z '[] z' where
   hFoldl' :: f -> z -> HList '[] -> z'
hFoldl' f
_ z
z HList '[]
_ = z
z'
z



class HZipList x y l | x y -> l, l -> x y where
   hZipList   :: HList x -> HList y -> HList l
   hUnzipList :: HList l -> (HList x, HList y)

instance HZipList '[] '[] '[] where
   hZipList :: HList '[] -> HList '[] -> HList '[]
hZipList HList '[]
_ HList '[]
_ = HList '[]
HNil
   hUnzipList :: HList '[] -> (HList '[], HList '[])
hUnzipList HList '[]
_ = (HList '[]
HNil, HList '[]
HNil)

instance ((x,y)~z, HZipList xs ys zs) => HZipList (x ': xs) (y ': ys) (z ': zs) where
   hZipList :: HList (x : xs) -> HList (y : ys) -> HList (z : zs)
hZipList (HCons x
x HList xs
xs) (HCons y
y HList ys
ys) = (x
x,y
y) z -> HList zs -> HList (z : zs)
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList xs -> HList ys -> HList zs
forall (x :: [*]) (y :: [*]) (l :: [*]).
HZipList x y l =>
HList x -> HList y -> HList l
hZipList HList xs
xs HList ys
ys
   hUnzipList :: HList (z : zs) -> (HList (x : xs), HList (y : ys))
hUnzipList (HCons ~(x
x,y
y) HList zs
zs) = let ~(HList xs
xs,HList ys
ys) = HList zs -> (HList xs, HList ys)
forall (x :: [*]) (y :: [*]) (l :: [*]).
HZipList x y l =>
HList l -> (HList x, HList y)
hUnzipList HList zs
zs in (x
x x -> HList xs -> HList (x : xs)
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList xs
xs, y
y y -> HList ys -> HList (y : ys)
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList ys
ys)


class HRevApp l1 l2 l3 | l1 l2 -> l3 where
   hRevApp :: HList l1 -> HList l2 -> HList l3

instance HRevApp '[] l2 l2 where
   hRevApp :: HList '[] -> HList l2 -> HList l2
hRevApp HList '[]
_ HList l2
l = HList l2
l

instance HRevApp l (x ': l') z => HRevApp (x ': l) l' z where
   hRevApp :: HList (x : l) -> HList l' -> HList z
hRevApp (HCons x
x HList l
l) HList l'
l' = HList l -> HList (x : l') -> HList z
forall (l1 :: [*]) (l2 :: [*]) (l3 :: [*]).
HRevApp l1 l2 l3 =>
HList l1 -> HList l2 -> HList l3
hRevApp HList l
l (x -> HList l' -> HList (x : l')
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
HCons x
x HList l'
l')



class HReverse xs sx | xs -> sx, sx -> xs where
   hReverse :: HList xs -> HList sx

instance
      ( HRevApp xs '[] sx
      , HRevApp sx '[] xs
      ) => HReverse xs sx
   where
      hReverse :: HList xs -> HList sx
hReverse HList xs
l = HList xs -> HList '[] -> HList sx
forall (l1 :: [*]) (l2 :: [*]) (l3 :: [*]).
HRevApp l1 l2 l3 =>
HList l1 -> HList l2 -> HList l3
hRevApp HList xs
l HList '[]
HNil


--------------------------------------
-- Tuple convertion
--------------------------------------

-- * Conversion to and from tuples

-- | Convert between hlists and tuples
class HTuple v where
   -- | Convert an heterogeneous list into a tuple
   hToTuple   :: HList v -> Tuple v
   
   -- | Convert a tuple into an heterogeneous list
   hFromTuple :: Tuple v -> HList v


instance HTuple '[] where
   hToTuple :: HList '[] -> Tuple '[]
hToTuple HList '[]
R:HList[]
HNil = ()
   hFromTuple :: Tuple '[] -> HList '[]
hFromTuple () = HList '[]
HNil

instance HTuple '[a] where
   hToTuple :: HList '[a] -> Tuple '[a]
hToTuple (a
a `HCons` HList '[]
R:HList[]
HNil)
      = a -> Solo a
forall a. a -> Solo a
MkSolo a
a
   hFromTuple :: Tuple '[a] -> HList '[a]
hFromTuple (MkSolo a
a)
      = a
a a -> HList '[] -> HList '[a]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList '[]
HNil

instance HTuple '[a,b] where
   hToTuple :: HList '[a, b] -> Tuple '[a, b]
hToTuple (a
a `HCons` b
b `HCons` HList '[]
R:HList[]
HNil)
      = (a
a,b
b)
   hFromTuple :: Tuple '[a, b] -> HList '[a, b]
hFromTuple (a
a,b
b)
      = a
a a -> HList '[b] -> HList '[a, b]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` b
b b -> HList '[] -> HList '[b]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList '[]
HNil

instance HTuple '[a,b,c] where
   hToTuple :: HList '[a, b, c] -> Tuple '[a, b, c]
hToTuple (a
a `HCons` b
b `HCons` c
c `HCons` HList '[]
R:HList[]
HNil)
      = (a
a,b
b,c
c)
   hFromTuple :: Tuple '[a, b, c] -> HList '[a, b, c]
hFromTuple (a
a,b
b,c
c)
      = a
a a -> HList '[b, c] -> HList '[a, b, c]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` b
b b -> HList '[c] -> HList '[b, c]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` c
c c -> HList '[] -> HList '[c]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList '[]
HNil

instance HTuple '[a,b,c,d] where
   hToTuple :: HList '[a, b, c, d] -> Tuple '[a, b, c, d]
hToTuple (a
a `HCons` b
b `HCons` c
c `HCons` d
d `HCons` HList '[]
R:HList[]
HNil)
      = (a
a,b
b,c
c,d
d)
   hFromTuple :: Tuple '[a, b, c, d] -> HList '[a, b, c, d]
hFromTuple (a
a,b
b,c
c,d
d)
      = a
a a -> HList '[b, c, d] -> HList '[a, b, c, d]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` b
b b -> HList '[c, d] -> HList '[b, c, d]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` c
c c -> HList '[d] -> HList '[c, d]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` d
d d -> HList '[] -> HList '[d]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList '[]
HNil

instance HTuple '[a,b,c,d,e] where
   hToTuple :: HList '[a, b, c, d, e] -> Tuple '[a, b, c, d, e]
hToTuple (a
a `HCons` b
b `HCons` c
c `HCons` d
d `HCons` e
e `HCons` HList '[]
R:HList[]
HNil)
      = (a
a,b
b,c
c,d
d,e
e)
   hFromTuple :: Tuple '[a, b, c, d, e] -> HList '[a, b, c, d, e]
hFromTuple (a
a,b
b,c
c,d
d,e
e)
      = a
a a -> HList '[b, c, d, e] -> HList '[a, b, c, d, e]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` b
b b -> HList '[c, d, e] -> HList '[b, c, d, e]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` c
c c -> HList '[d, e] -> HList '[c, d, e]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` d
d d -> HList '[e] -> HList '[d, e]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` e
e e -> HList '[] -> HList '[e]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList '[]
HNil

instance HTuple '[a,b,c,d,e,f] where
   hToTuple :: HList '[a, b, c, d, e, f] -> Tuple '[a, b, c, d, e, f]
hToTuple (a
a `HCons` b
b `HCons` c
c `HCons` d
d `HCons` e
e `HCons` f
f `HCons` HList '[]
R:HList[]
HNil)
      = (a
a,b
b,c
c,d
d,e
e,f
f)
   hFromTuple :: Tuple '[a, b, c, d, e, f] -> HList '[a, b, c, d, e, f]
hFromTuple (a
a,b
b,c
c,d
d,e
e,f
f)
      = a
a a -> HList '[b, c, d, e, f] -> HList '[a, b, c, d, e, f]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` b
b b -> HList '[c, d, e, f] -> HList '[b, c, d, e, f]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` c
c c -> HList '[d, e, f] -> HList '[c, d, e, f]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` d
d d -> HList '[e, f] -> HList '[d, e, f]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` e
e e -> HList '[f] -> HList '[e, f]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` f
f f -> HList '[] -> HList '[f]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList '[]
HNil

instance HTuple '[a,b,c,d,e,f,g] where
   hToTuple :: HList '[a, b, c, d, e, f, g] -> Tuple '[a, b, c, d, e, f, g]
hToTuple (a
a `HCons` b
b `HCons` c
c `HCons` d
d `HCons` e
e `HCons` f
f `HCons` g
g `HCons` HList '[]
R:HList[]
HNil)
      = (a
a,b
b,c
c,d
d,e
e,f
f,g
g)
   hFromTuple :: Tuple '[a, b, c, d, e, f, g] -> HList '[a, b, c, d, e, f, g]
hFromTuple (a
a,b
b,c
c,d
d,e
e,f
f,g
g)
      = a
a a -> HList '[b, c, d, e, f, g] -> HList '[a, b, c, d, e, f, g]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` b
b b -> HList '[c, d, e, f, g] -> HList '[b, c, d, e, f, g]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` c
c c -> HList '[d, e, f, g] -> HList '[c, d, e, f, g]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` d
d d -> HList '[e, f, g] -> HList '[d, e, f, g]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` e
e e -> HList '[f, g] -> HList '[e, f, g]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` f
f f -> HList '[g] -> HList '[f, g]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` g
g g -> HList '[] -> HList '[g]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList '[]
HNil

instance HTuple '[a,b,c,d,e,f,g,h] where
   hToTuple :: HList '[a, b, c, d, e, f, g, h] -> Tuple '[a, b, c, d, e, f, g, h]
hToTuple (a
a `HCons` b
b `HCons` c
c `HCons` d
d `HCons` e
e `HCons` f
f `HCons` g
g `HCons` h
h `HCons` HList '[]
R:HList[]
HNil)
      = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h)
   hFromTuple :: Tuple '[a, b, c, d, e, f, g, h] -> HList '[a, b, c, d, e, f, g, h]
hFromTuple (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h)
      = a
a a
-> HList '[b, c, d, e, f, g, h] -> HList '[a, b, c, d, e, f, g, h]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` b
b b -> HList '[c, d, e, f, g, h] -> HList '[b, c, d, e, f, g, h]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` c
c c -> HList '[d, e, f, g, h] -> HList '[c, d, e, f, g, h]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` d
d d -> HList '[e, f, g, h] -> HList '[d, e, f, g, h]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` e
e e -> HList '[f, g, h] -> HList '[e, f, g, h]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` f
f f -> HList '[g, h] -> HList '[f, g, h]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` g
g g -> HList '[h] -> HList '[g, h]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` h
h h -> HList '[] -> HList '[h]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList '[]
HNil

instance HTuple '[a,b,c,d,e,f,g,h,i] where
   hToTuple :: HList '[a, b, c, d, e, f, g, h, i]
-> Tuple '[a, b, c, d, e, f, g, h, i]
hToTuple (a
a `HCons` b
b `HCons` c
c `HCons` d
d `HCons` e
e `HCons` f
f `HCons` g
g `HCons` h
h `HCons` i
i `HCons` HList '[]
R:HList[]
HNil)
      = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i)
   hFromTuple :: Tuple '[a, b, c, d, e, f, g, h, i]
-> HList '[a, b, c, d, e, f, g, h, i]
hFromTuple (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i)
      = a
a a
-> HList '[b, c, d, e, f, g, h, i]
-> HList '[a, b, c, d, e, f, g, h, i]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` b
b b
-> HList '[c, d, e, f, g, h, i] -> HList '[b, c, d, e, f, g, h, i]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` c
c c -> HList '[d, e, f, g, h, i] -> HList '[c, d, e, f, g, h, i]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` d
d d -> HList '[e, f, g, h, i] -> HList '[d, e, f, g, h, i]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` e
e e -> HList '[f, g, h, i] -> HList '[e, f, g, h, i]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` f
f f -> HList '[g, h, i] -> HList '[f, g, h, i]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` g
g g -> HList '[h, i] -> HList '[g, h, i]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` h
h h -> HList '[i] -> HList '[h, i]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` i
i i -> HList '[] -> HList '[i]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList '[]
HNil

instance HTuple '[a,b,c,d,e,f,g,h,i,j] where
   hToTuple :: HList '[a, b, c, d, e, f, g, h, i, j]
-> Tuple '[a, b, c, d, e, f, g, h, i, j]
hToTuple (a
a `HCons` b
b `HCons` c
c `HCons` d
d `HCons` e
e `HCons` f
f `HCons` g
g `HCons` h
h `HCons` i
i `HCons` j
j `HCons` HList '[]
R:HList[]
HNil)
      = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j)
   hFromTuple :: Tuple '[a, b, c, d, e, f, g, h, i, j]
-> HList '[a, b, c, d, e, f, g, h, i, j]
hFromTuple (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j)
      = a
a a
-> HList '[b, c, d, e, f, g, h, i, j]
-> HList '[a, b, c, d, e, f, g, h, i, j]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` b
b b
-> HList '[c, d, e, f, g, h, i, j]
-> HList '[b, c, d, e, f, g, h, i, j]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` c
c c
-> HList '[d, e, f, g, h, i, j] -> HList '[c, d, e, f, g, h, i, j]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` d
d d -> HList '[e, f, g, h, i, j] -> HList '[d, e, f, g, h, i, j]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` e
e e -> HList '[f, g, h, i, j] -> HList '[e, f, g, h, i, j]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` f
f f -> HList '[g, h, i, j] -> HList '[f, g, h, i, j]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` g
g g -> HList '[h, i, j] -> HList '[g, h, i, j]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` h
h h -> HList '[i, j] -> HList '[h, i, j]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` i
i i -> HList '[j] -> HList '[i, j]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` j
j j -> HList '[] -> HList '[j]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList '[]
HNil

instance HTuple '[a,b,c,d,e,f,g,h,i,j,k] where
   hToTuple :: HList '[a, b, c, d, e, f, g, h, i, j, k]
-> Tuple '[a, b, c, d, e, f, g, h, i, j, k]
hToTuple (a
a `HCons` b
b `HCons` c
c `HCons` d
d `HCons` e
e `HCons` f
f `HCons` g
g `HCons` h
h `HCons` i
i `HCons` j
j `HCons` k
k `HCons` HList '[]
R:HList[]
HNil)
      = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k)
   hFromTuple :: Tuple '[a, b, c, d, e, f, g, h, i, j, k]
-> HList '[a, b, c, d, e, f, g, h, i, j, k]
hFromTuple (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k)
      = a
a a
-> HList '[b, c, d, e, f, g, h, i, j, k]
-> HList '[a, b, c, d, e, f, g, h, i, j, k]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` b
b b
-> HList '[c, d, e, f, g, h, i, j, k]
-> HList '[b, c, d, e, f, g, h, i, j, k]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` c
c c
-> HList '[d, e, f, g, h, i, j, k]
-> HList '[c, d, e, f, g, h, i, j, k]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` d
d d
-> HList '[e, f, g, h, i, j, k] -> HList '[d, e, f, g, h, i, j, k]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` e
e e -> HList '[f, g, h, i, j, k] -> HList '[e, f, g, h, i, j, k]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` f
f f -> HList '[g, h, i, j, k] -> HList '[f, g, h, i, j, k]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` g
g g -> HList '[h, i, j, k] -> HList '[g, h, i, j, k]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` h
h h -> HList '[i, j, k] -> HList '[h, i, j, k]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` i
i i -> HList '[j, k] -> HList '[i, j, k]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` j
j j -> HList '[k] -> HList '[j, k]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` k
k k -> HList '[] -> HList '[k]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList '[]
HNil

instance HTuple '[a,b,c,d,e,f,g,h,i,j,k,l] where
   hToTuple :: HList '[a, b, c, d, e, f, g, h, i, j, k, l]
-> Tuple '[a, b, c, d, e, f, g, h, i, j, k, l]
hToTuple (a
a `HCons` b
b `HCons` c
c `HCons` d
d `HCons` e
e `HCons` f
f `HCons` g
g `HCons` h
h `HCons` i
i `HCons` j
j `HCons` k
k `HCons` l
l `HCons` HList '[]
R:HList[]
HNil)
      = (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l)
   hFromTuple :: Tuple '[a, b, c, d, e, f, g, h, i, j, k, l]
-> HList '[a, b, c, d, e, f, g, h, i, j, k, l]
hFromTuple (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l)
      = a
a a
-> HList '[b, c, d, e, f, g, h, i, j, k, l]
-> HList '[a, b, c, d, e, f, g, h, i, j, k, l]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` b
b b
-> HList '[c, d, e, f, g, h, i, j, k, l]
-> HList '[b, c, d, e, f, g, h, i, j, k, l]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` c
c c
-> HList '[d, e, f, g, h, i, j, k, l]
-> HList '[c, d, e, f, g, h, i, j, k, l]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` d
d d
-> HList '[e, f, g, h, i, j, k, l]
-> HList '[d, e, f, g, h, i, j, k, l]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` e
e e
-> HList '[f, g, h, i, j, k, l] -> HList '[e, f, g, h, i, j, k, l]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` f
f f -> HList '[g, h, i, j, k, l] -> HList '[f, g, h, i, j, k, l]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` g
g g -> HList '[h, i, j, k, l] -> HList '[g, h, i, j, k, l]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` h
h h -> HList '[i, j, k, l] -> HList '[h, i, j, k, l]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` i
i i -> HList '[j, k, l] -> HList '[i, j, k, l]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` j
j j -> HList '[k, l] -> HList '[j, k, l]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` k
k k -> HList '[l] -> HList '[k, l]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` l
l l -> HList '[] -> HList '[l]
forall x (xs :: [*]). x -> HList xs -> HList (x : xs)
`HCons` HList '[]
HNil