{-# LANGUAGE ConstraintKinds         #-}
{-# LANGUAGE DataKinds               #-}
{-# LANGUAGE DefaultSignatures       #-}
{-# LANGUAGE FlexibleContexts        #-}
{-# LANGUAGE FlexibleInstances       #-}
{-# LANGUAGE KindSignatures          #-}
{-# LANGUAGE MagicHash               #-}
{-# LANGUAGE MultiParamTypeClasses   #-}
{-# LANGUAGE PolyKinds               #-}
{-# LANGUAGE RankNTypes              #-}
{-# LANGUAGE ScopedTypeVariables     #-}
{-# LANGUAGE TypeApplications        #-}
{-# LANGUAGE TypeFamilies            #-}
{-# LANGUAGE TypeOperators           #-}
{-# LANGUAGE UndecidableInstances    #-}
{-# LANGUAGE UndecidableSuperClasses #-}
module Data.Vector.HFixed.Class (
    -- * Types and type classes
    -- ** N-ary functions
    Fn
  , Fun
  , TFun(..)
    -- ** Type functions
  , Proxy(..)
  , type (++)
  , Len
  , HomList
    -- ** Type classes
  , Arity(..)
  , ArityC(..)
  , (:&&:)
  , HVector(..)
  , tupleSize
  , HVectorF(..)
  , tupleSizeF
    -- *** Lookup in vector
  , Index(..)
  , TyLookup(..)
    -- ** CPS-encoded vector
  , ContVec
  , ContVecF(..)
  , cons
  , consF
    -- ** Interop with homogeneous vectors
  , HomArity(..)
  , homInspect
  , homConstruct
    -- * Operations of Fun
    -- ** Primitives for Fun
  , curryFun
  , uncurryFun
  , uncurryMany
  , curryMany
  , constFun
    -- ** Primitives for TFun
  , constTFun
  , curryTFun
  , uncurryTFun
  , shuffleTF
  , stepTFun
    -- ** More complicated functions
  , concatF
  , lensWorkerF
  , lensWorkerTF
    -- * Lens
  , Lens
  , Lens'
  ) where

import Data.Coerce
import Data.Complex          (Complex(..))
import Data.Functor.Identity (Identity(..))
import Data.Type.Equality    (type (==))

import           Data.Vector.Fixed.Cont   (Peano,PeanoNum(..),ArityPeano)
import qualified Data.Vector.Fixed                as F
import qualified Data.Vector.Fixed.Cont           as F (curryFirst)
import qualified Data.Vector.Fixed.Unboxed        as U
import qualified Data.Vector.Fixed.Primitive      as P
import qualified Data.Vector.Fixed.Storable       as S
import qualified Data.Vector.Fixed.Boxed          as B

import Unsafe.Coerce (unsafeCoerce)
import GHC.Exts (Proxy#,proxy#)
import GHC.TypeLits
import GHC.Generics hiding (S)

import Data.Vector.HFixed.TypeFuns



----------------------------------------------------------------
-- Types
----------------------------------------------------------------

-- | Type family for N-ary function. Types of function parameters are
--   encoded as the list of types.
type family Fn (f :: α -> *) (as :: [α]) b where
  Fn f '[]      b = b
  Fn f (a : as) b = f a -> Fn f as b

-- | Newtype wrapper for function where all type parameters have same
--   type constructor. This type is required for writing function
--   which works with monads, appicatives etc.
newtype TFun f as b = TFun { TFun f as b -> Fn f as b
unTFun :: Fn f as b }

-- | Newtype wrapper to work around of type families' lack of
--   injectivity.
type Fun = TFun Identity



----------------------------------------------------------------
-- Generic operations
----------------------------------------------------------------

-- | Type class for combining two constraint constructors. Those are
--   required for 'ArityC' type class.
class (c1 a, c2 a) => (:&&:) c1 c2 a

instance (c1 a, c2 a) => (:&&:) c1 c2 a

-- | Type class for dealing with N-ary function in generic way. Both
--   'accum' and 'apply' work with accumulator data types which are
--   polymorphic. So it's only possible to write functions which
--   rearrange elements in vector using plain ADT. It's possible to
--   get around it by using GADT as accumulator (See 'ArityC' and
--   function which use it)
--
--   This is also somewhat a kitchen sink module. It contains
--   witnesses which could be used to prove type equalities or to
--   bring instance in scope.
class Arity (xs :: [α]) where
  -- | Fold over /N/ elements exposed as N-ary function.
  accum :: (forall a as. t (a : as) -> f a -> t as)
        -- ^ Step function. Applies element to accumulator.
        -> (t '[] -> b)
        -- ^ Extract value from accumulator.
        -> t xs
        -- ^ Initial state.
        -> TFun f xs b

  -- | Apply values to N-ary function
  apply :: (forall a as. t (a : as) -> (f a, t as))
        -- ^ Extract value to be applied to function.
        -> t xs
        -- ^ Initial state.
        -> ContVecF xs f

  -- | Size of type list as integer.
  arity :: p xs -> Int


class (Arity xs) => ArityC c xs where
  accumC :: proxy c
         -- ^
         -> (forall a as. (c a) => t (a : as) -> f a -> t as)
         -- ^ Step function. Applies element to accumulator.
         -> (t '[] -> b)
         -- ^ Extract value from accumulator.
         -> t xs
         -- ^ Initial state.
         -> TFun f xs b

  -- | Apply values to N-ary function
  applyC :: proxy c
         --
         -> (forall a as. (c a) => t (a : as) -> (f a, t as))
         -- ^ Extract value to be applied to function.
         -> t xs
         -- ^ Initial state.
         -> ContVecF xs f


instance Arity '[] where
  accum :: (forall (a :: α) (as :: [α]). t (a : as) -> f a -> t as)
-> (t '[] -> b) -> t '[] -> TFun f '[] b
accum forall (a :: α) (as :: [α]). t (a : as) -> f a -> t as
_ t '[] -> b
f t '[]
t = Fn f '[] b -> TFun f '[] b
forall α (f :: α -> *) (as :: [α]) b. Fn f as b -> TFun f as b
TFun (t '[] -> b
f t '[]
t)
  apply :: (forall (a :: α) (as :: [α]). t (a : as) -> (f a, t as))
-> t '[] -> ContVecF '[] f
apply forall (a :: α) (as :: [α]). t (a : as) -> (f a, t as)
_ t '[]
_   = (forall r. TFun f '[] r -> r) -> ContVecF '[] f
forall α (xs :: [α]) (f :: α -> *).
(forall r. TFun f xs r -> r) -> ContVecF xs f
ContVecF forall r. TFun f '[] r -> r
forall α (f :: α -> *) (as :: [α]) b. TFun f as b -> Fn f as b
unTFun
  {-# INLINE accum #-}
  {-# INLINE apply #-}
  arity :: p '[] -> Int
arity p '[]
_     = Int
0
  {-# INLINE arity #-}

instance Arity xs => Arity (x : xs) where
  accum :: (forall (a :: α) (as :: [α]). t (a : as) -> f a -> t as)
-> (t '[] -> b) -> t (x : xs) -> TFun f (x : xs) b
accum forall (a :: α) (as :: [α]). t (a : as) -> f a -> t as
f t '[] -> b
g t (x : xs)
t = (f x -> TFun f xs b) -> TFun f (x : xs) b
forall a (f :: a -> *) (x :: a) (xs :: [a]) r.
(f x -> TFun f xs r) -> TFun f (x : xs) r
uncurryTFun (\f x
a -> (forall (a :: α) (as :: [α]). t (a : as) -> f a -> t as)
-> (t '[] -> b) -> t xs -> TFun f xs b
forall α (xs :: [α]) (t :: [α] -> *) (f :: α -> *) b.
Arity xs =>
(forall (a :: α) (as :: [α]). t (a : as) -> f a -> t as)
-> (t '[] -> b) -> t xs -> TFun f xs b
accum forall (a :: α) (as :: [α]). t (a : as) -> f a -> t as
f t '[] -> b
g (t (x : xs) -> f x -> t xs
forall (a :: α) (as :: [α]). t (a : as) -> f a -> t as
f t (x : xs)
t f x
a))
  apply :: (forall (a :: α) (as :: [α]). t (a : as) -> (f a, t as))
-> t (x : xs) -> ContVecF (x : xs) f
apply forall (a :: α) (as :: [α]). t (a : as) -> (f a, t as)
f t (x : xs)
t   = case t (x : xs) -> (f x, t xs)
forall (a :: α) (as :: [α]). t (a : as) -> (f a, t as)
f t (x : xs)
t of (f x
a,t xs
u) -> f x -> ContVecF xs f -> ContVecF (x : xs) f
forall α (f :: α -> *) (x :: α) (xs :: [α]).
f x -> ContVecF xs f -> ContVecF (x : xs) f
consF f x
a ((forall (a :: α) (as :: [α]). t (a : as) -> (f a, t as))
-> t xs -> ContVecF xs f
forall α (xs :: [α]) (t :: [α] -> *) (f :: α -> *).
Arity xs =>
(forall (a :: α) (as :: [α]). t (a : as) -> (f a, t as))
-> t xs -> ContVecF xs f
apply forall (a :: α) (as :: [α]). t (a : as) -> (f a, t as)
f t xs
u)
  {-# INLINE accum #-}
  {-# INLINE apply #-}
  arity :: p (x : xs) -> Int
arity p (x : xs)
_     = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Proxy xs -> Int
forall α (xs :: [α]) (p :: [α] -> *). Arity xs => p xs -> Int
arity (Proxy xs
forall k (t :: k). Proxy t
Proxy :: Proxy xs)
  {-# INLINE arity        #-}

instance ArityC c '[] where
  accumC :: proxy c
-> (forall (a :: α) (as :: [α]). c a => t (a : as) -> f a -> t as)
-> (t '[] -> b)
-> t '[]
-> TFun f '[] b
accumC proxy c
_ forall (a :: α) (as :: [α]). c a => t (a : as) -> f a -> t as
_ t '[] -> b
f t '[]
t = Fn f '[] b -> TFun f '[] b
forall α (f :: α -> *) (as :: [α]) b. Fn f as b -> TFun f as b
TFun (t '[] -> b
f t '[]
t)
  applyC :: proxy c
-> (forall (a :: α) (as :: [α]). c a => t (a : as) -> (f a, t as))
-> t '[]
-> ContVecF '[] f
applyC proxy c
_ forall (a :: α) (as :: [α]). c a => t (a : as) -> (f a, t as)
_ t '[]
_   = (forall r. TFun f '[] r -> r) -> ContVecF '[] f
forall α (xs :: [α]) (f :: α -> *).
(forall r. TFun f xs r -> r) -> ContVecF xs f
ContVecF forall r. TFun f '[] r -> r
forall α (f :: α -> *) (as :: [α]) b. TFun f as b -> Fn f as b
unTFun
  {-# INLINE accumC #-}
  {-# INLINE applyC #-}

instance (c x, ArityC c xs) => ArityC c (x : xs) where
  accumC :: proxy c
-> (forall (a :: a) (as :: [a]). c a => t (a : as) -> f a -> t as)
-> (t '[] -> b)
-> t (x : xs)
-> TFun f (x : xs) b
accumC proxy c
w forall (a :: a) (as :: [a]). c a => t (a : as) -> f a -> t as
f t '[] -> b
g t (x : xs)
t = (f x -> TFun f xs b) -> TFun f (x : xs) b
forall a (f :: a -> *) (x :: a) (xs :: [a]) r.
(f x -> TFun f xs r) -> TFun f (x : xs) r
uncurryTFun (\f x
a -> proxy c
-> (forall (a :: a) (as :: [a]). c a => t (a : as) -> f a -> t as)
-> (t '[] -> b)
-> t xs
-> TFun f xs b
forall α (c :: α -> Constraint) (xs :: [α])
       (proxy :: (α -> Constraint) -> *) (t :: [α] -> *) (f :: α -> *) b.
ArityC c xs =>
proxy c
-> (forall (a :: α) (as :: [α]). c a => t (a : as) -> f a -> t as)
-> (t '[] -> b)
-> t xs
-> TFun f xs b
accumC proxy c
w forall (a :: a) (as :: [a]). c a => t (a : as) -> f a -> t as
f t '[] -> b
g (t (x : xs) -> f x -> t xs
forall (a :: a) (as :: [a]). c a => t (a : as) -> f a -> t as
f t (x : xs)
t f x
a))
  applyC :: proxy c
-> (forall (a :: a) (as :: [a]). c a => t (a : as) -> (f a, t as))
-> t (x : xs)
-> ContVecF (x : xs) f
applyC proxy c
w forall (a :: a) (as :: [a]). c a => t (a : as) -> (f a, t as)
f t (x : xs)
t   = case t (x : xs) -> (f x, t xs)
forall (a :: a) (as :: [a]). c a => t (a : as) -> (f a, t as)
f t (x : xs)
t of (f x
a,t xs
u) -> f x -> ContVecF xs f -> ContVecF (x : xs) f
forall α (f :: α -> *) (x :: α) (xs :: [α]).
f x -> ContVecF xs f -> ContVecF (x : xs) f
consF f x
a (proxy c
-> (forall (a :: a) (as :: [a]). c a => t (a : as) -> (f a, t as))
-> t xs
-> ContVecF xs f
forall α (c :: α -> Constraint) (xs :: [α])
       (proxy :: (α -> Constraint) -> *) (t :: [α] -> *) (f :: α -> *).
ArityC c xs =>
proxy c
-> (forall (a :: α) (as :: [α]). c a => t (a : as) -> (f a, t as))
-> t xs
-> ContVecF xs f
applyC proxy c
w forall (a :: a) (as :: [a]). c a => t (a : as) -> (f a, t as)
f t xs
u)
  {-# INLINE accumC #-}
  {-# INLINE applyC #-}



-- |
-- Type class for product type. Any product type could have instance
-- of this type.  Its methods describe how to construct and
-- deconstruct data type. For example instance for simple data type
-- with two fields could be written as:
--
-- > data A a = A Int a
-- >
-- > instance HVector (A a) where
-- >   type Elems (A a) = '[Int,a]
-- >   construct = TFun $ \i a -> A i a
-- >   inspect (A i a) (TFun f) = f i a
--
-- Another equivalent description of this type class is descibes
-- isomorphism between data type and
-- 'Data.Vector.HFixed.Cont.ContVec', where @constuct@ implements
-- @ContVec → a@ (see 'Data.Vector.HFixed.Cont.vector') and @inspect@
-- implements @a → ContVec@ (see 'Data.Vector.HFixed.Cont.cvec')
--
-- Istances should satisfy one law:
--
-- > inspect v construct = v
--
-- Default implementation which uses 'Generic' is provided.
class Arity (Elems v) => HVector v where
  type Elems v :: [*]
  type Elems v = GElems (Rep v)
  -- | Function for constructing vector
  construct :: Fun (Elems v) v
  default construct :: (Generic v, GHVector (Rep v), GElems (Rep v) ~ Elems v)
                    => Fun (Elems v) v
  construct = (Rep v Any -> v)
-> TFun Identity (Elems v) (Rep v Any) -> Fun (Elems v) v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rep v Any -> v
forall a x. Generic a => Rep a x -> a
to TFun Identity (Elems v) (Rep v Any)
forall (v :: * -> *) p. GHVector v => Fun (GElems v) (v p)
gconstruct
  -- | Function for deconstruction of vector. It applies vector's
  --   elements to N-ary function.
  inspect :: v -> Fun (Elems v) a -> a
  default inspect :: (Generic v, GHVector (Rep v), GElems (Rep v) ~ Elems v)
                  => v -> Fun (Elems v) a -> a
  inspect v
v = Rep v Any -> Fun (GElems (Rep v)) a -> a
forall (v :: * -> *) p r.
GHVector v =>
v p -> Fun (GElems v) r -> r
ginspect (v -> Rep v Any
forall a x. Generic a => a -> Rep a x
from v
v)
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

-- | Number of elements in product type
tupleSize :: forall v proxy. HVector v => proxy v -> Int
tupleSize :: proxy v -> Int
tupleSize proxy v
_ = Proxy (Elems v) -> Int
forall α (xs :: [α]) (p :: [α] -> *). Arity xs => p xs -> Int
arity (Proxy (Elems v)
forall k (t :: k). Proxy t
Proxy :: Proxy (Elems v))

-- | Type class for partially homogeneous vector where every element
--   in the vector have same type constructor. Vector itself is
--   parametrized by that constructor
class Arity (ElemsF v) => HVectorF (v :: (α -> *) -> *) where
  -- | Elements of the vector without type constructors
  type ElemsF v :: [α]
  inspectF   :: v f -> TFun f (ElemsF v) a -> a
  constructF :: TFun f (ElemsF v) (v f)

-- | Number of elements in parametrized product type
tupleSizeF :: forall v f proxy. HVectorF v => proxy (v f) -> Int
tupleSizeF :: proxy (v f) -> Int
tupleSizeF proxy (v f)
_a = Proxy (ElemsF v) -> Int
forall α (xs :: [α]) (p :: [α] -> *). Arity xs => p xs -> Int
arity (Proxy (ElemsF v)
forall k (t :: k). Proxy t
Proxy :: Proxy (ElemsF v))


----------------------------------------------------------------
-- Interop with homogeneous vectors
----------------------------------------------------------------

-- | Conversion between homogeneous and heterogeneous N-ary functions.
class (ArityPeano n, Arity (HomList n a)) => HomArity n a where
  -- | Convert n-ary homogeneous function to heterogeneous.
  toHeterogeneous :: F.Fun n a r -> Fun (HomList n a) r
  -- | Convert heterogeneous n-ary function to homogeneous.
  toHomogeneous   :: Fun (HomList n a) r -> F.Fun n a r


instance HomArity 'Z a where
  toHeterogeneous :: Fun 'Z a r -> Fun (HomList 'Z a) r
toHeterogeneous = Fun 'Z a r -> Fun (HomList 'Z a) r
coerce
  toHomogeneous :: Fun (HomList 'Z a) r -> Fun 'Z a r
toHomogeneous   = Fun (HomList 'Z a) r -> Fun 'Z a r
coerce
  {-# INLINE toHeterogeneous #-}
  {-# INLINE toHomogeneous   #-}

instance HomArity n a => HomArity ('S n) a where
  toHeterogeneous :: Fun ('S n) a r -> Fun (HomList ('S n) a) r
toHeterogeneous Fun ('S n) a r
f
    = (a -> Fn Identity (HomList n a) r) -> Fun (a : HomList n a) r
coerce ((a -> Fn Identity (HomList n a) r) -> Fun (a : HomList n a) r)
-> (a -> Fn Identity (HomList n a) r) -> Fun (a : HomList n a) r
forall a b. (a -> b) -> a -> b
$ \a
a -> TFun Identity (HomList n a) r -> Fn Identity (HomList n a) r
forall α (f :: α -> *) (as :: [α]) b. TFun f as b -> Fn f as b
unTFun (TFun Identity (HomList n a) r -> Fn Identity (HomList n a) r)
-> TFun Identity (HomList n a) r -> Fn Identity (HomList n a) r
forall a b. (a -> b) -> a -> b
$ Fun n a r -> TFun Identity (HomList n a) r
forall (n :: PeanoNum) a r.
HomArity n a =>
Fun n a r -> Fun (HomList n a) r
toHeterogeneous (Fun ('S n) a r -> a -> Fun n a r
forall (n :: PeanoNum) a b. Fun ('S n) a b -> a -> Fun n a b
F.curryFirst Fun ('S n) a r
f a
a)
  toHomogeneous :: Fun (HomList ('S n) a) r -> Fun ('S n) a r
toHomogeneous (f :: Fun (a : HomList n a) r)
    = (a -> Fun n a r) -> Fun ('S n) a r
coerce ((a -> Fun n a r) -> Fun ('S n) a r)
-> (a -> Fun n a r) -> Fun ('S n) a r
forall a b. (a -> b) -> a -> b
$ \a
a -> (Fun (HomList n a) r -> Fun n a r
forall (n :: PeanoNum) a r.
HomArity n a =>
Fun (HomList n a) r -> Fun n a r
toHomogeneous (Fun (HomList n a) r -> Fun n a r)
-> Fun (HomList n a) r -> Fun n a r
forall a b. (a -> b) -> a -> b
$ Fun (a : HomList n a) r -> a -> Fun (HomList n a) r
forall x (xs :: [*]) r. Fun (x : xs) r -> x -> Fun xs r
curryFun Fun (a : HomList n a) r
f a
a :: F.Fun n a r)
  {-# INLINE toHeterogeneous #-}
  {-# INLINE toHomogeneous   #-}

-- | Default implementation of 'inspect' for homogeneous vector.
homInspect :: (F.Vector v a, HomArity (Peano (F.Dim v)) a)
           => v a -> Fun (HomList (Peano (F.Dim v)) a) r -> r
homInspect :: v a -> Fun (HomList (Peano (Dim v)) a) r -> r
homInspect v a
v Fun (HomList (Peano (Dim v)) a) r
f = v a -> Fun (Peano (Dim v)) a r -> r
forall (v :: * -> *) a b.
Vector v a =>
v a -> Fun (Peano (Dim v)) a b -> b
F.inspect v a
v (Fun (HomList (Peano (Dim v)) a) r -> Fun (Peano (Dim v)) a r
forall (n :: PeanoNum) a r.
HomArity n a =>
Fun (HomList n a) r -> Fun n a r
toHomogeneous Fun (HomList (Peano (Dim v)) a) r
f)
{-# INLINE homInspect #-}

-- | Default implementation of 'construct' for homogeneous vector.
homConstruct :: forall v a.
                (F.Vector v a, HomArity (Peano (F.Dim v)) a)
             => Fun (HomList (Peano (F.Dim v)) a) (v a)
homConstruct :: Fun (HomList (Peano (Dim v)) a) (v a)
homConstruct = Fun (Peano (Dim v)) a (v a)
-> Fun (HomList (Peano (Dim v)) a) (v a)
forall (n :: PeanoNum) a r.
HomArity n a =>
Fun n a r -> Fun (HomList n a) r
toHeterogeneous (Fun (Peano (Dim v)) a (v a)
forall (v :: * -> *) a. Vector v a => Fun (Peano (Dim v)) a (v a)
F.construct :: F.Fun (Peano (F.Dim v)) a (v a))
{-# INLINE homConstruct #-}



instance ( HomArity (Peano n) a
         , KnownNat n
         , Peano (n + 1) ~ 'S (Peano n)
         ) => HVector (B.Vec n a) where
  type Elems (B.Vec n a) = HomList (Peano n) a
  inspect :: Vec n a -> Fun (Elems (Vec n a)) a -> a
inspect   = Vec n a -> Fun (Elems (Vec n a)) a -> a
forall (v :: * -> *) a r.
(Vector v a, HomArity (Peano (Dim v)) a) =>
v a -> Fun (HomList (Peano (Dim v)) a) r -> r
homInspect
  construct :: Fun (Elems (Vec n a)) (Vec n a)
construct = Fun (Elems (Vec n a)) (Vec n a)
forall (v :: * -> *) a.
(Vector v a, HomArity (Peano (Dim v)) a) =>
Fun (HomList (Peano (Dim v)) a) (v a)
homConstruct
  {-# INLINE inspect   #-}
  {-# INLINE construct #-}

instance ( U.Unbox n a
         , HomArity (Peano n) a
         , KnownNat n
         , Peano (n + 1) ~ 'S (Peano n)
         ) => HVector (U.Vec n a) where
  type Elems (U.Vec n a) = HomList (Peano n) a
  inspect :: Vec n a -> Fun (Elems (Vec n a)) a -> a
inspect   = Vec n a -> Fun (Elems (Vec n a)) a -> a
forall (v :: * -> *) a r.
(Vector v a, HomArity (Peano (Dim v)) a) =>
v a -> Fun (HomList (Peano (Dim v)) a) r -> r
homInspect
  construct :: Fun (Elems (Vec n a)) (Vec n a)
construct = Fun (Elems (Vec n a)) (Vec n a)
forall (v :: * -> *) a.
(Vector v a, HomArity (Peano (Dim v)) a) =>
Fun (HomList (Peano (Dim v)) a) (v a)
homConstruct
  {-# INLINE inspect   #-}
  {-# INLINE construct #-}

instance ( S.Storable a
         , HomArity (Peano n) a
         , KnownNat n
         , Peano (n + 1) ~ 'S (Peano n)
         ) => HVector (S.Vec n a) where
  type Elems (S.Vec n a) = HomList (Peano n) a
  inspect :: Vec n a -> Fun (Elems (Vec n a)) a -> a
inspect   = Vec n a -> Fun (Elems (Vec n a)) a -> a
forall (v :: * -> *) a r.
(Vector v a, HomArity (Peano (Dim v)) a) =>
v a -> Fun (HomList (Peano (Dim v)) a) r -> r
homInspect
  construct :: Fun (Elems (Vec n a)) (Vec n a)
construct = Fun (Elems (Vec n a)) (Vec n a)
forall (v :: * -> *) a.
(Vector v a, HomArity (Peano (Dim v)) a) =>
Fun (HomList (Peano (Dim v)) a) (v a)
homConstruct
  {-# INLINE inspect   #-}
  {-# INLINE construct #-}

instance ( P.Prim a
         , HomArity (Peano n) a
         , KnownNat n
         , Peano (n + 1) ~ 'S (Peano n)
         ) => HVector (P.Vec n a) where
  type Elems (P.Vec n a) = HomList (Peano n) a
  inspect :: Vec n a -> Fun (Elems (Vec n a)) a -> a
inspect   = Vec n a -> Fun (Elems (Vec n a)) a -> a
forall (v :: * -> *) a r.
(Vector v a, HomArity (Peano (Dim v)) a) =>
v a -> Fun (HomList (Peano (Dim v)) a) r -> r
homInspect
  construct :: Fun (Elems (Vec n a)) (Vec n a)
construct = Fun (Elems (Vec n a)) (Vec n a)
forall (v :: * -> *) a.
(Vector v a, HomArity (Peano (Dim v)) a) =>
Fun (HomList (Peano (Dim v)) a) (v a)
homConstruct
  {-# INLINE inspect   #-}
  {-# INLINE construct #-}



----------------------------------------------------------------
-- CPS-encoded vectors
----------------------------------------------------------------

--
-- newtype ContVec xs = ContVec { runContVec :: forall r. Fun xs r -> r }

instance Arity xs => HVector (ContVecF xs Identity) where
  type Elems (ContVecF xs Identity) = xs
  construct :: Fun (Elems (ContVecF xs Identity)) (ContVecF xs Identity)
construct = (forall a (as :: [*]).
 T_mkN xs (a : as) -> Identity a -> T_mkN xs as)
-> (T_mkN xs '[] -> ContVecF xs Identity)
-> T_mkN xs xs
-> TFun Identity xs (ContVecF xs Identity)
forall α (xs :: [α]) (t :: [α] -> *) (f :: α -> *) b.
Arity xs =>
(forall (a :: α) (as :: [α]). t (a : as) -> f a -> t as)
-> (t '[] -> b) -> t xs -> TFun f xs b
accum
    (\(T_mkN f) (Identity x) -> (ContVec as -> ContVecF xs Identity) -> T_mkN xs as
forall (all :: [*]) (xs :: [*]).
(ContVec xs -> ContVec all) -> T_mkN all xs
T_mkN (ContVec (a : as) -> ContVecF xs Identity
f (ContVec (a : as) -> ContVecF xs Identity)
-> (ContVec as -> ContVec (a : as))
-> ContVec as
-> ContVecF xs Identity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ContVec as -> ContVec (a : as)
forall x (xs :: [*]). x -> ContVec xs -> ContVec (x : xs)
cons a
x))
    (\(T_mkN ContVec '[] -> ContVecF xs Identity
f)              -> ContVec '[] -> ContVecF xs Identity
f ((forall r. TFun Identity '[] r -> r) -> ContVec '[]
forall α (xs :: [α]) (f :: α -> *).
(forall r. TFun f xs r -> r) -> ContVecF xs f
ContVecF forall r. TFun Identity '[] r -> r
forall α (f :: α -> *) (as :: [α]) b. TFun f as b -> Fn f as b
unTFun))
    ((ContVecF xs Identity -> ContVecF xs Identity) -> T_mkN xs xs
forall (all :: [*]) (xs :: [*]).
(ContVec xs -> ContVec all) -> T_mkN all xs
T_mkN ContVecF xs Identity -> ContVecF xs Identity
forall a. a -> a
id)
  inspect :: ContVecF xs Identity -> Fun (Elems (ContVecF xs Identity)) a -> a
inspect (ContVecF forall r. TFun Identity xs r -> r
cont) Fun (Elems (ContVecF xs Identity)) a
f = TFun Identity xs a -> a
forall r. TFun Identity xs r -> r
cont TFun Identity xs a
Fun (Elems (ContVecF xs Identity)) a
f
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

newtype T_mkN all xs = T_mkN (ContVec xs -> ContVec all)

-- | CPS-encoded heterogeneous vector.
type ContVec xs = ContVecF xs Identity

-- | CPS-encoded partially heterogeneous vector.
newtype ContVecF (xs :: [α]) (f :: α -> *) =
  ContVecF { ContVecF xs f -> forall r. TFun f xs r -> r
runContVecF :: forall r. TFun f xs r -> r }

instance Arity xs => HVectorF (ContVecF xs) where
  type ElemsF (ContVecF xs) = xs
  inspectF :: ContVecF xs f -> TFun f (ElemsF (ContVecF xs)) a -> a
inspectF (ContVecF forall r. TFun f xs r -> r
cont) = TFun f (ElemsF (ContVecF xs)) a -> a
forall r. TFun f xs r -> r
cont
  constructF :: TFun f (ElemsF (ContVecF xs)) (ContVecF xs f)
constructF = TFun f (ElemsF (ContVecF xs)) (ContVecF xs f)
forall α (f :: α -> *) (xs :: [α]).
Arity xs =>
TFun f xs (ContVecF xs f)
constructFF
  {-# INLINE constructF #-}
  {-# INLINE inspectF   #-}

constructFF :: forall f xs. (Arity xs) => TFun f xs (ContVecF xs f)
{-# INLINE constructFF #-}
constructFF :: TFun f xs (ContVecF xs f)
constructFF = (forall (a :: α) (as :: [α]).
 TF_mkN f xs (a : as) -> f a -> TF_mkN f xs as)
-> (TF_mkN f xs '[] -> ContVecF xs f)
-> TF_mkN f xs xs
-> TFun f xs (ContVecF xs f)
forall α (xs :: [α]) (t :: [α] -> *) (f :: α -> *) b.
Arity xs =>
(forall (a :: α) (as :: [α]). t (a : as) -> f a -> t as)
-> (t '[] -> b) -> t xs -> TFun f xs b
accum (\(TF_mkN f) f a
x -> (ContVecF as f -> ContVecF xs f) -> TF_mkN f xs as
forall α (f :: α -> *) (all :: [α]) (xs :: [α]).
(ContVecF xs f -> ContVecF all f) -> TF_mkN f all xs
TF_mkN (ContVecF (a : as) f -> ContVecF xs f
f (ContVecF (a : as) f -> ContVecF xs f)
-> (ContVecF as f -> ContVecF (a : as) f)
-> ContVecF as f
-> ContVecF xs f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> ContVecF as f -> ContVecF (a : as) f
forall α (f :: α -> *) (x :: α) (xs :: [α]).
f x -> ContVecF xs f -> ContVecF (x : xs) f
consF f a
x))
                    (\(TF_mkN ContVecF '[] f -> ContVecF xs f
f)   -> ContVecF '[] f -> ContVecF xs f
f (ContVecF '[] f -> ContVecF xs f)
-> ContVecF '[] f -> ContVecF xs f
forall a b. (a -> b) -> a -> b
$ (forall r. TFun f '[] r -> r) -> ContVecF '[] f
forall α (xs :: [α]) (f :: α -> *).
(forall r. TFun f xs r -> r) -> ContVecF xs f
ContVecF forall r. TFun f '[] r -> r
forall α (f :: α -> *) (as :: [α]) b. TFun f as b -> Fn f as b
unTFun)
                    ((ContVecF xs f -> ContVecF xs f) -> TF_mkN f xs xs
forall α (f :: α -> *) (all :: [α]) (xs :: [α]).
(ContVecF xs f -> ContVecF all f) -> TF_mkN f all xs
TF_mkN ContVecF xs f -> ContVecF xs f
forall a. a -> a
id)

newtype TF_mkN f all xs = TF_mkN (ContVecF xs f -> ContVecF all f)


-- | Cons element to the vector
cons :: x -> ContVec xs -> ContVec (x : xs)
cons :: x -> ContVec xs -> ContVec (x : xs)
cons x
x (ContVecF forall r. TFun Identity xs r -> r
cont) = (forall r. TFun Identity (x : xs) r -> r) -> ContVec (x : xs)
forall α (xs :: [α]) (f :: α -> *).
(forall r. TFun f xs r -> r) -> ContVecF xs f
ContVecF ((forall r. TFun Identity (x : xs) r -> r) -> ContVec (x : xs))
-> (forall r. TFun Identity (x : xs) r -> r) -> ContVec (x : xs)
forall a b. (a -> b) -> a -> b
$ \TFun Identity (x : xs) r
f -> TFun Identity xs r -> r
forall r. TFun Identity xs r -> r
cont (TFun Identity xs r -> r) -> TFun Identity xs r -> r
forall a b. (a -> b) -> a -> b
$ TFun Identity (x : xs) r -> x -> TFun Identity xs r
forall x (xs :: [*]) r. Fun (x : xs) r -> x -> Fun xs r
curryFun TFun Identity (x : xs) r
f x
x
{-# INLINE cons #-}

-- | Cons element to the vector
consF :: f x -> ContVecF xs f -> ContVecF (x : xs) f
consF :: f x -> ContVecF xs f -> ContVecF (x : xs) f
consF f x
x (ContVecF forall r. TFun f xs r -> r
cont) = (forall r. TFun f (x : xs) r -> r) -> ContVecF (x : xs) f
forall α (xs :: [α]) (f :: α -> *).
(forall r. TFun f xs r -> r) -> ContVecF xs f
ContVecF ((forall r. TFun f (x : xs) r -> r) -> ContVecF (x : xs) f)
-> (forall r. TFun f (x : xs) r -> r) -> ContVecF (x : xs) f
forall a b. (a -> b) -> a -> b
$ \TFun f (x : xs) r
f -> TFun f xs r -> r
forall r. TFun f xs r -> r
cont (TFun f xs r -> r) -> TFun f xs r -> r
forall a b. (a -> b) -> a -> b
$ TFun f (x : xs) r -> f x -> TFun f xs r
forall α (f :: α -> *) (x :: α) (xs :: [α]) r.
TFun f (x : xs) r -> f x -> TFun f xs r
curryTFun TFun f (x : xs) r
f f x
x
{-# INLINE consF #-}



----------------------------------------------------------------
-- Instances of Fun
----------------------------------------------------------------

instance (Arity xs) => Functor (TFun f xs) where
  fmap :: (a -> b) -> TFun f xs a -> TFun f xs b
fmap a -> b
f (TFun Fn f xs a
g0)
    = (forall (a :: α) (as :: [α]).
 TF_fmap f a (a : as) -> f a -> TF_fmap f a as)
-> (TF_fmap f a '[] -> b) -> TF_fmap f a xs -> TFun f xs b
forall α (xs :: [α]) (t :: [α] -> *) (f :: α -> *) b.
Arity xs =>
(forall (a :: α) (as :: [α]). t (a : as) -> f a -> t as)
-> (t '[] -> b) -> t xs -> TFun f xs b
accum (\(TF_fmap g) f a
a -> Fn f as a -> TF_fmap f a as
forall α (f :: α -> *) a (xs :: [α]). Fn f xs a -> TF_fmap f a xs
TF_fmap (Fn f (a : as) a
f a -> Fn f as a
g f a
a))
            (\(TF_fmap Fn f '[] a
r)   -> a -> b
f a
Fn f '[] a
r)
            (Fn f xs a -> TF_fmap f a xs
forall α (f :: α -> *) a (xs :: [α]). Fn f xs a -> TF_fmap f a xs
TF_fmap Fn f xs a
g0)
  {-# INLINE fmap #-}

instance (Arity xs) => Applicative (TFun f xs) where
  pure :: a -> TFun f xs a
pure a
r = (forall (a :: α) (as :: [α]). Proxy (a : as) -> f a -> Proxy as)
-> (Proxy '[] -> a) -> Proxy xs -> TFun f xs a
forall α (xs :: [α]) (t :: [α] -> *) (f :: α -> *) b.
Arity xs =>
(forall (a :: α) (as :: [α]). t (a : as) -> f a -> t as)
-> (t '[] -> b) -> t xs -> TFun f xs b
accum (\Proxy (a : as)
Proxy f a
_ -> Proxy as
forall k (t :: k). Proxy t
Proxy)
                 (\Proxy '[]
Proxy   -> a
r)
                 (Proxy xs
forall k (t :: k). Proxy t
Proxy)
  {-# INLINE pure  #-}
  (TFun Fn f xs (a -> b)
f0 :: TFun f xs (a -> b)) <*> :: TFun f xs (a -> b) -> TFun f xs a -> TFun f xs b
<*> (TFun Fn f xs a
g0 :: TFun f xs a)
    = (forall (a :: α) (as :: [α]).
 TF_ap f (a -> b) a (a : as) -> f a -> TF_ap f (a -> b) a as)
-> (TF_ap f (a -> b) a '[] -> b)
-> TF_ap f (a -> b) a xs
-> TFun f xs b
forall α (xs :: [α]) (t :: [α] -> *) (f :: α -> *) b.
Arity xs =>
(forall (a :: α) (as :: [α]). t (a : as) -> f a -> t as)
-> (t '[] -> b) -> t xs -> TFun f xs b
accum (\(TF_ap f g) f a
a -> Fn f as (a -> b) -> Fn f as a -> TF_ap f (a -> b) a as
forall α (f :: α -> *) a b (xs :: [α]).
Fn f xs a -> Fn f xs b -> TF_ap f a b xs
TF_ap (Fn f (a : as) (a -> b)
f a -> Fn f as (a -> b)
f f a
a) (Fn f (a : as) a
f a -> Fn f as a
g f a
a))
            (\(TF_ap Fn f '[] (a -> b)
f Fn f '[] a
g)   -> Fn f '[] (a -> b)
a -> b
f a
Fn f '[] a
g)
            ( Fn f xs (a -> b) -> Fn f xs a -> TF_ap f (a -> b) a xs
forall α (f :: α -> *) a b (xs :: [α]).
Fn f xs a -> Fn f xs b -> TF_ap f a b xs
TF_ap Fn f xs (a -> b)
f0 Fn f xs a
g0 :: TF_ap f (a -> b) a xs)
  {-# INLINE (<*>) #-}

instance Arity xs => Monad (TFun f xs) where
  return :: a -> TFun f xs a
return  = a -> TFun f xs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  TFun f xs a
f >>= :: TFun f xs a -> (a -> TFun f xs b) -> TFun f xs b
>>= a -> TFun f xs b
g = (a -> TFun f xs b) -> TFun f xs (a -> b)
forall α (f :: α -> *) x (xs :: [α]) r.
Arity xs =>
(x -> TFun f xs r) -> TFun f xs (x -> r)
shuffleTF a -> TFun f xs b
g TFun f xs (a -> b) -> TFun f xs a -> TFun f xs b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TFun f xs a
f
  {-# INLINE return #-}
  {-# INLINE (>>=)  #-}

newtype TF_fmap f a   xs = TF_fmap (Fn f xs a)
data    TF_ap   f a b xs = TF_ap   (Fn f xs a) (Fn f xs b)



----------------------------------------------------------------
-- Operations on Fun
----------------------------------------------------------------

-- | Apply single parameter to function
curryFun :: Fun (x : xs) r -> x -> Fun xs r
curryFun :: Fun (x : xs) r -> x -> Fun xs r
curryFun = Fun (x : xs) r -> x -> Fun xs r
coerce
{-# INLINE curryFun #-}

-- | Uncurry N-ary function.
uncurryFun :: (x -> Fun xs r) -> Fun (x : xs) r
uncurryFun :: (x -> Fun xs r) -> Fun (x : xs) r
uncurryFun = (x -> Fun xs r) -> Fun (x : xs) r
coerce
{-# INLINE uncurryFun #-}

-- | Conversion function
uncurryMany :: forall xs ys r. Arity xs => Fun xs (Fun ys r) -> Fun (xs ++ ys) r
-- NOTE: GHC is not smart enough to figure out that:
--
--       > Fn xs (Fn ys) r ~ Fn (xs ++ ys) r
--
--       It's possible to construct type safe definition but it's
--       quite complicated and increase compile time and may hurrt
--       performance
{-# INLINE uncurryMany #-}
uncurryMany :: Fun xs (Fun ys r) -> Fun (xs ++ ys) r
uncurryMany = Fun xs (Fun ys r) -> Fun (xs ++ ys) r
forall a b. a -> b
unsafeCoerce

-- | Curry first /n/ arguments of N-ary function.
curryMany :: forall xs ys r. Arity xs => Fun (xs ++ ys) r -> Fun xs (Fun ys r)
-- NOTE: See uncurryMany
{-# INLINE curryMany #-}
curryMany :: Fun (xs ++ ys) r -> Fun xs (Fun ys r)
curryMany = Fun (xs ++ ys) r -> Fun xs (Fun ys r)
forall a b. a -> b
unsafeCoerce


-- | Add one parameter to function which is ignored.
constFun :: Fun xs r -> Fun (x : xs) r
constFun :: Fun xs r -> Fun (x : xs) r
constFun = (x -> Fun xs r) -> Fun (x : xs) r
forall x (xs :: [*]) r. (x -> Fun xs r) -> Fun (x : xs) r
uncurryFun ((x -> Fun xs r) -> Fun (x : xs) r)
-> (Fun xs r -> x -> Fun xs r) -> Fun xs r -> Fun (x : xs) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fun xs r -> x -> Fun xs r
forall a b. a -> b -> a
const
{-# INLINE constFun #-}

-- | Add one parameter to function which is ignored.
constTFun :: TFun f xs r -> TFun f (x : xs) r
constTFun :: TFun f xs r -> TFun f (x : xs) r
constTFun = (f x -> TFun f xs r) -> TFun f (x : xs) r
forall a (f :: a -> *) (x :: a) (xs :: [a]) r.
(f x -> TFun f xs r) -> TFun f (x : xs) r
uncurryTFun ((f x -> TFun f xs r) -> TFun f (x : xs) r)
-> (TFun f xs r -> f x -> TFun f xs r)
-> TFun f xs r
-> TFun f (x : xs) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TFun f xs r -> f x -> TFun f xs r
forall a b. a -> b -> a
const
{-# INLINE constTFun #-}

-- | Transform function but leave outermost parameter untouched.
stepTFun :: (TFun f xs a       -> TFun f ys b)
         -> (TFun f (x : xs) a -> TFun f (x : ys) b)
stepTFun :: (TFun f xs a -> TFun f ys b)
-> TFun f (x : xs) a -> TFun f (x : ys) b
stepTFun TFun f xs a -> TFun f ys b
g = (f x -> TFun f ys b) -> TFun f (x : ys) b
forall a (f :: a -> *) (x :: a) (xs :: [a]) r.
(f x -> TFun f xs r) -> TFun f (x : xs) r
uncurryTFun ((f x -> TFun f ys b) -> TFun f (x : ys) b)
-> (TFun f (x : xs) a -> f x -> TFun f ys b)
-> TFun f (x : xs) a
-> TFun f (x : ys) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TFun f xs a -> TFun f ys b)
-> (f x -> TFun f xs a) -> f x -> TFun f ys b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TFun f xs a -> TFun f ys b
g ((f x -> TFun f xs a) -> f x -> TFun f ys b)
-> (TFun f (x : xs) a -> f x -> TFun f xs a)
-> TFun f (x : xs) a
-> f x
-> TFun f ys b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TFun f (x : xs) a -> f x -> TFun f xs a
forall α (f :: α -> *) (x :: α) (xs :: [α]) r.
TFun f (x : xs) r -> f x -> TFun f xs r
curryTFun
{-# INLINE stepTFun #-}

-- | Concatenate n-ary functions. This function combine results of
--   both N-ary functions and merge their parameters into single list.
concatF :: (Arity xs, Arity ys)
        => (a -> b -> c) -> Fun xs a -> Fun ys b -> Fun (xs ++ ys) c
{-# INLINE concatF #-}
concatF :: (a -> b -> c) -> Fun xs a -> Fun ys b -> Fun (xs ++ ys) c
concatF a -> b -> c
f Fun xs a
funA Fun ys b
funB = Fun xs (Fun ys c) -> Fun (xs ++ ys) c
forall (xs :: [*]) (ys :: [*]) r.
Arity xs =>
Fun xs (Fun ys r) -> Fun (xs ++ ys) r
uncurryMany (Fun xs (Fun ys c) -> Fun (xs ++ ys) c)
-> Fun xs (Fun ys c) -> Fun (xs ++ ys) c
forall a b. (a -> b) -> a -> b
$ (a -> Fun ys c) -> Fun xs a -> Fun xs (Fun ys c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Fun ys c
go Fun xs a
funA
  where
    go :: a -> Fun ys c
go a
a = (b -> c) -> Fun ys b -> Fun ys c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\b
b -> a -> b -> c
f a
a b
b) Fun ys b
funB

-- | Helper for lens implementation.
lensWorkerF :: forall f r x y xs. (Functor f, Arity xs)
            => (x -> f y) -> Fun (y : xs) r -> Fun (x : xs) (f r)
{-# INLINE lensWorkerF #-}
lensWorkerF :: (x -> f y) -> Fun (y : xs) r -> Fun (x : xs) (f r)
lensWorkerF x -> f y
g Fun (y : xs) r
f
  = (x -> Fun xs (f r)) -> Fun (x : xs) (f r)
forall x (xs :: [*]) r. (x -> Fun xs r) -> Fun (x : xs) r
uncurryFun
  ((x -> Fun xs (f r)) -> Fun (x : xs) (f r))
-> (x -> Fun xs (f r)) -> Fun (x : xs) (f r)
forall a b. (a -> b) -> a -> b
$ \x
x -> (\y -> r
r -> (y -> r) -> f y -> f r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (y -> r
r (y -> r) -> y -> r
forall a b. (a -> b) -> a -> b
$) (x -> f y
g x
x)) ((y -> r) -> f r) -> TFun Identity xs (y -> r) -> Fun xs (f r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (y -> TFun Identity xs r) -> TFun Identity xs (y -> r)
forall α (f :: α -> *) x (xs :: [α]) r.
Arity xs =>
(x -> TFun f xs r) -> TFun f xs (x -> r)
shuffleTF (Fun (y : xs) r -> y -> TFun Identity xs r
forall x (xs :: [*]) r. Fun (x : xs) r -> x -> Fun xs r
curryFun Fun (y : xs) r
f)

-- | Helper for lens implementation.
lensWorkerTF :: forall f g r x y xs. (Functor f, Arity xs)
             => (g x -> f (g y))
             -> TFun g (y : xs) r
             -> TFun g (x : xs) (f r)
{-# INLINE lensWorkerTF #-}
lensWorkerTF :: (g x -> f (g y)) -> TFun g (y : xs) r -> TFun g (x : xs) (f r)
lensWorkerTF g x -> f (g y)
g TFun g (y : xs) r
f
  = (g x -> TFun g xs (f r)) -> TFun g (x : xs) (f r)
forall a (f :: a -> *) (x :: a) (xs :: [a]) r.
(f x -> TFun f xs r) -> TFun f (x : xs) r
uncurryTFun
  ((g x -> TFun g xs (f r)) -> TFun g (x : xs) (f r))
-> (g x -> TFun g xs (f r)) -> TFun g (x : xs) (f r)
forall a b. (a -> b) -> a -> b
$ \g x
x -> (\g y -> r
r -> (g y -> r) -> f (g y) -> f r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (g y -> r
r (g y -> r) -> g y -> r
forall a b. (a -> b) -> a -> b
$) (g x -> f (g y)
g g x
x)) ((g y -> r) -> f r) -> TFun g xs (g y -> r) -> TFun g xs (f r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (g y -> TFun g xs r) -> TFun g xs (g y -> r)
forall α (f :: α -> *) x (xs :: [α]) r.
Arity xs =>
(x -> TFun f xs r) -> TFun f xs (x -> r)
shuffleTF (TFun g (y : xs) r -> g y -> TFun g xs r
forall α (f :: α -> *) (x :: α) (xs :: [α]) r.
TFun f (x : xs) r -> f x -> TFun f xs r
curryTFun TFun g (y : xs) r
f)


----------------------------------------------------------------
-- Operations on TFun
----------------------------------------------------------------

-- | Apply single parameter to function
curryTFun :: TFun f (x : xs) r -> f x -> TFun f xs r
curryTFun :: TFun f (x : xs) r -> f x -> TFun f xs r
curryTFun = TFun f (x : xs) r -> f x -> TFun f xs r
coerce
{-# INLINE curryTFun #-}

-- | Uncurry single parameter
uncurryTFun :: (f x -> TFun f xs r) -> TFun f (x : xs) r
uncurryTFun :: (f x -> TFun f xs r) -> TFun f (x : xs) r
uncurryTFun = (f x -> TFun f xs r) -> TFun f (x : xs) r
coerce
{-# INLINE uncurryTFun #-}

-- | Move first argument of function to its result. This function is
--   useful for implementation of lens.
shuffleTF :: forall f x xs r. Arity xs
          => (x -> TFun f xs r) -> TFun f xs (x -> r)
{-# INLINE shuffleTF #-}
shuffleTF :: (x -> TFun f xs r) -> TFun f xs (x -> r)
shuffleTF x -> TFun f xs r
fun0 = (forall (a :: α) (as :: [α]).
 TF_shuffle f x r (a : as) -> f a -> TF_shuffle f x r as)
-> (TF_shuffle f x r '[] -> x -> r)
-> TF_shuffle f x r xs
-> TFun f xs (x -> r)
forall α (xs :: [α]) (t :: [α] -> *) (f :: α -> *) b.
Arity xs =>
(forall (a :: α) (as :: [α]). t (a : as) -> f a -> t as)
-> (t '[] -> b) -> t xs -> TFun f xs b
accum
  (\(TF_shuffle f) f a
a -> (x -> Fn f as r) -> TF_shuffle f x r as
forall α (f :: α -> *) x r (xs :: [α]).
(x -> Fn f xs r) -> TF_shuffle f x r xs
TF_shuffle (\x
x -> x -> Fn f (a : as) r
x -> f a -> Fn f as r
f x
x f a
a))
  (\(TF_shuffle x -> Fn f '[] r
f)   -> x -> r
x -> Fn f '[] r
f)
  ((x -> Fn f xs r) -> TF_shuffle f x r xs
forall α (f :: α -> *) x r (xs :: [α]).
(x -> Fn f xs r) -> TF_shuffle f x r xs
TF_shuffle ((TFun f xs r -> Fn f xs r) -> (x -> TFun f xs r) -> x -> Fn f xs r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TFun f xs r -> Fn f xs r
forall α (f :: α -> *) (as :: [α]) b. TFun f as b -> Fn f as b
unTFun x -> TFun f xs r
fun0))

data TF_shuffle f x r xs = TF_shuffle (x -> Fn f xs r)



----------------------------------------------------------------
-- Indexing
----------------------------------------------------------------

-- | Indexing of vectors
class ArityPeano n => Index (n :: PeanoNum) (xs :: [*]) where
  -- | Type at position n
  type ValueAt n xs :: *
  -- | List of types with n'th element replaced by /a/.
  type NewElems n xs a :: [*]
  -- | Getter function for vectors
  getF :: proxy n -> Fun xs (ValueAt n xs)
  -- | Putter function. It applies value @x@ to @n@th parameter of
  --   function.
  putF :: proxy n -> ValueAt n xs -> Fun xs r -> Fun xs r
  -- | Helper for implementation of lens
  lensF   :: (Functor f, v ~ ValueAt n xs)
          => proxy n -> (v -> f v) -> Fun xs r -> Fun xs (f r)
  -- | Helper for type-changing lens
  lensChF :: (Functor f)
          => proxy n -> (ValueAt n xs -> f a) -> Fun (NewElems n xs a) r -> Fun xs (f r)

instance Arity xs => Index 'Z (x : xs) where
  type ValueAt  'Z (x : xs)   = x
  type NewElems 'Z (x : xs) a = a : xs
  getF :: proxy 'Z -> Fun (x : xs) (ValueAt 'Z (x : xs))
getF  proxy 'Z
_     = Fn Identity (x : xs) x -> TFun Identity (x : xs) x
forall α (f :: α -> *) (as :: [α]) b. Fn f as b -> TFun f as b
TFun (Fn Identity (x : xs) x -> TFun Identity (x : xs) x)
-> Fn Identity (x : xs) x -> TFun Identity (x : xs) x
forall a b. (a -> b) -> a -> b
$ \(Identity x
x) -> TFun Identity xs x -> Fn Identity xs x
forall α (f :: α -> *) (as :: [α]) b. TFun f as b -> Fn f as b
unTFun (x -> TFun Identity xs x
forall (f :: * -> *) a. Applicative f => a -> f a
pure x
x :: Fun xs x)
  putF :: proxy 'Z -> ValueAt 'Z (x : xs) -> Fun (x : xs) r -> Fun (x : xs) r
putF  proxy 'Z
_ ValueAt 'Z (x : xs)
x Fun (x : xs) r
f = Fun xs r -> Fun (x : xs) r
forall (xs :: [*]) r x. Fun xs r -> Fun (x : xs) r
constFun (Fun xs r -> Fun (x : xs) r) -> Fun xs r -> Fun (x : xs) r
forall a b. (a -> b) -> a -> b
$ Fun (x : xs) r -> x -> Fun xs r
forall x (xs :: [*]) r. Fun (x : xs) r -> x -> Fun xs r
curryFun Fun (x : xs) r
f x
ValueAt 'Z (x : xs)
x
  lensF :: proxy 'Z -> (v -> f v) -> Fun (x : xs) r -> Fun (x : xs) (f r)
lensF   proxy 'Z
_     = (v -> f v) -> Fun (x : xs) r -> Fun (x : xs) (f r)
forall (f :: * -> *) r x y (xs :: [*]).
(Functor f, Arity xs) =>
(x -> f y) -> Fun (y : xs) r -> Fun (x : xs) (f r)
lensWorkerF
  lensChF :: proxy 'Z
-> (ValueAt 'Z (x : xs) -> f a)
-> Fun (NewElems 'Z (x : xs) a) r
-> Fun (x : xs) (f r)
lensChF proxy 'Z
_     = (ValueAt 'Z (x : xs) -> f a)
-> Fun (NewElems 'Z (x : xs) a) r -> Fun (x : xs) (f r)
forall (f :: * -> *) r x y (xs :: [*]).
(Functor f, Arity xs) =>
(x -> f y) -> Fun (y : xs) r -> Fun (x : xs) (f r)
lensWorkerF
  {-# INLINE getF    #-}
  {-# INLINE putF    #-}
  {-# INLINE lensF   #-}
  {-# INLINE lensChF #-}

instance Index n xs => Index ('S n) (x : xs) where
  type ValueAt  ('S n) (x : xs)   = ValueAt n xs
  type NewElems ('S n) (x : xs) a = x : NewElems n xs a
  getF :: proxy ('S n) -> Fun (x : xs) (ValueAt ('S n) (x : xs))
getF    proxy ('S n)
_   = Fun xs (ValueAt n xs) -> Fun (x : xs) (ValueAt n xs)
forall (xs :: [*]) r x. Fun xs r -> Fun (x : xs) r
constFun (Fun xs (ValueAt n xs) -> Fun (x : xs) (ValueAt n xs))
-> Fun xs (ValueAt n xs) -> Fun (x : xs) (ValueAt n xs)
forall a b. (a -> b) -> a -> b
$ Proxy n -> Fun xs (ValueAt n xs)
forall (n :: PeanoNum) (xs :: [*]) (proxy :: PeanoNum -> *).
Index n xs =>
proxy n -> Fun xs (ValueAt n xs)
getF    (Proxy n
forall k (t :: k). Proxy t
Proxy @n)
  putF :: proxy ('S n)
-> ValueAt ('S n) (x : xs) -> Fun (x : xs) r -> Fun (x : xs) r
putF    proxy ('S n)
_ ValueAt ('S n) (x : xs)
x = (TFun Identity xs r -> TFun Identity xs r)
-> Fun (x : xs) r -> Fun (x : xs) r
forall a (f :: a -> *) (xs :: [a]) a (ys :: [a]) b (x :: a).
(TFun f xs a -> TFun f ys b)
-> TFun f (x : xs) a -> TFun f (x : ys) b
stepTFun ((TFun Identity xs r -> TFun Identity xs r)
 -> Fun (x : xs) r -> Fun (x : xs) r)
-> (TFun Identity xs r -> TFun Identity xs r)
-> Fun (x : xs) r
-> Fun (x : xs) r
forall a b. (a -> b) -> a -> b
$ Proxy n -> ValueAt n xs -> TFun Identity xs r -> TFun Identity xs r
forall (n :: PeanoNum) (xs :: [*]) (proxy :: PeanoNum -> *) r.
Index n xs =>
proxy n -> ValueAt n xs -> Fun xs r -> Fun xs r
putF    (Proxy n
forall k (t :: k). Proxy t
Proxy @n) ValueAt n xs
ValueAt ('S n) (x : xs)
x
  lensF :: proxy ('S n) -> (v -> f v) -> Fun (x : xs) r -> Fun (x : xs) (f r)
lensF   proxy ('S n)
_ v -> f v
f = (TFun Identity xs r -> TFun Identity xs (f r))
-> Fun (x : xs) r -> Fun (x : xs) (f r)
forall a (f :: a -> *) (xs :: [a]) a (ys :: [a]) b (x :: a).
(TFun f xs a -> TFun f ys b)
-> TFun f (x : xs) a -> TFun f (x : ys) b
stepTFun ((TFun Identity xs r -> TFun Identity xs (f r))
 -> Fun (x : xs) r -> Fun (x : xs) (f r))
-> (TFun Identity xs r -> TFun Identity xs (f r))
-> Fun (x : xs) r
-> Fun (x : xs) (f r)
forall a b. (a -> b) -> a -> b
$ Proxy n
-> (v -> f v) -> TFun Identity xs r -> TFun Identity xs (f r)
forall (n :: PeanoNum) (xs :: [*]) (f :: * -> *) v
       (proxy :: PeanoNum -> *) r.
(Index n xs, Functor f, v ~ ValueAt n xs) =>
proxy n -> (v -> f v) -> Fun xs r -> Fun xs (f r)
lensF   (Proxy n
forall k (t :: k). Proxy t
Proxy @n) v -> f v
f
  lensChF :: proxy ('S n)
-> (ValueAt ('S n) (x : xs) -> f a)
-> Fun (NewElems ('S n) (x : xs) a) r
-> Fun (x : xs) (f r)
lensChF proxy ('S n)
_ ValueAt ('S n) (x : xs) -> f a
f = (TFun Identity (NewElems n xs a) r -> TFun Identity xs (f r))
-> TFun Identity (x : NewElems n xs a) r -> Fun (x : xs) (f r)
forall a (f :: a -> *) (xs :: [a]) a (ys :: [a]) b (x :: a).
(TFun f xs a -> TFun f ys b)
-> TFun f (x : xs) a -> TFun f (x : ys) b
stepTFun ((TFun Identity (NewElems n xs a) r -> TFun Identity xs (f r))
 -> TFun Identity (x : NewElems n xs a) r -> Fun (x : xs) (f r))
-> (TFun Identity (NewElems n xs a) r -> TFun Identity xs (f r))
-> TFun Identity (x : NewElems n xs a) r
-> Fun (x : xs) (f r)
forall a b. (a -> b) -> a -> b
$ Proxy n
-> (ValueAt n xs -> f a)
-> TFun Identity (NewElems n xs a) r
-> TFun Identity xs (f r)
forall (n :: PeanoNum) (xs :: [*]) (f :: * -> *)
       (proxy :: PeanoNum -> *) a r.
(Index n xs, Functor f) =>
proxy n
-> (ValueAt n xs -> f a) -> Fun (NewElems n xs a) r -> Fun xs (f r)
lensChF (Proxy n
forall k (t :: k). Proxy t
Proxy @n) ValueAt n xs -> f a
ValueAt ('S n) (x : xs) -> f a
f
  {-# INLINE getF    #-}
  {-# INLINE putF    #-}
  {-# INLINE lensF   #-}
  {-# INLINE lensChF #-}


----------------------------------------------------------------
-- Type lookup
----------------------------------------------------------------

-- | Type class to supporty looking up value in product type by its
--   type. Latter must not contain two elements of type @x@.
class Arity xs => TyLookup x xs where
  lookupTFun :: TFun f xs (f x)

-- Case analysis for type equality
class Arity xs => TyLookupCase (eq :: Bool) x xs where
  lookupTFunCase :: Proxy# eq -> TFun f xs (f x)

-- List xs does not contain type x
class NoType                  x xs
class NoTypeCase (eq :: Bool) x xs
instance                             NoType a '[]
instance NoTypeCase (a == x) a xs => NoType a (x ': xs)
instance ( TypeError ('Text "Duplicate type found: " ':$$: 'ShowType a)
         )           => NoTypeCase 'True  a xs
instance NoType a xs => NoTypeCase 'False a xs


instance ( TypeError ('Text "Cannot find type: " ':$$: 'ShowType a)
         ) => TyLookup a '[] where
  lookupTFun :: TFun f '[] (f a)
lookupTFun = [Char] -> TFun f '[] (f a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable"

-- Case analysis of type equality
instance ( Arity xs
         , TyLookupCase (a == x) a (x ': xs)
         ) => TyLookup a (x ': xs) where
  lookupTFun :: TFun f (x : xs) (f a)
lookupTFun = Proxy# (a == x) -> TFun f (x : xs) (f a)
forall α (eq :: Bool) (x :: α) (xs :: [α]) (f :: α -> *).
TyLookupCase eq x xs =>
Proxy# eq -> TFun f xs (f x)
lookupTFunCase (Proxy# (a == x)
forall k (a :: k). Proxy# a
proxy# :: Proxy# (a == x))
  {-# INLINE lookupTFun #-}

-- Found x
instance ( Arity xs
         , NoType x xs
         ) => TyLookupCase 'True x (x ': xs) where
  lookupTFunCase :: Proxy# 'True -> TFun f (x : xs) (f x)
lookupTFunCase Proxy# 'True
_ = (f x -> TFun f xs (f x)) -> TFun f (x : xs) (f x)
forall a (f :: a -> *) (x :: a) (xs :: [a]) r.
(f x -> TFun f xs r) -> TFun f (x : xs) r
uncurryTFun f x -> TFun f xs (f x)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  {-# INLINE lookupTFunCase #-}

-- Go deeper
instance ( Arity xs
         , TyLookup a xs
         ) => TyLookupCase 'False a (x ': xs) where
  lookupTFunCase :: Proxy# 'False -> TFun f (x : xs) (f a)
lookupTFunCase Proxy# 'False
_ = (f x -> TFun f xs (f a)) -> TFun f (x : xs) (f a)
forall a (f :: a -> *) (x :: a) (xs :: [a]) r.
(f x -> TFun f xs r) -> TFun f (x : xs) r
uncurryTFun ((f x -> TFun f xs (f a)) -> TFun f (x : xs) (f a))
-> (f x -> TFun f xs (f a)) -> TFun f (x : xs) (f a)
forall a b. (a -> b) -> a -> b
$ TFun f xs (f a) -> f x -> TFun f xs (f a)
forall a b. a -> b -> a
const TFun f xs (f a)
forall α (x :: α) (xs :: [α]) (f :: α -> *).
TyLookup x xs =>
TFun f xs (f x)
lookupTFun
  {-# INLINE lookupTFunCase #-}


----------------------------------------------------------------
-- Instances
----------------------------------------------------------------

-- | Unit is empty heterogeneous vector
instance HVector () where
  type Elems () = '[]
  construct :: Fun (Elems ()) ()
construct = Fn Identity '[] () -> TFun Identity '[] ()
forall α (f :: α -> *) (as :: [α]) b. Fn f as b -> TFun f as b
TFun ()
  inspect :: () -> Fun (Elems ()) a -> a
inspect () (TFun Fn Identity (Elems ()) a
f) = a
Fn Identity (Elems ()) a
f

instance HVector (Complex a) where
  type Elems (Complex a) = '[a,a]
  construct :: Fun (Elems (Complex a)) (Complex a)
construct = Fn Identity '[a, a] (Complex a)
-> TFun Identity '[a, a] (Complex a)
forall α (f :: α -> *) (as :: [α]) b. Fn f as b -> TFun f as b
TFun (Fn Identity '[a, a] (Complex a)
 -> TFun Identity '[a, a] (Complex a))
-> Fn Identity '[a, a] (Complex a)
-> TFun Identity '[a, a] (Complex a)
forall a b. (a -> b) -> a -> b
$ \(Identity a
r) (Identity a
i) -> a -> a -> Complex a
forall a. a -> a -> Complex a
(:+) a
r a
i
  inspect :: Complex a -> Fun (Elems (Complex a)) a -> a
inspect (a
r :+ a
i) Fun (Elems (Complex a)) a
f = Fun '[a, a] a -> a -> a -> a
coerce Fun '[a, a] a
Fun (Elems (Complex a)) a
f a
r a
i
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b) where
  type Elems (a,b) = '[a,b]
  construct :: Fun (Elems (a, b)) (a, b)
construct = (a -> b -> (a, b)) -> Fun '[a, b] (a, b)
coerce ((,) :: a->b -> (a,b))
  inspect :: (a, b) -> Fun (Elems (a, b)) a -> a
inspect (a
a,b
b) Fun (Elems (a, b)) a
f = Fun '[a, b] a -> a -> b -> a
coerce Fun '[a, b] a
Fun (Elems (a, b)) a
f a
a b
b
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c) where
  type Elems (a,b,c) = '[a,b,c]
  construct :: Fun (Elems (a, b, c)) (a, b, c)
construct = (a -> b -> c -> (a, b, c)) -> Fun '[a, b, c] (a, b, c)
coerce ((,,) :: a->b->c -> (a,b,c))
  inspect :: (a, b, c) -> Fun (Elems (a, b, c)) a -> a
inspect (a
a,b
b,c
c) Fun (Elems (a, b, c)) a
f = Fun '[a, b, c] a -> a -> b -> c -> a
coerce Fun '[a, b, c] a
Fun (Elems (a, b, c)) a
f a
a b
b c
c
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d) where
  type Elems (a,b,c,d) = '[a,b,c,d]
  construct :: Fun (Elems (a, b, c, d)) (a, b, c, d)
construct = (a -> b -> c -> d -> (a, b, c, d))
-> Fun '[a, b, c, d] (a, b, c, d)
coerce ((,,,) :: a->b->c->d -> (a,b,c,d))
  inspect :: (a, b, c, d) -> Fun (Elems (a, b, c, d)) a -> a
inspect (a
a,b
b,c
c,d
d) Fun (Elems (a, b, c, d)) a
f = Fun '[a, b, c, d] a -> a -> b -> c -> d -> a
coerce Fun '[a, b, c, d] a
Fun (Elems (a, b, c, d)) a
f a
a b
b c
c d
d
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e) where
  type Elems (a,b,c,d,e) = '[a,b,c,d,e]
  construct :: Fun (Elems (a, b, c, d, e)) (a, b, c, d, e)
construct = (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> Fun '[a, b, c, d, e] (a, b, c, d, e)
coerce ((,,,,) :: a->b->c->d->e -> (a,b,c,d,e))
  inspect :: (a, b, c, d, e) -> Fun (Elems (a, b, c, d, e)) a -> a
inspect (a
a,b
b,c
c,d
d,e
e) Fun (Elems (a, b, c, d, e)) a
f = Fun '[a, b, c, d, e] a -> a -> b -> c -> d -> e -> a
coerce Fun '[a, b, c, d, e] a
Fun (Elems (a, b, c, d, e)) a
f a
a b
b c
c d
d e
e
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f) where
  type Elems (a,b,c,d,e,f) = '[a,b,c,d,e,f]
  construct :: Fun (Elems (a, b, c, d, e, f)) (a, b, c, d, e, f)
construct = (a -> b -> c -> d -> e -> f -> (a, b, c, d, e, f))
-> Fun '[a, b, c, d, e, f] (a, b, c, d, e, f)
coerce ((,,,,,) :: a->b->c->d->e->f
                              -> (a,b,c,d,e,f))
  inspect :: (a, b, c, d, e, f) -> Fun (Elems (a, b, c, d, e, f)) a -> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f) Fun (Elems (a, b, c, d, e, f)) a
fun = Fun '[a, b, c, d, e, f] a -> a -> b -> c -> d -> e -> f -> a
coerce Fun '[a, b, c, d, e, f] a
Fun (Elems (a, b, c, d, e, f)) a
fun a
a b
b c
c d
d e
e f
f
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g) where
  type Elems (a,b,c,d,e,f,g) = '[a,b,c,d,e,f,g]
  construct :: Fun (Elems (a, b, c, d, e, f, g)) (a, b, c, d, e, f, g)
construct = (a -> b -> c -> d -> e -> f -> g -> (a, b, c, d, e, f, g))
-> Fun '[a, b, c, d, e, f, g] (a, b, c, d, e, f, g)
coerce ((,,,,,,) :: a->b->c->d->e->f->g
                               -> (a,b,c,d,e,f,g))
  inspect :: (a, b, c, d, e, f, g) -> Fun (Elems (a, b, c, d, e, f, g)) a -> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g) Fun (Elems (a, b, c, d, e, f, g)) a
fun = Fun '[a, b, c, d, e, f, g] a
-> a -> b -> c -> d -> e -> f -> g -> a
coerce Fun '[a, b, c, d, e, f, g] a
Fun (Elems (a, b, c, d, e, f, g)) a
fun a
a b
b c
c d
d e
e f
f g
g
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h) where
  type Elems (a,b,c,d,e,f,g,h) = '[a,b,c,d,e,f,g,h]
  construct :: Fun (Elems (a, b, c, d, e, f, g, h)) (a, b, c, d, e, f, g, h)
construct = (a -> b -> c -> d -> e -> f -> g -> h -> (a, b, c, d, e, f, g, h))
-> Fun '[a, b, c, d, e, f, g, h] (a, b, c, d, e, f, g, h)
coerce ((,,,,,,,) :: a->b->c->d->e->f->g->h
                                -> (a,b,c,d,e,f,g,h))
  inspect :: (a, b, c, d, e, f, g, h)
-> Fun (Elems (a, b, c, d, e, f, g, h)) a -> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h) Fun (Elems (a, b, c, d, e, f, g, h)) a
fun = Fun '[a, b, c, d, e, f, g, h] a
-> a -> b -> c -> d -> e -> f -> g -> h -> a
coerce Fun '[a, b, c, d, e, f, g, h] a
Fun (Elems (a, b, c, d, e, f, g, h)) a
fun a
a b
b c
c d
d e
e f
f g
g h
h
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i) where
  type Elems (a,b,c,d,e,f,g,h,i) = '[a,b,c,d,e,f,g,h,i]
  construct :: Fun (Elems (a, b, c, d, e, f, g, h, i)) (a, b, c, d, e, f, g, h, i)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> (a, b, c, d, e, f, g, h, i))
-> Fun '[a, b, c, d, e, f, g, h, i] (a, b, c, d, e, f, g, h, i)
coerce ((,,,,,,,,) :: a->b->c->d->e->f->g->h->i
                                 -> (a,b,c,d,e,f,g,h,i))
  inspect :: (a, b, c, d, e, f, g, h, i)
-> Fun (Elems (a, b, c, d, e, f, g, h, i)) a -> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i) Fun (Elems (a, b, c, d, e, f, g, h, i)) a
fun = Fun '[a, b, c, d, e, f, g, h, i] a
-> a -> b -> c -> d -> e -> f -> g -> h -> i -> a
coerce Fun '[a, b, c, d, e, f, g, h, i] a
Fun (Elems (a, b, c, d, e, f, g, h, i)) a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j) where
  type Elems (a,b,c,d,e,f,g,h,i,j) = '[a,b,c,d,e,f,g,h,i,j]
  construct :: Fun
  (Elems (a, b, c, d, e, f, g, h, i, j))
  (a, b, c, d, e, f, g, h, i, j)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> (a, b, c, d, e, f, g, h, i, j))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j] (a, b, c, d, e, f, g, h, i, j)
coerce ((,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j
                                  -> (a,b,c,d,e,f,g,h,i,j))
  inspect :: (a, b, c, d, e, f, g, h, i, j)
-> Fun (Elems (a, b, c, d, e, f, g, h, i, j)) a -> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j) Fun (Elems (a, b, c, d, e, f, g, h, i, j)) a
fun = Fun '[a, b, c, d, e, f, g, h, i, j] a
-> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> a
coerce Fun '[a, b, c, d, e, f, g, h, i, j] a
Fun (Elems (a, b, c, d, e, f, g, h, i, j)) a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k) = '[a,b,c,d,e,f,g,h,i,j,k]
  construct :: Fun
  (Elems (a, b, c, d, e, f, g, h, i, j, k))
  (a, b, c, d, e, f, g, h, i, j, k)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> (a, b, c, d, e, f, g, h, i, j, k))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k]
     (a, b, c, d, e, f, g, h, i, j, k)
coerce ((,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k
                                   -> (a,b,c,d,e,f,g,h,i,j,k))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k)
-> Fun (Elems (a, b, c, d, e, f, g, h, i, j, k)) a -> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k) Fun (Elems (a, b, c, d, e, f, g, h, i, j, k)) a
fun = Fun '[a, b, c, d, e, f, g, h, i, j, k] a
-> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> a
coerce Fun '[a, b, c, d, e, f, g, h, i, j, k] a
Fun (Elems (a, b, c, d, e, f, g, h, i, j, k)) a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l) = '[a,b,c,d,e,f,g,h,i,j,k,l]
  construct :: Fun
  (Elems (a, b, c, d, e, f, g, h, i, j, k, l))
  (a, b, c, d, e, f, g, h, i, j, k, l)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> (a, b, c, d, e, f, g, h, i, j, k, l))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l]
     (a, b, c, d, e, f, g, h, i, j, k, l)
coerce ((,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l
                                    -> (a,b,c,d,e,f,g,h,i,j,k,l))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l)
-> Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l)) a -> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l) Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l)) a
fun = Fun '[a, b, c, d, e, f, g, h, i, j, k, l] a
-> a -> b -> c -> d -> e -> f -> g -> h -> i -> j -> k -> l -> a
coerce Fun '[a, b, c, d, e, f, g, h, i, j, k, l] a
Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l)) a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m) = '[a,b,c,d,e,f,g,h,i,j,k,l,m]
  construct :: Fun
  (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m))
  (a, b, c, d, e, f, g, h, i, j, k, l, m)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m]
     (a, b, c, d, e, f, g, h, i, j, k, l, m)
coerce ((,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m
                                     -> (a,b,c,d,e,f,g,h,i,j,k,l,m))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m)
-> Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m)) a -> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m) Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m)) a
fun = Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m] a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> a
coerce Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m] a
Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m)) a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n]
  construct :: Fun
  (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n]
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
coerce ((,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n
                                      -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n)
-> Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n)) a -> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n) Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n)) a
fun
    = Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m, n] a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> a
coerce Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m, n] a
Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n)) a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o]
  construct :: Fun
  (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o]
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
coerce ((,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o
                                       -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)
-> Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)) a -> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o) Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)) a
fun
    = Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o] a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> a
coerce Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o] a
Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)) a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p]
  construct :: Fun
  (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p]
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
coerce ((,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p
                                        -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)
-> Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)) a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p) Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)) a
fun
    = Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p] a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> a
coerce Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p] a
Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)) a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q]
  construct :: Fun
  (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q]
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
coerce ((,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q
                                         -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)
-> Fun
     (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)) a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q) Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)) a
fun
    = Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q] a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> a
coerce Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q] a
Fun (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)) a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r]
  construct :: Fun
  (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r]
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
coerce ((,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r
                                          -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)
-> Fun
     (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)) a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r) Fun
  (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)) a
fun
    = Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r] a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> a
coerce Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r] a
Fun
  (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)) a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s]
  construct :: Fun
  (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s]
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
coerce ((,,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s
                                           -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)
-> Fun
     (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)) a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s) Fun
  (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)) a
fun
    = Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s] a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> a
coerce Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s] a
Fun
  (Elems (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)) a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t]
  construct :: Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t]
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
coerce ((,,,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t
                                            -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)
-> Fun
     (Elems
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
     a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s,t
t) Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
  a
fun
    = Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t] a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> a
coerce Fun '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t] a
Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t))
  a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s t
t
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u) =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u]
  construct :: Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> u
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u]
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u)
coerce ((,,,,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t->u
                                             -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u)
-> Fun
     (Elems
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u))
     a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s,t
t,u
u) Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u))
  a
fun
    = Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u] a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> u
-> a
coerce Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u] a
Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u))
  a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s t
t u
u
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v) =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v]
  construct :: Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> u
 -> v
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u,
     v))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v]
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v)
coerce ((,,,,,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t->u->v
                                              -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v)
-> Fun
     (Elems
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v))
     a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s,t
t,u
u,v
v) Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v))
  a
fun
    = Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v]
  a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> u
-> v
-> a
coerce Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v]
  a
Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v))
  a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s t
t u
u v
v
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w) =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w]
  construct :: Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
   w)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> u
 -> v
 -> w
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u,
     v, w))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
       w]
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w)
coerce ((,,,,,,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t->u->v->w
                                               -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
 w)
-> Fun
     (Elems
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
         w))
     a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s,t
t,u
u,v
v,w
w) Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w))
  a
fun
    = Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w]
  a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> u
-> v
-> w
-> a
coerce Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w]
  a
Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w))
  a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s t
t u
u v
v w
w
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x) =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x]
  construct :: Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
   w, x)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> u
 -> v
 -> w
 -> x
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u,
     v, w, x))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
       w, x]
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x)
coerce ((,,,,,,,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t->u->v->w->x
                                                -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
 w, x)
-> Fun
     (Elems
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
         w, x))
     a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s,t
t,u
u,v
v,w
w,x
x) Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x))
  a
