mgeneric-0.0.0.2: Generics with multiple parameters

Safe HaskellSafe-Inferred
LanguageHaskell2010

Data.MGeneric

Synopsis

Documentation

type family f :$: as :: * Source

Type level application

f :$: '[a, b, ...] ~ f a b ...

Equations

f :$: [] = f 
f :$: (a : as) = f a :$: as 

data Un s Source

Universe kind

The s parameter should always be *

Constructors

UV

Empty universe

UT

Trivial universe

UF (Field s)

Lifts from the field universe

(Un s) :**: (Un s)

Product universe

(Un s) :++: (Un s)

Sum universe

data Field s Source

Field kind

The s parameter should always be *

(FK a) can be replaced by (a :@: []), but the empty application case is often handled differently in generic type classes

Constructors

FK s

Constant field

FP Nat

Parameter field

forall k . k :@: [Field s]

Application field

Instances

AdaptFieldFunction n ([] (Field *)) ps 
(MZipWith k n f (ExpandFieldFunction n bs ps), (~) * (ZipInput n (ZipWithType' k n f (ExpandFieldFunction n bs ps))) (ZipWithType k n f (ExpandFieldFunction n bs ps)), AdaptFieldFunction n bs ps, AdaptFieldFunction n as ps) => AdaptFieldFunction n ((:) (Field *) ((:@:) * k f bs) as) ps 
(HLookup m (ZipInputs n ps), (~) * (ZipInput n ((:!:) * ps m)) ((:!:) * (ZipInputs n ps) m), AdaptFieldFunction n as ps) => AdaptFieldFunction n ((:) (Field *) (FP * m) as) ps 
AdaptFieldMonoid ([] (Field *)) fs 
AdaptFieldFunction ([] (Field *)) fs t 
AdaptFieldFunction ([] (Field *)) ([] Variance) ps vs 
(MFoldable k f (ExpandFields bs fs), AdaptFieldMonoid bs fs, AdaptFieldMonoid as fs) => AdaptFieldMonoid ((:) (Field *) ((:@:) * k f bs) as) fs 
(GFPMFoldable n fs, AdaptFieldMonoid as fs) => AdaptFieldMonoid ((:) (Field *) (FP * n) as) fs 
AdaptFieldMonoid as fs => AdaptFieldMonoid ((:) (Field *) (FK * a) as) fs 
(MTraversable k f (ExpandFieldFunction bs fs) t, (~) * ((:$:) k f (ExpandFields bs (Codomains fs))) ((:$:) k f (Codomains (ExpandFieldFunction bs fs))), (~) * ((:$:) k f (ExpandFields bs (Domains fs))) ((:$:) k f (Domains (ExpandFieldFunction bs fs))), AdaptFieldFunction bs fs t, AdaptFieldFunction as fs t) => AdaptFieldFunction ((:) (Field *) ((:@:) * k f bs) as) fs t 
(GFPMTraversable n fs t, AdaptFieldFunction as fs t, (~) [*] (AppMap ((:) * ((:!:) * fs n) (ExpandFieldFunction as fs)) t) ((:) * ((:!:) * (Domains fs) n -> t ((:!:) * (Codomains fs) n)) (AppMap (ExpandFieldFunction as fs) t))) => AdaptFieldFunction ((:) (Field *) (FP * n) as) fs t 
AdaptFieldFunction as fs t => AdaptFieldFunction ((:) (Field *) (FK * a) as) fs t 
(MFunctor k f (ExpandFieldFunction bs (FlipVariance vs') ps vs) vs', (~) [*] (ExpandFields bs (Domains ps vs)) (Codomains (ExpandFieldFunction bs (FlipVariance vs') ps vs) vs'), (~) [*] (ExpandFields bs (Codomains ps vs)) (Domains (ExpandFieldFunction bs (FlipVariance vs') ps vs) vs'), AdaptFieldFunction bs (FlipVariance vs') ps vs, AdaptFieldFunction as vfs ps vs) => AdaptFieldFunction ((:) (Field *) ((:@:) * k f bs) as) ((:) Variance ContraV vfs) ps vs 
(MFunctor k f (ExpandFieldFunction bs vs' ps vs) vs', (~) [*] (ExpandFields bs (Codomains ps vs)) (Codomains (ExpandFieldFunction bs vs' ps vs) vs'), (~) [*] (ExpandFields bs (Domains ps vs)) (Domains (ExpandFieldFunction bs vs' ps vs) vs'), AdaptFieldFunction bs vs' ps vs, AdaptFieldFunction as vfs ps vs) => AdaptFieldFunction ((:) (Field *) ((:@:) * k f bs) as) ((:) Variance CoV vfs) ps vs 
(GFPMFunctor [Variance] n ps vs, AdaptFieldFunction as vfs ps vs, (~) * (Flip ((:!:) * ps n)) ((:!:) * (Domains ps vs) n -> (:!:) * (Codomains ps vs) n)) => AdaptFieldFunction ((:) (Field *) (FP * n) as) ((:) Variance ContraV vfs) ps vs 
(GFPMFunctor [Variance] n ps vs, AdaptFieldFunction as vfs ps vs, (~) * ((:!:) * ps n) ((:!:) * (Domains ps vs) n -> (:!:) * (Codomains ps vs) n)) => AdaptFieldFunction ((:) (Field *) (FP * n) as) ((:) Variance CoV vfs) ps vs 
AdaptFieldFunction as vfs ps vs => AdaptFieldFunction ((:) (Field *) (FK * a) as) ((:) Variance v vfs) ps vs 

data In u ps :: * where Source

Universe u inhabitation with parameters ps

Constructors

InT :: In UT ps 
InF :: InField f ps -> In (UF f) ps 
InL :: In u ps -> In (u :++: v) ps 
InR :: In v ps -> In (u :++: v) ps 
(:*:) :: In u ps -> In v ps -> In (u :**: v) ps infixr 5 

data InField f ps :: * where Source

Field f inhabitation with parameters ps

Constructors

InK :: a -> InField (FK a) ps 
InP :: (ps :!: n) -> InField (FP n) ps 
InA :: (f :$: ExpandFields as ps) -> InField (f :@: as) ps 

type family ExpandField f ps :: * Source

Equations

ExpandField (FK a) ps = a 
ExpandField (FP n) ps = ps :!: n 
ExpandField (f :@: as) ps = f :$: ExpandFields as ps 

type family ExpandFields f ps :: [*] Source

Equations

ExpandFields [] ps = [] 
ExpandFields (FK a : fs) ps = a : ExpandFields fs ps 
ExpandFields (FP n : fs) ps = (ps :!: n) : ExpandFields fs ps 
ExpandFields ((f :@: as) : fs) ps = (f :$: ExpandFields as ps) : ExpandFields fs ps 

class MGeneric a where Source

Representable types with parameters

Associated Types

type Rep a :: Un * Source

Representation of a

type Pars a :: [*] Source

Parameters of a

Methods

from :: a -> In (Rep a) (Pars a) Source

Convert from the datatype to its representation

to :: In (Rep a) (Pars a) -> a Source

Convert to the datatype from its representation

Instances

MGeneric Bool 
MGeneric Ordering 
MGeneric () 
MGeneric [a] 
MGeneric (Endo a) 
MGeneric (Sum a) 
MGeneric (Product a) 
MGeneric (First a) 
MGeneric (Last a) 
MGeneric (Maybe a) 
MGeneric (Identity a) 
MGeneric (Either a b) 
MGeneric (a, b) 
MGeneric (Const a b) 
MGeneric (a, b, c) 
MGeneric (a, b, c, d) 
MGeneric (a, b, c, d, e) 
MGeneric (a, b, c, d, e, f) 
MGeneric (a, b, c, d, e, f, g) 
MGeneric (a, b, c, d, e, f, g, h) 
MGeneric (a, b, c, d, e, f, g, h, i)