fixplate-0.1.3: Uniplate-style generic traversals for optionally annotated fixed-point types.

Safe HaskellSafe-Infered

Data.Generics.Fixplate.Morphisms

Contents

Description

Scary named folds...

Synopsis

Classic ana/cata/para/hylo-morphisms

para :: Functor f => (Mu f -> f a -> a) -> Mu f -> aSource

A paramorphism is a generalized (right) fold.

para' :: Functor f => (f (Mu f, a) -> a) -> Mu f -> aSource

Another version of para (more natural in some sense; compare with apo).

paraList :: (Functor f, Foldable f) => (Mu f -> [a] -> a) -> Mu f -> aSource

cata :: Functor f => (f a -> a) -> Mu f -> aSource

A catamorphism is a simpler version of a paramorphism

ana :: Functor f => (a -> f a) -> a -> Mu fSource

An anamorphism is simply an unfold. Probably not very useful in this context.

apo :: Functor f => (a -> f (Either (Mu f) a)) -> a -> Mu fSource

An apomorphism is a generalization of the anamorphism.

hylo :: Functor f => (f a -> a) -> (b -> f b) -> b -> aSource

A hylomorphism is the composition of a catamorphism and an anamorphism.

More exotic stuff

zygo_ :: Functor f => (f b -> b) -> (f (b, a) -> a) -> Mu f -> aSource

A zygomorphism is a basically a catamorphism inside another catamorphism. It could be implemented (somewhat wastefully) by first annotating each subtree with the corresponding values of the inner catamorphism (synthCata), then running a paramorphims on the annotated tree:

 zygo_ g h == para' u . synthCata g 
   where
     u = h . fmap (first attribute) . unAnn
     first f (x,y) = (f x, y)

zygo :: Functor f => (f b -> b) -> (f (b, a) -> a) -> Mu f -> (b, a)Source

newtype Free f a Source

Constructors

Free 

Fields

unFree :: Either a (f (Free f a))
 

newtype CoFree f a Source

Constructors

CoFree 

Fields

unCoFree :: (a, f (CoFree f a))
 

futu :: Functor f => (a -> f (Free f a)) -> a -> Mu fSource

Futumorphism. Whatever it does.

histo :: Functor f => (f (CoFree f a) -> a) -> Mu f -> aSource

Histomorphism. Whatever it does.

Monadic versions

paraM :: (Monad m, Traversable f) => (Mu f -> f a -> m a) -> Mu f -> m aSource

Monadic paramorphism.

paraM_ :: (Monad m, Traversable f) => (Mu f -> f a -> m a) -> Mu f -> m ()Source

cataM :: (Monad m, Traversable f) => (f a -> m a) -> Mu f -> m aSource

Monadic catamorphism.

cataM_ :: (Monad m, Traversable f) => (f a -> m a) -> Mu f -> m ()Source