fun
    = Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x]
  a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> u
-> v
-> w
-> x
-> a
coerce Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x]
  a
Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x))
  a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s t
t u
u v
v w
w x
x
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y) =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y]
  construct :: Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
   w, x, y)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> u
 -> v
 -> w
 -> x
 -> y
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u,
     v, w, x, y))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
       w, x, y]
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y)
coerce ((,,,,,,,,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t->u->v->w->x->y
                                                 -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
 w, x, y)
-> Fun
     (Elems
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
         w, x, y))
     a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s,t
t,u
u,v
v,w
w,x
x,y
y) Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y))
  a
fun
    = Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y]
  a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> u
-> v
-> w
-> x
-> y
-> a
coerce Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y]
  a
Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y))
  a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s t
t u
u v
v w
w x
x y
y
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z) =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z]
  construct :: Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
   w, x, y, z)
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> u
 -> v
 -> w
 -> x
 -> y
 -> z
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u,
     v, w, x, y, z))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
       w, x, y, z]
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z)
coerce ((,,,,,,,,,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t->u->v->w->x->y->z
                                                  -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
 w, x, y, z)
-> Fun
     (Elems
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
         w, x, y, z))
     a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s,t
t,u
u,v
v,w
w,x
x,y
y,z
z) Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z))
  a
fun
    = Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y, z]
  a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> u
