multiwalk-0.3.0.1: Traverse data types via generics, acting on multiple types simultaneously.
Safe HaskellSafe-Inferred
LanguageHaskell2010

Control.MultiWalk.HasSub

Description

This module is the heart of multiwalk, providing generic instances for modifying and querying data types.

Documentation

class HasSub ctag tag (ls :: Spec) t where Source #

Methods

modSub :: forall c m. (Applicative m, AllMods c ls) => Proxy c -> (forall s. c s => Proxy s -> Carrier ctag s -> m (Carrier ctag s)) -> t -> m t Source #

getSub :: forall c m. (Monoid m, AllMods c ls) => Proxy c -> (forall s. c s => Proxy s -> Carrier ctag s -> m) -> t -> m Source #

Instances

Instances details
HasSub tag (ctag :: k) 'SpecLeaf t Source # 
Instance details

Defined in Control.MultiWalk.HasSub

Methods

modSub :: forall c m. (Applicative m, AllMods c 'SpecLeaf) => Proxy c -> (forall s. c s => Proxy s -> Carrier tag s -> m (Carrier tag s)) -> t -> m t Source #

getSub :: forall c m. (Monoid m, AllMods c 'SpecLeaf) => Proxy c -> (forall s. c s => Proxy s -> Carrier tag s -> m) -> t -> m Source #

(Generic t, HasSub' ctag (l ': ls) ('Nothing :: Maybe Symbol) ('Nothing :: Maybe Symbol) (Rep t)) => HasSub ctag GSubTag ('SpecList (l ': ls)) t Source # 
Instance details

Defined in Control.MultiWalk.HasSub

Methods

modSub :: forall c m. (Applicative m, AllMods c ('SpecList (l ': ls))) => Proxy c -> (forall s. c s => Proxy s -> Carrier ctag s -> m (Carrier ctag s)) -> t -> m t Source #

getSub :: forall c m. (Monoid m, AllMods c ('SpecList (l ': ls))) => Proxy c -> (forall s. c s => Proxy s -> Carrier ctag s -> m) -> t -> m Source #

Carrier tag s ~ t => HasSub tag (ctag :: k) ('SpecSelf s) t Source # 
Instance details

Defined in Control.MultiWalk.HasSub

Methods

modSub :: forall c m. (Applicative m, AllMods c ('SpecSelf s)) => Proxy c -> (forall s0. c s0 => Proxy s0 -> Carrier tag s0 -> m (Carrier tag s0)) -> t -> m t Source #

getSub :: forall c m. (Monoid m, AllMods c ('SpecSelf s)) => Proxy c -> (forall s0. c s0 => Proxy s0 -> Carrier tag s0 -> m) -> t -> m Source #

data Spec Source #

Constructors

SpecList [SubSpec] 
SpecLeaf 
SpecSelf Type

Modifiers (used for customizing constraints)

data SubSpec Source #

Constructors

SubSpec 

Fields

  • SelSpec

    Constructor and field selectors

  • Type

    Modifiers (used for customizing constraints)

  • Type

    Carrier type, should be equal to Carrier of type above (to be aligned with the target's generic subtypes)

Instances

Instances details
(Generic t, HasSub' ctag (l ': ls) ('Nothing :: Maybe Symbol) ('Nothing :: Maybe Symbol) (Rep t)) => HasSub ctag GSubTag ('SpecList (l ': ls)) t Source # 
Instance details

Defined in Control.MultiWalk.HasSub

Methods

modSub :: forall c m. (Applicative m, AllMods c ('SpecList (l ': ls))) => Proxy c -> (forall s. c s => Proxy s -> Carrier ctag s -> m (Carrier ctag s)) -> t -> m t Source #

getSub :: forall c m. (Monoid m, AllMods c ('SpecList (l ': ls))) => Proxy c -> (forall s. c s => Proxy s -> Carrier ctag s -> m) -> t -> m Source #

type family Carrier ctag a :: Type Source #

Instances

Instances details
type Carrier MWCTag a Source # 
Instance details

Defined in Control.MultiWalk.Contains

type Carrier MWCTag a Source # 
Instance details

Defined in Control.MultiWalk.Contains

type ToSpec tag (a :: Type) = 'SubSpec 'NoSel a (Carrier tag a) Source #

type ToSpecSel tag (s :: SelSpec) (a :: Type) = 'SubSpec s a (Carrier tag a) Source #

type family All (p :: k -> Constraint) (as :: [k]) :: Constraint where ... Source #

Equations

All p '[] = () 
All p (a ': as) = (p a, All p as) 

type family AllMods (p :: Type -> Constraint) (as :: Spec) :: Constraint where ... Source #

Equations

AllMods p ('SpecList ls) = AllMods' p ls 
AllMods p ('SpecSelf t) = p t 
AllMods p 'SpecLeaf = () 

data GSubTag Source #

Instances

Instances details
(Generic t, HasSub' ctag (l ': ls) ('Nothing :: Maybe Symbol) ('Nothing :: Maybe Symbol) (Rep t)) => HasSub ctag GSubTag ('SpecList (l ': ls)) t Source # 
Instance details

Defined in Control.MultiWalk.HasSub

Methods

modSub :: forall c m. (Applicative m, AllMods c ('SpecList (l ': ls))) => Proxy c -> (forall s. c s => Proxy s -> Carrier ctag s -> m (Carrier ctag s)) -> t -> m t Source #

getSub :: forall c m. (Monoid m, AllMods c ('SpecList (l ': ls))) => Proxy c -> (forall s. c s => Proxy s -> Carrier ctag s -> m) -> t -> m Source #