generic-override-0.0.0.0: Provides functionality for overriding instances for generic derivation

Safe HaskellNone
LanguageHaskell2010

Data.Override.Internal

Synopsis

Documentation

newtype Override a (xs :: [*]) Source #

The feature of this library. For use with DerivingVia. Apply it to a type a and supply a type-level list of instance overrides xs.

Constructors

Override a 
Instances
Eq a => Eq (Override a xs) Source # 
Instance details

Defined in Data.Override.Internal

Methods

(==) :: Override a xs -> Override a xs -> Bool #

(/=) :: Override a xs -> Override a xs -> Bool #

Show a => Show (Override a xs) Source # 
Instance details

Defined in Data.Override.Internal

Methods

showsPrec :: Int -> Override a xs -> ShowS #

show :: Override a xs -> String #

showList :: [Override a xs] -> ShowS #

(Generic a, GOverride xs (Rep a)) => Generic (Override a xs) Source # 
Instance details

Defined in Data.Override.Internal

Associated Types

type Rep (Override a xs) :: Type -> Type #

Methods

from :: Override a xs -> Rep (Override a xs) x #

to :: Rep (Override a xs) x -> Override a xs #

type Rep (Override a xs) Source # 
Instance details

Defined in Data.Override.Internal

type Rep (Override a xs) = OverrideRep xs (Rep a)

unOverride :: Override a xs -> a Source #

Unwrap an Override value.

override :: a -> proxy xs -> Override a xs Source #

Construct an Override using a proxy of overrides.

data As (o :: k) n Source #

Used to construct a type-level override. Usually used infix. The o should be either a type (kind *) or a type-level string (kind Symbol).

newtype Overridden (ms :: Maybe Symbol) a (xs :: [*]) Source #

Used at the leaf nodes of a generic Rep

Constructors

Overridden a 

unOverridden :: Overridden ms a xs -> a Source #

Unwrap an Overridden value.

overridden :: forall a (ms :: Maybe Symbol) (xs :: [*]) proxy0 proxy1. a -> proxy0 ms -> proxy1 xs -> Overridden ms a xs Source #

Same as override but for Overridden types.

class GOverride (xs :: [*]) (f :: * -> *) where Source #

Type class used to build the Generic instance for Override.

Associated Types

type OverrideRep xs f :: * -> * Source #

Analogous to Rep; rewrites the type for a given Rep and injects Overridden at the leaves.

Methods

overrideFrom :: f x -> OverrideRep xs f x Source #

overrideTo :: OverrideRep xs f x -> f x Source #

Instances
(GOverride xs f, GOverride xs g) => GOverride xs (f :*: g) Source # 
Instance details

Defined in Data.Override.Internal

Associated Types

type OverrideRep xs (f :*: g) :: Type -> Type Source #

Methods

overrideFrom :: (f :*: g) x -> OverrideRep xs (f :*: g) x Source #

overrideTo :: OverrideRep xs (f :*: g) x -> (f :*: g) x Source #

GOverride xs (M1 S (MetaSel ms su ss ds) (K1 R c :: Type -> Type)) Source # 
Instance details

Defined in Data.Override.Internal

Associated Types

type OverrideRep xs (M1 S (MetaSel ms su ss ds) (K1 R c)) :: Type -> Type Source #

Methods

overrideFrom :: M1 S (MetaSel ms su ss ds) (K1 R c) x -> OverrideRep xs (M1 S (MetaSel ms su ss ds) (K1 R c)) x Source #

overrideTo :: OverrideRep xs (M1 S (MetaSel ms su ss ds) (K1 R c)) x -> M1 S (MetaSel ms su ss ds) (K1 R c) x Source #

GOverride xs f => GOverride xs (M1 C c f) Source # 
Instance details

Defined in Data.Override.Internal

Associated Types

type OverrideRep xs (M1 C c f) :: Type -> Type Source #

Methods

overrideFrom :: M1 C c f x -> OverrideRep xs (M1 C c f) x Source #

overrideTo :: OverrideRep xs (M1 C c f) x -> M1 C c f x Source #

GOverride xs f => GOverride xs (M1 D c f) Source # 
Instance details

Defined in Data.Override.Internal

Associated Types

type OverrideRep xs (M1 D c f) :: Type -> Type Source #

Methods

overrideFrom :: M1 D c f x -> OverrideRep xs (M1 D c f) x Source #

overrideTo :: OverrideRep xs (M1 D c f) x -> M1 D c f x Source #

type family Using (ms :: Maybe Symbol) (x :: *) (xs :: [*]) where ... Source #

Type family used to determine which override from xs to replace x with, if any. The ms holds the field name for x, if applicable.

Equations

Using ms x '[] = x 
Using ms x (As (o :: Symbol) n ': xs) = If (ms == Just o) n (Using ms x xs) 
Using ms x (As (o :: *) n ': xs) = If (x == o) n (Using ms x xs)