-> v
-> w
-> x
-> y
-> z
-> a
coerce Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y, z]
  a
Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z))
  a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s t
t u
u v
v w
w x
x y
y z
z
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a') where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a') =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a']
  construct :: Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a'))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
   w, x, y, z, a')
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> u
 -> v
 -> w
 -> x
 -> y
 -> z
 -> a'
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u,
     v, w, x, y, z, a'))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
       w, x, y, z, a']
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a')
coerce ((,,,,,,,,,,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t->u->v->w->x->y->z->a'
                                                   -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a'))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
 w, x, y, z, a')
-> Fun
     (Elems
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
         w, x, y, z, a'))
     a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s,t
t,u
u,v
v,w
w,x
x,y
y,z
z,a'
a') Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a'))
  a
fun
    = Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y, z, a']
  a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> u
-> v
-> w
-> x
-> y
-> z
-> a'
-> a
coerce Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y, z, a']
  a
Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a'))
  a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s t
t u
u v
v w
w x
x y
y z
z a'
a'
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b') where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b') =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b']
  construct :: Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b'))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
   w, x, y, z, a', b')
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> u
 -> v
 -> w
 -> x
 -> y
 -> z
 -> a'
 -> b'
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u,
     v, w, x, y, z, a', b'))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
       w, x, y, z, a', b']
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b')
coerce ((,,,,,,,,,,,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t->u->v->w->x->y->z->a'->b'
                                                    -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b'))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
 w, x, y, z, a', b')
-> Fun
     (Elems
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
         w, x, y, z, a', b'))
     a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s,t
