recursion-schemes-ext-1.0.0.4: Amateur addenda to recursion-schemes

Safe HaskellNone
LanguageHaskell2010

Data.Functor.Foldable.Exotic

Contents

Description

Several extensions to Edward Kmett's recursion schemes package. The monadic recursion schemes and exotic recursion schemes should be stable, but the recursion schemes for interdependent data type (and their attendant typeclasses) are experimental.

Synopsis

Monadic recursion schemes

cataM :: (Recursive t, Traversable (Base t), Monad m) => (Base t a -> m a) -> t -> m a Source #

A monadic catamorphism

anaM :: (Corecursive t, Traversable (Base t), Monad m) => (a -> m (Base t a)) -> a -> m t Source #

A monadic anamorphism

hyloM :: (Functor f, Monad m, Traversable f) => (f b -> m b) -> (a -> m (f a)) -> a -> m b Source #

A monadic hylomorphism

Recursion schemes for interdependent data types

dendro Source #

Arguments

:: (Recursive t', Functor f) 
=> ((f a -> a) -> Trans b b)

A pseudoprism parametric in an \(F \)-algebra that allows b to inspect itself.

-> (f a -> a)

A (Base t)-algebra

-> (Base t' b -> b)

A (Base t')-algebra

-> t' 
-> b 

A dendromorphism entangles two catamorphisms

scolio Source #

Arguments

:: (Functor f, Functor g) 
=> ((f b -> b) -> Trans b b)

A pseudoprism parametric in an \( F \)-algebra that allows b to inspect itself.

-> ((a -> f a) -> Lens' a a)

A lens parametric in an \( F \)-coalgebra that allows b to inspect itself.

-> (g b -> b)

A g-algebra

-> (a -> g a)

A g-coalgebra

-> (f b -> b)

An f-algebra

-> (a -> f a)

An f-coalgebra

-> a 
-> b 

Entangle two hylomorphisms.

chema Source #

Arguments

:: (Corecursive t', Functor f) 
=> ((a -> f a) -> Lens' b b)

A lens parametric in an \( F \)-coalgebra that allows b to inspect itself.

-> (a -> f a)

A (Base t)-coalgebra

-> (b -> Base t' b)

A (Base t')-coalgebra

-> b 
-> t' 

Exotic recursion schemes

dicata :: Recursive a => (Base a (b, a) -> b) -> (Base a (b, a) -> a) -> a -> b Source #

Catamorphism collapsing along two data types simultaneously. Basically a fancy zygomorphism.

micro :: Corecursive a => (b -> Either a (Base a b)) -> b -> a Source #

A micromorphism is an Elgot algebra specialized to unfolding.

mutu :: Recursive t => (Base t (b, a) -> b) -> (Base t (b, a) -> a) -> t -> a Source #

Mutumorphism

Data type for transformations

type Trans s a = forall f. Functor f => (f a -> a) -> f s -> s Source #

A map of \( F \)-algebras (pseudoprism)

Helper functions

finish :: Eq a => (a -> a) -> a -> a Source #

Helper function to force recursion. This can be used alongside dendro to simplify writing a Trans