{-# LANGUAGE PolyKinds #-}

module Servant.Util.Common.HList where

import Data.Kind (Type)


-- TODO: move to vinyl one day.

-- | Servant package defines their own 'HList', so we also can (to avoid a large dependency).
data HList (f :: k -> Type) (l :: [k]) where
    HNil :: HList f '[]
    HCons :: f a -> HList f as -> HList f (a ': as)
infixr 3 `HCons`

(.*.) :: forall k (f :: k -> Type) (a :: k) (as :: [k]).
         f a -> HList f as -> HList f (a : as)
.*. :: f a -> HList f as -> HList f (a : as)
(.*.) = f a -> HList f as -> HList f (a : as)
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
HCons
infixr 3 .*.


class HListFromTuple a where
    type HListTuple a :: Type
    htuple :: HListTuple a -> a

instance HListFromTuple (HList f '[]) where
    type HListTuple (HList f '[]) = ()
    htuple :: HListTuple (HList f '[]) -> HList f '[]
htuple () = HList f '[]
forall k (f :: k -> *). HList f '[]
HNil

instance HListFromTuple (HList f '[a]) where
    type HListTuple (HList f '[a]) = f a
    htuple :: HListTuple (HList f '[a]) -> HList f '[a]
htuple HListTuple (HList f '[a])
a = f a
HListTuple (HList f '[a])
a f a -> HList f '[] -> HList f '[a]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. HList f '[]
forall k (f :: k -> *). HList f '[]
HNil

instance HListFromTuple (HList f [a, b]) where
    type HListTuple (HList f [a, b]) = (f a, f b)
    htuple :: HListTuple (HList f '[a, b]) -> HList f '[a, b]
htuple (a, b) = f a
a f a -> HList f '[b] -> HList f '[a, b]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f b
b f b -> HList f '[] -> HList f '[b]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. HList f '[]
forall k (f :: k -> *). HList f '[]
HNil

instance HListFromTuple (HList f [a, b, c]) where
    type HListTuple (HList f [a, b, c]) = (f a, f b, f c)
    htuple :: HListTuple (HList f '[a, b, c]) -> HList f '[a, b, c]
htuple (a, b, c) = f a
a f a -> HList f '[b, c] -> HList f '[a, b, c]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f b
b f b -> HList f '[c] -> HList f '[b, c]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f c
c f c -> HList f '[] -> HList f '[c]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. HList f '[]
forall k (f :: k -> *). HList f '[]
HNil

instance HListFromTuple (HList f [a, b, c, d]) where
    type HListTuple (HList f [a, b, c, d]) = (f a, f b, f c, f d)
    htuple :: HListTuple (HList f '[a, b, c, d]) -> HList f '[a, b, c, d]
htuple (a, b, c, d) = f a
a f a -> HList f '[b, c, d] -> HList f '[a, b, c, d]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f b
b f b -> HList f '[c, d] -> HList f '[b, c, d]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f c
c f c -> HList f '[d] -> HList f '[c, d]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f d
d f d -> HList f '[] -> HList f '[d]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. HList f '[]
forall k (f :: k -> *). HList f '[]
HNil

instance HListFromTuple (HList f [a, b, c, d, e]) where
    type HListTuple (HList f [a, b, c, d, e]) = (f a, f b, f c, f d, f e)
    htuple :: HListTuple (HList f '[a, b, c, d, e]) -> HList f '[a, b, c, d, e]
htuple (a, b, c, d, e) = f a
a f a -> HList f '[b, c, d, e] -> HList f '[a, b, c, d, e]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f b
b f b -> HList f '[c, d, e] -> HList f '[b, c, d, e]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f c
c f c -> HList f '[d, e] -> HList f '[c, d, e]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f d
d f d -> HList f '[e] -> HList f '[d, e]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f e
e f e -> HList f '[] -> HList f '[e]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. HList f '[]
forall k (f :: k -> *). HList f '[]
HNil

instance HListFromTuple (HList f [a, b, c, d, e, g]) where
    type HListTuple (HList f [a, b, c, d, e, g]) = (f a, f b, f c, f d, f e, f g)
    htuple :: HListTuple (HList f '[a, b, c, d, e, g])
-> HList f '[a, b, c, d, e, g]
htuple (a, b, c, d, e, g) = f a
a f a -> HList f '[b, c, d, e, g] -> HList f '[a, b, c, d, e, g]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f b
b f b -> HList f '[c, d, e, g] -> HList f '[b, c, d, e, g]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f c
c f c -> HList f '[d, e, g] -> HList f '[c, d, e, g]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f d
d f d -> HList f '[e, g] -> HList f '[d, e, g]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f e
e f e -> HList f '[g] -> HList f '[e, g]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f g
g f g -> HList f '[] -> HList f '[g]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. HList f '[]
forall k (f :: k -> *). HList f '[]
HNil

instance HListFromTuple (HList f [a, b, c, d, e, g, h]) where
    type HListTuple (HList f [a, b, c, d, e, g, h]) =
        (f a, f b, f c, f d, f e, f g, f h)
    htuple :: HListTuple (HList f '[a, b, c, d, e, g, h])
-> HList f '[a, b, c, d, e, g, h]
htuple (a, b, c, d, e, g, h) =
        f a
a f a
-> HList f '[b, c, d, e, g, h] -> HList f '[a, b, c, d, e, g, h]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f b
b f b -> HList f '[c, d, e, g, h] -> HList f '[b, c, d, e, g, h]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f c
c f c -> HList f '[d, e, g, h] -> HList f '[c, d, e, g, h]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f d
d f d -> HList f '[e, g, h] -> HList f '[d, e, g, h]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f e
e f e -> HList f '[g, h] -> HList f '[e, g, h]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f g
g f g -> HList f '[h] -> HList f '[g, h]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f h
h f h -> HList f '[] -> HList f '[h]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. HList f '[]
forall k (f :: k -> *). HList f '[]
HNil

instance HListFromTuple (HList f [a, b, c, d, e, g, h, i]) where
    type HListTuple (HList f [a, b, c, d, e, g, h, i]) =
        (f a, f b, f c, f d, f e, f g, f h, f i)
    htuple :: HListTuple (HList f '[a, b, c, d, e, g, h, i])
-> HList f '[a, b, c, d, e, g, h, i]
htuple (a, b, c, d, e, g, h, i) =
        f a
a f a
-> HList f '[b, c, d, e, g, h, i]
-> HList f '[a, b, c, d, e, g, h, i]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f b
b f b
-> HList f '[c, d, e, g, h, i] -> HList f '[b, c, d, e, g, h, i]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f c
c f c -> HList f '[d, e, g, h, i] -> HList f '[c, d, e, g, h, i]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f d
d f d -> HList f '[e, g, h, i] -> HList f '[d, e, g, h, i]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f e
e f e -> HList f '[g, h, i] -> HList f '[e, g, h, i]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f g
g f g -> HList f '[h, i] -> HList f '[g, h, i]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f h
h f h -> HList f '[i] -> HList f '[h, i]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. f i
i f i -> HList f '[] -> HList f '[i]
forall a (f :: a -> *) (a :: a) (as :: [a]).
f a -> HList f as -> HList f (a : as)
.*. HList f '[]
forall k (f :: k -> *). HList f '[]
HNil