t,u
u,v
v,w
w,x
x,y
y,z
z,a'
a',b'
b') Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b'))
  a
fun
    = Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y, z, a', b']
  a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> u
-> v
-> w
-> x
-> y
-> z
-> a'
-> b'
-> a
coerce Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y, z, a', b']
  a
Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b'))
  a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s t
t u
u v
v w
w x
x y
y z
z a'
a' b'
b'
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c') where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c') =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c']
  construct :: Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c'))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
   w, x, y, z, a', b', c')
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> u
 -> v
 -> w
 -> x
 -> y
 -> z
 -> a'
 -> b'
 -> c'
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u,
     v, w, x, y, z, a', b', c'))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
       w, x, y, z, a', b', c']
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c')
coerce ((,,,,,,,,,,,,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t->u->v->w->x->y->z->a'->b'->c'
                                                     -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c'))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
 w, x, y, z, a', b', c')
-> Fun
     (Elems
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
         w, x, y, z, a', b', c'))
     a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s,t
t,u
u,v
v,w
w,x
x,y
y,z
z,a'
a',b'
b',c'
c') Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c'))
  a
fun
    = Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y, z, a', b', c']
  a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> u
-> v
-> w
-> x
-> y
-> z
-> a'
-> b'
-> c'
-> a
coerce Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y, z, a', b', c']
  a
Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c'))
  a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s t
t u
u v
v w
w x
x y
y z
z a'
a' b'
b' c'
c'
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c',d') where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c',d') =
    '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c',d']
  construct :: Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c', d'))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
   w, x, y, z, a', b', c', d')
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> u
 -> v
 -> w
 -> x
 -> y
 -> z
 -> a'
 -> b'
 -> c'
 -> d'
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u,
     v, w, x, y, z, a', b', c', d'))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
       w, x, y, z, a', b', c', d']
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c', d')
coerce ((,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t->u->v->w->x->y->z->a'->b'->c'->d'
                                                      -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c',d'))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
 w, x, y, z, a', b', c', d')
