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

Control.MultiWalk

Description

This module provides functionality for recursively traversing and querying along multiple types.

Synopsis

Documentation

class (BuildF (MultiWalk' tag) (MultiTypes tag), BuildQ (MultiWalk' tag) (MultiTypes tag)) => MultiTag tag Source #

You should instantiate MultiTag to a tag associated to the structure you are working with. The tag is mostly there to prevent orphan instances, since people are often working with structures from other packages (Pandoc AST, HTML, etc.)

Associated Types

type MultiTypes tag :: [Type] Source #

The types that will be used in the walks and queries; every type listed here should have a MultiSub instance. (The compiler will complain about this.)

class MultiSub tag t Source #

Associated Types

type SubTypes tag t :: Spec Source #

A list of substructure specifications for types that are substructures to this type; all types listed here should also be listed in the corresponding MultiTypes, but you can omit types from there that should not be regarded as subtypes.

Substructure specifications are special datakinds that you can generate using ToSpec and ToSpecSel, and the combinators (eg. Under, MatchWith and Trav).

type HasSubTag tag t :: Type Source #

If you want to write HasSub instances by hand (not that easy), you can put the associated HasSub tag here. Defaults to GSubTag (which derives Generic instances).

type HasSubTag tag t = GSubTag

query :: forall tag m t a. (MultiTag tag, MultiWalk tag a, MultiWalk tag t, Monoid m) => (t -> m) -> a -> m Source #

Query a structure with a single query function (just like Pandoc.Walk).

walk :: forall tag t c. (MultiTag tag, MultiWalk tag c, MultiWalk tag t) => (t -> t) -> c -> c Source #

Modify a structure by walking with a single function (just like Pandoc.Walk).

walkM :: forall tag t a m. (Monad m, MultiTag tag, MultiWalk tag a, MultiWalk tag t) => (t -> m t) -> a -> m a Source #

Modify a structure by walking with a single function (just like Pandoc.Walk).

type Walk tag m = forall t. MultiWalk tag t => t -> m t Source #

type Query tag m = forall t. MultiWalk tag t => t -> m Source #

walkSub :: forall tag t m. (Applicative m, MultiWalk tag t) => FList m (MultiTypes tag) -> t -> m t Source #

Modify (only) substructures by applying functions from FList.

querySub :: forall tag t m. (Monoid m, MultiWalk tag t) => QList m (MultiTypes tag) -> t -> m Source #

Query (only) substructures by applying functions from QList.

buildMultiW :: forall tag m. (MultiTag tag, Applicative m) => (Walk tag m -> FList m (MultiTypes tag) -> FList m (MultiTypes tag)) -> Walk tag m Source #

Most general way to create a walk. Create a walk with multiple functions, targeting multiple types.

First argument is a function that takes a walk, an empty list of functions and should return a list of functions populated with the multiple walk functions.

By "tying a knot", the first argument you are supplied with is almost the result of buildMultiW itself, the only difference being that it only walks substructures of the type. It's a responsability of each function in the FList to apply this function to its argument in any desired way, as to continue recursing down the "type tree".

You can add functions to the empty FList via .>.

multi :: Applicative m => Block -> m Block
multi = buildMultiW @PTag $ \sub list ->
    list .> blks sub
         .> inls sub
  where
    blks _ (CodeBlock _ c) = Para [Str c]
    blks f x = f x
    inls _ (Code _ c) = Str c
    inls f x = f x

buildMultiQ :: forall tag m. (MultiTag tag, Monoid m) => (Query tag m -> QList m (MultiTypes tag) -> QList m (MultiTypes tag)) -> Query tag m Source #

Most general way to create a query. Create a query with multiple functions, targeting multiple types.

First argument is a function that takes a query, an empty list of queries and should return a list of queries populated with the multiple query functions.

By "tying a knot", the first argument you are supplied with is almost the result of buildMultiQ itself, the only difference being that it only queries substructures of the type. It's a responsability of each function in the QList to apply this function to its argument in any desired way, as to continue recursing down the "type tree".

You can add functions to the empty QList via ?>.

multi :: Block -> [Text]
multi = buildMultiQ @PTag $ \sub list ->
    list ?> blks sub
         ?> inls sub
  where
    blks _ (CodeBlock _ c) = [c]
    blks f x = f x
    inls _ (Code _ c) = [c]
    inls f x = f x

