module Data.Vector.HFixed.Class (
Fn
, Fun
, TFun(..)
, Proxy(..)
, type (++)
, Len
, HomList
, Arity(..)
, ArityC(..)
, HVector(..)
, tupleSize
, HVectorF(..)
, tupleSizeF
, ContVec
, ContVecF(..)
, cons
, consF
, HomArity(..)
, homInspect
, homConstruct
, curryFun
, uncurryFun
, uncurryMany
, curryMany
, constFun
, constTFun
, curryTFun
, uncurryTFun
, shuffleTF
, stepTFun
, concatF
, lensWorkerF
, lensWorkerTF
, Index(..)
) where
import Control.Applicative (Applicative(..),(<$>))
import Data.Coerce
import Data.Complex (Complex(..))
import Data.Typeable (Proxy(..))
import Data.Functor.Identity (Identity(..))
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.TypeLits
import GHC.Generics hiding (S)
import Data.Vector.HFixed.TypeFuns
type family Fn (f :: * -> *) (as :: [*]) b where
Fn f '[] b = b
Fn f (a : as) b = f a -> Fn f as b
newtype TFun f as b = TFun { unTFun :: Fn f as b }
type Fun = TFun Identity
class Arity (xs :: [*]) where
accum :: (forall a as. t (a : as) -> f a -> t as)
-> (t '[] -> b)
-> t xs
-> TFun f xs b
apply :: (forall a as. t (a : as) -> (f a, t as))
-> t xs
-> ContVecF xs f
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)
-> (t '[] -> b)
-> t xs
-> TFun f xs b
applyC :: proxy c
-> (forall a as. (c a) => t (a : as) -> (f a, t as))
-> t xs
-> ContVecF xs f
instance Arity '[] where
accum _ f t = TFun (f t)
apply _ _ = ContVecF unTFun
arity _ = 0
instance Arity xs => Arity (x : xs) where
accum f g t = uncurryTFun (\a -> accum f g (f t a))
apply f t = case f t of (a,u) -> consF a (apply f u)
arity _ = 1 + arity (Proxy :: Proxy xs)
instance ArityC c '[] where
accumC _ _ f t = TFun (f t)
applyC _ _ _ = ContVecF unTFun
instance (c x, ArityC c xs) => ArityC c (x : xs) where
accumC w f g t = uncurryTFun (\a -> accumC w f g (f t a))
applyC w f t = case f t of (a,u) -> consF a (applyC w f u)
class Arity (Elems v) => HVector v where
type Elems v :: [*]
type Elems v = GElems (Rep v)
construct :: Fun (Elems v) v
default construct :: (Generic v, GHVector (Rep v), GElems (Rep v) ~ Elems v)
=> Fun (Elems v) v
construct = fmap to gconstruct
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 = ginspect (from v)
tupleSize :: forall v proxy. HVector v => proxy v -> Int
tupleSize _ = arity (Proxy :: Proxy (Elems v))
class Arity (ElemsF v) => HVectorF (v :: (* -> *) -> *) where
type ElemsF v :: [*]
inspectF :: v f -> TFun f (ElemsF v) a -> a
constructF :: TFun f (ElemsF v) (v f)
tupleSizeF :: forall v f proxy. HVectorF v => proxy (v f) -> Int
tupleSizeF _a = arity (Proxy :: Proxy (ElemsF v))
class (ArityPeano n, Arity (HomList n a)) => HomArity n a where
toHeterogeneous :: F.Fun n a r -> Fun (HomList n a) r
toHomogeneous :: Fun (HomList n a) r -> F.Fun n a r
instance HomArity 'Z a where
toHeterogeneous = coerce
toHomogeneous = coerce
instance HomArity n a => HomArity ('S n) a where
toHeterogeneous f
= coerce $ \a -> unTFun $ toHeterogeneous (F.curryFirst f a)
toHomogeneous (f :: Fun (a : HomList n a) r)
= coerce $ \a -> (toHomogeneous $ curryFun f a :: F.Fun n a r)
homInspect :: (F.Vector v a, HomArity (Peano (F.Dim v)) a)
=> v a -> Fun (HomList (Peano (F.Dim v)) a) r -> r
homInspect v f = F.inspect v (toHomogeneous f)
homConstruct :: forall v a.
(F.Vector v a, HomArity (Peano (F.Dim v)) a)
=> Fun (HomList (Peano (F.Dim v)) a) (v a)
homConstruct = toHeterogeneous (F.construct :: F.Fun (Peano (F.Dim v)) a (v a))
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 = homInspect
construct = homConstruct
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 = homInspect
construct = homConstruct
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 = homInspect
construct = homConstruct
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 = homInspect
construct = homConstruct
instance Arity xs => HVector (ContVecF xs Identity) where
type Elems (ContVecF xs Identity) = xs
construct = accum
(\(T_mkN f) (Identity x) -> T_mkN (f . cons x))
(\(T_mkN f) -> f (ContVecF unTFun))
(T_mkN id)
inspect (ContVecF cont) f = cont f
newtype T_mkN all xs = T_mkN (ContVec xs -> ContVec all)
type ContVec xs = ContVecF xs Identity
newtype ContVecF xs f = ContVecF { runContVecF :: forall r. TFun f xs r -> r }
instance Arity xs => HVectorF (ContVecF xs) where
type ElemsF (ContVecF xs) = xs
inspectF (ContVecF cont) = cont
constructF = constructFF
constructFF :: forall f xs. (Arity xs) => TFun f xs (ContVecF xs f)
constructFF = accum (\(TF_mkN f) x -> TF_mkN (f . consF x))
(\(TF_mkN f) -> f $ ContVecF unTFun)
(TF_mkN id)
newtype TF_mkN f all xs = TF_mkN (ContVecF xs f -> ContVecF all f)
cons :: x -> ContVec xs -> ContVec (x : xs)
cons x (ContVecF cont) = ContVecF $ \f -> cont $ curryFun f x
consF :: f x -> ContVecF xs f -> ContVecF (x : xs) f
consF x (ContVecF cont) = ContVecF $ \f -> cont $ curryTFun f x
instance (Arity xs) => Functor (TFun f xs) where
fmap f (TFun g0)
= accum (\(TF_fmap g) a -> TF_fmap (g a))
(\(TF_fmap r) -> f r)
(TF_fmap g0)
instance (Arity xs) => Applicative (TFun f xs) where
pure r = accum (\Proxy _ -> Proxy)
(\Proxy -> r)
(Proxy)
(TFun f0 :: TFun f xs (a -> b)) <*> (TFun g0 :: TFun f xs a)
= accum (\(TF_ap f g) a -> TF_ap (f a) (g a))
(\(TF_ap f g) -> f g)
( TF_ap f0 g0 :: TF_ap f (a -> b) a xs)
instance Arity xs => Monad (TFun f xs) where
return = pure
f >>= g = shuffleTF g <*> f
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)
curryFun :: Fun (x : xs) r -> x -> Fun xs r
curryFun = coerce
uncurryFun :: (x -> Fun xs r) -> Fun (x : xs) r
uncurryFun = coerce
uncurryMany :: forall xs ys r. Arity xs => Fun xs (Fun ys r) -> Fun (xs ++ ys) r
uncurryMany = unsafeCoerce
curryMany :: forall xs ys r. Arity xs => Fun (xs ++ ys) r -> Fun xs (Fun ys r)
curryMany = unsafeCoerce
constFun :: Fun xs r -> Fun (x : xs) r
constFun = uncurryFun . const
constTFun :: TFun f xs r -> TFun f (x : xs) r
constTFun = uncurryTFun . const
stepTFun :: (TFun f xs a -> TFun f ys b)
-> (TFun f (x : xs) a -> TFun f (x : ys) b)
stepTFun g = uncurryTFun . fmap g . curryTFun
concatF :: (Arity xs, Arity ys)
=> (a -> b -> c) -> Fun xs a -> Fun ys b -> Fun (xs ++ ys) c
concatF f funA funB = uncurryMany $ fmap go funA
where
go a = fmap (\b -> f a b) funB
lensWorkerF :: forall f r x y xs. (Functor f, Arity xs)
=> (x -> f y) -> Fun (y : xs) r -> Fun (x : xs) (f r)
lensWorkerF g f
= uncurryFun
$ \x -> (\r -> fmap (r $) (g x)) <$> shuffleTF (curryFun f)
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)
lensWorkerTF g f
= uncurryTFun
$ \x -> (\r -> fmap (r $) (g x)) <$> shuffleTF (curryTFun f)
curryTFun :: TFun f (x : xs) r -> f x -> TFun f xs r
curryTFun = coerce
uncurryTFun :: (f x -> TFun f xs r) -> TFun f (x : xs) r
uncurryTFun = coerce
shuffleTF :: forall f x xs r. Arity xs
=> (x -> TFun f xs r) -> TFun f xs (x -> r)
shuffleTF fun0 = accum
(\(TF_shuffle f) a -> TF_shuffle (\x -> f x a))
(\(TF_shuffle f) -> f)
(TF_shuffle (fmap unTFun fun0))
data TF_shuffle f x r xs = TF_shuffle (x -> Fn f xs r)
class ArityPeano n => Index (n :: PeanoNum) (xs :: [*]) where
type ValueAt n xs :: *
type NewElems n xs a :: [*]
getF :: proxy n -> Fun xs (ValueAt n xs)
putF :: proxy n -> ValueAt n xs -> Fun xs r -> Fun xs r
lensF :: (Functor f, v ~ ValueAt n xs)
=> proxy n -> (v -> f v) -> Fun xs r -> Fun xs (f r)
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 _ = TFun $ \(Identity x) -> unTFun (pure x :: Fun xs x)
putF _ x f = constFun $ curryFun f x
lensF _ = lensWorkerF
lensChF _ = lensWorkerF
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 _ = constFun $ getF (Proxy @ n)
putF _ x = stepTFun $ putF (Proxy @ n) x
lensF _ f = stepTFun $ lensF (Proxy @ n) f
lensChF _ f = stepTFun $ lensChF (Proxy @ n) f
instance HVector () where
type Elems () = '[]
construct = TFun ()
inspect () (TFun f) = f
instance HVector (Complex a) where
type Elems (Complex a) = '[a,a]
construct = TFun $ \(Identity r) (Identity i) -> (:+) r i
inspect (r :+ i) f = coerce f r i
instance HVector (a,b) where
type Elems (a,b) = '[a,b]
construct = coerce ((,) :: a->b -> (a,b))
inspect (a,b) f = coerce f a b
instance HVector (a,b,c) where
type Elems (a,b,c) = '[a,b,c]
construct = coerce ((,,) :: a->b->c -> (a,b,c))
inspect (a,b,c) f = coerce f a b c
instance HVector (a,b,c,d) where
type Elems (a,b,c,d) = '[a,b,c,d]
construct = coerce ((,,,) :: a->b->c->d -> (a,b,c,d))
inspect (a,b,c,d) f = coerce f a b c d
instance HVector (a,b,c,d,e) where
type Elems (a,b,c,d,e) = '[a,b,c,d,e]
construct = coerce ((,,,,) :: a->b->c->d->e -> (a,b,c,d,e))
inspect (a,b,c,d,e) f = coerce f a b c d e
instance HVector (a,b,c,d,e,f) where
type Elems (a,b,c,d,e,f) = '[a,b,c,d,e,f]
construct = coerce ((,,,,,) :: a->b->c->d->e->f
-> (a,b,c,d,e,f))
inspect (a,b,c,d,e,f) fun = coerce fun a b c d e f
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 = coerce ((,,,,,,) :: a->b->c->d->e->f->g
-> (a,b,c,d,e,f,g))
inspect (a,b,c,d,e,f,g) fun = coerce fun a b c d e f g
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 = 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 = coerce fun a b c d e f g h
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 = 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 = coerce fun a b c d e f g h i
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 = 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 = coerce fun a b c d e f g h i j
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 = 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 = coerce fun a b c d e f g h i j k
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 = 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 = coerce fun a b c d e f g h i j k l
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 = 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 = coerce fun a b c d e f g h i j k l m
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 = 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
= coerce fun a b c d e f g h i j k l m n
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 = 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
= coerce fun a b c d e f g h i j k l m n o
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 = 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
= coerce fun a b c d e f g h i j k l m n o p
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 = 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
= coerce fun a b c d e f g h i j k l m n o p q
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 = 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
= coerce fun a b c d e f g h i j k l m n o p q r
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 = 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
= coerce fun a b c d e f g h i j k l m n o p q r s
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 = 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
= coerce fun a b c d e f g h i j k l m n o p q r s t
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 = 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
= coerce fun a b c d e f g h i j k l m n o p q r s t u
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 = 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
= coerce fun a b c d e f g h i j k l m n o p q r s t u v
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 = 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
= 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
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 = 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
= 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
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 = 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
= 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
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 = 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
= 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
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 = 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
= 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'
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 = 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
= 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'
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 = 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
= 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'
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 = 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
= 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'
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 = 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
= 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'
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 = 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
= 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'
class GHVector (v :: * -> *) where
type GElems v :: [*]
gconstruct :: Fun (GElems v) (v p)
ginspect :: v p -> Fun (GElems v) r -> r
instance (GHVector f, Arity (GElems f)) => GHVector (M1 i c f) where
type GElems (M1 i c f) = GElems f
gconstruct = fmap M1 gconstruct
ginspect v = ginspect (unM1 v)
instance ( GHVector f, GHVector g, Arity (GElems f), Arity (GElems g)
) => GHVector (f :*: g) where
type GElems (f :*: g) = GElems f ++ GElems g
gconstruct = concatF (:*:) gconstruct gconstruct
ginspect (f :*: g) fun
= ginspect g $ ginspect f $ curryMany fun
instance GHVector (K1 R x) where
type GElems (K1 R x) = '[x]
gconstruct = TFun (K1 . runIdentity)
ginspect (K1 x) (TFun f) = f (Identity x)
instance GHVector U1 where
type GElems U1 = '[]
gconstruct = coerce U1
ginspect _ (TFun f) = f