-> Fun
     (Elems
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
         w, x, y, z, a', b', c', d'))
     a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s,t
t,u
u,v
v,w
w,x
x,y
y,z
z,a'
a',b'
b',c'
c',d'
d') Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c', d'))
  a
fun
    = Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y, z, a', b', c', d']
  a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> u
-> v
-> w
-> x
-> y
-> z
-> a'
-> b'
-> c'
-> d'
-> a
coerce Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y, z, a', b', c', d']
  a
Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c', d'))
  a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s t
t u
u v
v w
w x
x y
y z
z a'
a' b'
b' c'
c' d'
d'
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c',d',e') where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c',d',e')
    = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c',d',e']
  construct :: Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c', d', e'))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
   w, x, y, z, a', b', c', d', e')
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> u
 -> v
 -> w
 -> x
 -> y
 -> z
 -> a'
 -> b'
 -> c'
 -> d'
 -> e'
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u,
     v, w, x, y, z, a', b', c', d', e'))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
       w, x, y, z, a', b', c', d', e']
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c', d', e')
coerce ((,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t->u->v->w->x->y->z->a'->b'->c'->d'->e'
                                                       -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c',d',e'))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
 w, x, y, z, a', b', c', d', e')
-> Fun
     (Elems
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
         w, x, y, z, a', b', c', d', e'))
     a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s,t
t,u
u,v
v,w
w,x
x,y
y,z
z,a'
a',b'
b',c'
c',d'
d',e'
e') Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c', d', e'))
  a
fun
    = Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y, z, a', b', c', d', e']
  a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> u
-> v
-> w
-> x
-> y
-> z
-> a'
-> b'
-> c'
-> d'
-> e'
-> a
coerce Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y, z, a', b', c', d', e']
  a
Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c', d', e'))
  a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s t
t u
u v
v w
w x
x y
y z
z a'
a' b'
b' c'
c' d'
d' e'
e'
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}

