generics-sop-0.3.1.0: Generic Programming using True Sums of Products

Safe HaskellNone
LanguageHaskell2010

Generics.SOP.Type.Metadata

Contents

Description

Type-level metadata

This module provides datatypes (to be used promoted) that can represent the metadata of Haskell datatypes on the type level.

We do not reuse the term-level metadata types, because these are GADTs that incorporate additional invariants. We could (at least in GHC 8) impose the same invariants on the type level as well, but some tests have revealed that the resulting type are rather inconvenient to work with.

So we use simple datatypes to represent the type-level metadata, even if this means that some invariants are not explicitly captured.

We establish a relation between the term- and type-level versions of the metadata by automatically computing the term-level version from the type-level version.

As we now have two versions of metadata (term-level and type-level) with very similar, yet slightly different datatype definitions, the names between the modules clash, and this module is recommended to be imported qualified when needed.

The interface exported by this module is still somewhat experimental.

Since: 0.3.0.0

Synopsis

Documentation

data DatatypeInfo #

Metadata for a datatype (to be used promoted).

A type of kind DatatypeInfo contains meta-information about a datatype that is not contained in its code. This information consists primarily of the names of the datatype, its constructors, and possibly its record selectors.

The constructor indicates whether the datatype has been declared using newtype or not.

Since: 0.3.0.0

data ConstructorInfo #

Metadata for a single constructors (to be used promoted).

Since: 0.3.0.0

Constructors

Constructor ConstructorName

Normal constructor

Infix ConstructorName Associativity Fixity

Infix constructor

Record ConstructorName [FieldInfo]

Record constructor

Instances

DemoteConstructorInfos ([] ConstructorInfo) ([] [*]) # 
(DemoteConstructorInfo c xs, DemoteConstructorInfos cs xss) => DemoteConstructorInfos ((:) ConstructorInfo c cs) ((:) [*] xs xss) # 

Methods

demoteConstructorInfos :: proxy ((ConstructorInfo ': c) cs) -> NP [*] ConstructorInfo (([*] ': xs) xss) #

data FieldInfo #

Metadata for a single record field (to be used promoted).

Since: 0.3.0.0

Constructors

FieldInfo FieldName 

Instances

DemoteFieldInfos ([] FieldInfo) ([] *) # 

Methods

demoteFieldInfos :: proxy [FieldInfo] -> NP * FieldInfo [*] #

(DemoteFieldInfo f x, DemoteFieldInfos fs xs) => DemoteFieldInfos ((:) FieldInfo f fs) ((:) * x xs) # 

Methods

demoteFieldInfos :: proxy ((FieldInfo ': f) fs) -> NP * FieldInfo ((* ': x) xs) #

type DatatypeName = Symbol #

The name of a datatype.

type ModuleName = Symbol #

The name of a module.

type ConstructorName = Symbol #

The name of a data constructor.

type FieldName = Symbol #

The name of a field / record selector.

type Fixity = Nat #

The fixity of an infix constructor.

class DemoteDatatypeInfo x xss where #

Class for computing term-level datatype information from type-level datatype information.

Since: 0.3.0.0

Minimal complete definition

demoteDatatypeInfo

Methods

demoteDatatypeInfo :: proxy x -> DatatypeInfo xss #

Given a proxy of some type-level datatype information, return the corresponding term-level information.

Since: 0.3.0.0

Instances

(KnownSymbol m, KnownSymbol d, DemoteConstructorInfos cs xss) => DemoteDatatypeInfo (ADT m d cs) xss # 

Methods

demoteDatatypeInfo :: proxy (ADT m d cs) -> DatatypeInfo xss #

(KnownSymbol m, KnownSymbol d, DemoteConstructorInfo c ((:) * x ([] *))) => DemoteDatatypeInfo (Newtype m d c) ((:) [*] ((:) * x ([] *)) ([] [*])) # 

Methods

demoteDatatypeInfo :: proxy (Newtype m d c) -> DatatypeInfo (([*] ': (* ': x) [*]) [[*]]) #

class DemoteConstructorInfos cs xss where #

Class for computing term-level constructor information from type-level constructor information.

Since: 0.3.0.0

Minimal complete definition

demoteConstructorInfos

Methods

demoteConstructorInfos :: proxy cs -> NP ConstructorInfo xss #

Given a proxy of some type-level constructor information, return the corresponding term-level information as a product.

Since: 0.3.0.0

Instances

DemoteConstructorInfos ([] ConstructorInfo) ([] [*]) # 
(DemoteConstructorInfo c xs, DemoteConstructorInfos cs xss) => DemoteConstructorInfos ((:) ConstructorInfo c cs) ((:) [*] xs xss) # 