(.>) :: FContains ls t => FList m ls -> (t -> m t) -> FList m ls Source #

Add a function to a FList.

(?>) :: QContains ls t => QList m ls -> (t -> m) -> QList m ls Source #

Add a function to a QList.

data Spec Source #

Constructors

SpecList [SubSpec] 
SpecLeaf 
SpecSelf Type

Modifiers (used for customizing constraints)

data Trav (k :: Type -> Type) (a :: Type) Source #

Use this for matching with a type inside a traversable functor.

Instances

Instances details
(Traversable f, TContains fs a) => TContains fs (Trav f a) Source # 
Instance details

Defined in Control.MultiWalk.Contains

Methods

tGetW :: Applicative m => FList m fs -> ContainsCarrier (Trav f a) -> m (ContainsCarrier (Trav f a)) Source #

tGetQ :: Monoid m => QList m fs -> ContainsCarrier (Trav f a) -> m Source #

data MatchWith (s :: Type) (a :: Type) Source #

Use this for matching with another type that is coercible to the type you want.

Instances

Instances details
(TContains fs a, Coercible (Carrier a) s) => TContains fs (MatchWith s a) Source # 
Instance details

Defined in Control.MultiWalk.Contains

Methods

tGetW :: Applicative m => FList m fs -> ContainsCarrier (MatchWith s a) -> m (ContainsCarrier (MatchWith s a)) Source #

tGetQ :: Monoid m => QList m fs -> ContainsCarrier (MatchWith s a) -> m Source #

data Under (b :: Type) (s :: SelSpec) (a :: Type) Source #

Use this for matching a subcomponent nested inside another type. Useful if you don't want to add the middle type to the list of walkable types.

Instances

Instances details
(TContains fs a, HasSub GSubTag ('SpecList '['SubSpec s a (Carrier a)]) b) => TContains fs (Under b s a) Source # 
Instance details

Defined in Control.MultiWalk.Contains

Methods

tGetW :: Applicative m => FList m fs -> ContainsCarrier (Under b s a) -> m (ContainsCarrier (Under b s a)) Source #

tGetQ :: Monoid m => QList m fs -> ContainsCarrier (Under b s a) -> m Source #

type MultiWalk tag t = (AllMods (TContains (MultiTypes tag)) (SubTypes tag t), QContains (MultiTypes tag) t, FContains (MultiTypes tag) t, HasSub (HasSubTag tag t) (SubTypes tag t) t) Source #

data FList :: (Type -> Type) -> [Type] -> Type where Source #

Heterogeneous list of monadic-valued functions

Constructors

FNil :: FList m '[] 
(:.:) :: (x -> m x) -> FList m xs -> FList m (x ': xs) infixr 8 

data QList :: Type -> [Type] -> Type where Source #

Heterogeneous list of queries

Constructors

QNil :: QList m '[] 
(:?:) :: (x -> m) -> QList m xs -> QList m (x ': xs) infixr 8 

class All c ls => BuildF c ls where Source #

Methods

buildF :: (forall t. c t => t -> m t) -> FList m ls Source #

Instances

Instances details
BuildF c ('[] :: [Type]) Source # 
Instance details

Defined in Control.MultiWalk

Methods

buildF :: (forall t. c t => t -> m t) -> FList m '[] Source #

(BuildF c ls, c l) => BuildF c (l ': ls) Source # 
Instance details

Defined in Control.MultiWalk

Methods

buildF :: (forall t. c t => t -> m t) -> FList m (l ': ls) Source #

class All c ls => BuildQ c ls where Source #

Methods

buildQ :: (forall t. c t => t -> m) -> QList m ls Source #

Instances

Instances details
BuildQ c ('[] :: [Type]) Source # 
Instance details

Defined in Control.MultiWalk

Methods

buildQ :: (forall t. c t => t -> m) -> QList m '[] Source #

(BuildQ c ls, c l) => BuildQ c (l ': ls) Source # 
Instance details

Defined in Control.MultiWalk

Methods

buildQ :: (forall t. c t => t -> m) -> QList m (l ': ls) Source #