instance HVector (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c',d',e',f') where
  type Elems (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c',d',e',f')
    = '[a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c',d',e',f']
  construct :: Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c', d', e', f'))
  (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
   w, x, y, z, a', b', c', d', e', f')
construct = (a
 -> b
 -> c
 -> d
 -> e
 -> f
 -> g
 -> h
 -> i
 -> j
 -> k
 -> l
 -> m
 -> n
 -> o
 -> p
 -> q
 -> r
 -> s
 -> t
 -> u
 -> v
 -> w
 -> x
 -> y
 -> z
 -> a'
 -> b'
 -> c'
 -> d'
 -> e'
 -> f'
 -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u,
     v, w, x, y, z, a', b', c', d', e', f'))
-> Fun
     '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
       w, x, y, z, a', b', c', d', e', f']
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c', d', e', f')
coerce ((,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,) :: a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t->u->v->w->x->y->z->a'->b'->c'->d'->e'->f'
                                                        -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,a',b',c',d',e',f'))
  inspect :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
 w, x, y, z, a', b', c', d', e', f')
-> Fun
     (Elems
        (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
         w, x, y, z, a', b', c', d', e', f'))
     a
-> a
inspect (a
a,b
b,c
c,d
d,e
e,f
f,g
g,h
h,i
i,j
j,k
k,l
l,m
m,n
n,o
o,p
p,q
q,r
r,s
s,t
t,u
u,v
v,w
w,x
x,y
y,z
z,a'
a',b'
b',c'
c',d'
d',e'
e',f'
f') Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c', d', e', f'))
  a
fun
    = Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y, z, a', b', c', d', e', f']
  a