Methods

demoteConstructorInfos :: proxy ((ConstructorInfo ': c) cs) -> NP [*] ConstructorInfo (([*] ': xs) xss) #

class DemoteConstructorInfo x xs where #

Class for computing term-level constructor information from type-level constructor information.

Since: 0.3.0.0

Minimal complete definition

demoteConstructorInfo

Methods

demoteConstructorInfo :: proxy x -> ConstructorInfo xs #

Given a proxy of some type-level constructor information, return the corresponding term-level information.

Since: 0.3.0.0

Instances

(KnownSymbol s, SListI * xs) => DemoteConstructorInfo (Constructor s) xs # 
(KnownSymbol s, DemoteFieldInfos fs xs) => DemoteConstructorInfo (Record s fs) xs # 

Methods

demoteConstructorInfo :: proxy (Record s fs) -> ConstructorInfo xs #

(KnownSymbol s, DemoteAssociativity a, KnownNat f) => DemoteConstructorInfo (Infix s a f) ((:) * y ((:) * z ([] *))) # 

Methods

demoteConstructorInfo :: proxy (Infix s a f) -> ConstructorInfo ((* ': y) ((* ': z) [*])) #

class SListI xs => DemoteFieldInfos fs xs where #

Class for computing term-level field information from type-level field information.

Since: 0.3.0.0

Minimal complete definition

demoteFieldInfos

Methods

demoteFieldInfos :: proxy fs -> NP FieldInfo xs #

Given a proxy of some type-level field information, return the corresponding term-level information as a product.

Since: 0.3.0.0

Instances

DemoteFieldInfos ([] FieldInfo) ([] *) # 

Methods

demoteFieldInfos :: proxy [FieldInfo] -> NP * FieldInfo [*] #

(DemoteFieldInfo f x, DemoteFieldInfos fs xs) => DemoteFieldInfos ((:) FieldInfo f fs) ((:) * x xs) # 

Methods

demoteFieldInfos :: proxy ((FieldInfo ': f) fs) -> NP * FieldInfo ((* ': x) xs) #

class DemoteFieldInfo x a where #

Class for computing term-level field information from type-level field information.

Since: 0.3.0.0

Minimal complete definition

demoteFieldInfo

Methods

demoteFieldInfo :: proxy x -> FieldInfo a #

Given a proxy of some type-level field information, return the corresponding term-level information.

Since: 0.3.0.0

Instances

class DemoteAssociativity a where #

Class for computing term-level associativity information from type-level associativity information.

Since: 0.3.0.0

Minimal complete definition

demoteAssociativity

Methods

demoteAssociativity :: proxy a -> Associativity #

Given a proxy of some type-level associativity information, return the corresponding term-level information.

Since: 0.3.0.0

re-exports

data Associativity :: * #

Datatype to represent the associativity of a constructor

Instances

Bounded Associativity 
Enum Associativity 
Eq Associativity 
Data Associativity 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Associativity -> c Associativity #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Associativity #

toConstr :: Associativity -> Constr #

dataTypeOf :: Associativity -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Associativity) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Associativity) #

gmapT :: (forall b. Data b => b -> b) -> Associativity -> Associativity #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Associativity -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Associativity -> r #

gmapQ :: (forall d. Data d => d -> u) -> Associativity -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Associativity -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Associativity -> m Associativity #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Associativity -> m Associativity #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Associativity -> m Associativity #

Ord Associativity 
Read Associativity 
Show Associativity 
Ix Associativity 
Generic Associativity 

Associated Types

type Rep Associativity :: * -> * #

SingI Associativity LeftAssociative 

Methods

sing :: Sing LeftAssociative a

SingI Associativity RightAssociative 

Methods

sing :: Sing RightAssociative a

SingI Associativity NotAssociative 

Methods

sing :: Sing NotAssociative a

SingKind Associativity (KProxy Associativity) 

Associated Types

type DemoteRep (KProxy Associativity) (kparam :: KProxy (KProxy Associativity)) :: *

Methods

fromSing :: Sing (KProxy Associativity) a -> DemoteRep (KProxy Associativity) kparam

type Rep Associativity 
type Rep Associativity = D1 (MetaData "Associativity" "GHC.Generics" "base" False) ((:+:) (C1 (MetaCons "LeftAssociative" PrefixI False) U1) ((:+:) (C1 (MetaCons "RightAssociative" PrefixI False) U1) (C1 (MetaCons "NotAssociative" PrefixI False) U1)))
data Sing Associativity 
type DemoteRep Associativity (KProxy Associativity)