-> a
-> b
-> c
-> d
-> e
-> f
-> g
-> h
-> i
-> j
-> k
-> l
-> m
-> n
-> o
-> p
-> q
-> r
-> s
-> t
-> u
-> v
-> w
-> x
-> y
-> z
-> a'
-> b'
-> c'
-> d'
-> e'
-> f'
-> a
coerce Fun
  '[a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
    w, x, y, z, a', b', c', d', e', f']
  a
Fun
  (Elems
     (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t, u, v,
      w, x, y, z, a', b', c', d', e', f'))
  a
fun a
a b
b c
c d
d e
e f
f g
g h
h i
i j
j k
k l
l m
m n
n o
o p
p q
q r
r s
s t
t u
u v
v w
w x
x y
y z
z a'
a' b'
b' c'
c' d'
d' e'
e' f'
f'
  {-# INLINE construct #-}
  {-# INLINE inspect   #-}


-- | Copy of lens type definition from lens package
type Lens s t a b = forall f. Functor f => (a -> f b) -> s -> f t

-- | Copy of type preserving lens definition from lens package
type Lens' s a = Lens s s a a

----------------------------------------------------------------
-- Generics
----------------------------------------------------------------

class GHVector (v :: * -> *) where
  type GElems v :: [*]
  gconstruct :: Fun (GElems v) (v p)
  ginspect   :: v p -> Fun (GElems v) r -> r


-- We simply skip metadata
instance (GHVector f, Arity (GElems f)) => GHVector (M1 i c f) where
  type GElems (M1 i c f) = GElems f
  gconstruct :: Fun (GElems (M1 i c f)) (M1 i c f p)
gconstruct = (f p -> M1 i c f p)
-> TFun Identity (GElems f) (f p)
-> TFun Identity (GElems f) (M1 i c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f p -> M1 i c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 TFun Identity (GElems f) (f p)
forall (v :: * -> *) p. GHVector v => Fun (GElems v) (v p)
gconstruct
  ginspect :: M1 i c f p -> Fun (GElems (M1 i c f)) r -> r
ginspect M1 i c f p
v = f p -> Fun (GElems f) r -> r
forall (v :: * -> *) p r.
GHVector v =>
v p -> Fun (GElems v) r -> r
ginspect (M1 i c f p -> f p
forall i (c :: Meta) k (f :: k -> *) (p :: k). M1 i c f p -> f p
unM1 M1 i c f p
v)
  {-# INLINE gconstruct #-}
  {-# INLINE ginspect   #-}


instance ( GHVector f, GHVector g, Arity (GElems f), Arity (GElems g)
         ) => GHVector (f :*: g) where
  type GElems (f :*: g) = GElems f ++ GElems g
  gconstruct :: Fun (GElems (f :*: g)) ((:*:) f g p)
gconstruct = (f p -> g p -> (:*:) f g p)
-> Fun (GElems f) (f p)
-> Fun (GElems g) (g p)
-> Fun (GElems f ++ GElems g) ((:*:) f g p)
forall (xs :: [*]) (ys :: [*]) a b c.
(Arity xs, Arity ys) =>
(a -> b -> c) -> Fun xs a -> Fun ys b -> Fun (xs ++ ys) c
concatF f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) Fun (GElems f) (f p)
forall (v :: * -> *) p. GHVector v => Fun (GElems v) (v p)
gconstruct Fun (GElems g) (g p)
forall (v :: * -> *) p. GHVector v => Fun (GElems v) (v p)
gconstruct
  ginspect :: (:*:) f g p -> Fun (GElems (f :*: g)) r -> r
ginspect (f p
f :*: g p
g) Fun (GElems (f :*: g)) r
fun
    = g p -> Fun (GElems g) r -> r
forall (v :: * -> *) p r.
GHVector v =>
v p -> Fun (GElems v) r -> r
ginspect g p
g (Fun (GElems g) r -> r) -> Fun (GElems g) r -> r
forall a b. (a -> b) -> a -> b
$ f p -> Fun (GElems f) (Fun (GElems g) r) -> Fun (GElems g) r
forall (v :: * -> *) p r.
GHVector v =>
v p -> Fun (GElems v) r -> r
ginspect f p
f (Fun (GElems f) (Fun (GElems g) r) -> Fun (GElems g) r)
-> Fun (GElems f) (Fun (GElems g) r) -> Fun (GElems g) r
forall a b. (a -> b) -> a -> b
$ Fun (GElems f ++ GElems g) r -> Fun (GElems f) (Fun (GElems g) r)
forall (xs :: [*]) (ys :: [*]) r.
Arity xs =>
Fun (xs ++ ys) r -> Fun xs (Fun ys r)
curryMany Fun (GElems f ++ GElems g) r
Fun (GElems (f :*: g)) r
fun
  {-# INLINE gconstruct #-}
  {-# INLINE ginspect   #-}


instance ( TypeError ('Text "It's impossible to derive HVector for type without constructors")
         ) => GHVector V1 where
  type GElems V1 = TypeError ('Text "It's impossible to derive HVector for type without constructors")
  gconstruct :: Fun (GElems V1) (V1 p)
gconstruct = [Char] -> TFun Identity (TypeError ...) (V1 p)
forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable"
  ginspect :: V1 p -> Fun (GElems V1) r -> r
ginspect   = [Char] -> V1 p -> Fun (TypeError ...) r -> r
forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable"

instance ( TypeError ('Text "It's impossible to derive HVector for sum types")
         ) => GHVector (f :+: g) where
  type GElems (f :+: g) = TypeError ('Text "It's impossible to derive HVector for sum types")
  gconstruct :: Fun (GElems (f :+: g)) ((:+:) f g p)
gconstruct = [Char] -> TFun Identity (TypeError ...) ((:+:) f g p)
forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable"
  ginspect :: (:+:) f g p -> Fun (GElems (f :+: g)) r -> r
ginspect   = [Char] -> (:+:) f g p -> Fun (TypeError ...) r -> r
forall a. HasCallStack => [Char] -> a
error [Char]
"Unreachable"

-- Recursion is terminated by simple field
instance GHVector (K1 R x) where
  type GElems (K1 R x) = '[x]
  gconstruct :: Fun (GElems (K1 R x)) (K1 R x p)
gconstruct               = Fn Identity '[x] (K1 R x p) -> TFun Identity '[x] (K1 R x p)
forall α (f :: α -> *) (as :: [α]) b. Fn f as b -> TFun f as b
TFun (x -> K1 R x p
forall k i c (p :: k). c -> K1 i c p
K1 (x -> K1 R x p) -> (Identity x -> x) -> Identity x -> K1 R x p
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity x -> x
forall a. Identity a -> a
runIdentity)
  ginspect :: K1 R x p -> Fun (GElems (K1 R x)) r -> r
ginspect (K1 x
x) (TFun Fn Identity (GElems (K1 R x)) r
f) = Fn Identity (GElems (K1 R x)) r
Identity x -> r
f (x -> Identity x
forall a. a -> Identity a
Identity x
x)
  {-# INLINE gconstruct #-}
  {-# INLINE ginspect   #-}


-- Unit types are empty vectors
instance GHVector U1 where
  type GElems U1      = '[]
  gconstruct :: Fun (GElems U1) (U1 p)
gconstruct          = U1 Any -> Fun '[] (U1 p)
coerce U1 Any
forall k (p :: k). U1 p
U1
  ginspect :: U1 p -> Fun (GElems U1) r -> r
ginspect U1 p
_ (TFun Fn Identity (GElems U1) r
f) = r
Fn Identity (GElems U1) r
f
  {-# INLINE gconstruct #-}
  {-# INLINE ginspect   #-}