module Data.Foldable.Functor.Extensions
( dicata
, dendro
, micro
, symplecto
, chema
, cataM
, SubHom (..)
, CoSubHom (..)
, Dummy (..)
) where
import Control.Arrow ((&&&))
import Control.Composition ((-.*), (.*))
import Control.Monad ((<=<))
import Data.Functor.Foldable (Base, Corecursive, Recursive, ana, cata,
elgot, embed, hylo, project)
class (Functor f, Functor g) => SubHom f g a b where
homo :: (f a -> a) -> (g b -> b) -> (g b -> b)
class (Functor f, Functor g) => CoSubHom f g a b where
homoCo :: (a -> f a) -> (b -> g b) -> (b -> g b)
class Dummy t where
dummy :: t
symplecto :: (SubHom g f b b, CoSubHom g f a a)
=> (g b -> b)
-> (a -> g a)
-> (f b -> b)
-> (a -> f a)
-> a -> b
symplecto = homoCo -.* (flip . ((.) .* hylo .* homo))
chema :: (CoSubHom (Base t) (Base t') a b, Corecursive t')
=> (a -> Base t a)
-> (b -> Base t' b)
-> b -> t'
chema = ana .* homoCo
dendro :: (SubHom (Base t) (Base t') a b, Recursive t')
=> t
-> (Base t a -> a)
-> (Base t' b -> b)
-> t' -> b
dendro _ = cata .* homo
dicata :: (Recursive a) => (Base a (b, a) -> b) -> (Base a (b, a) -> a) -> a -> b
dicata f g = fst . cata (f &&& g)
micro :: (Corecursive a) => (b -> Either a (Base a b)) -> b -> a
micro = elgot embed
cataM :: (Recursive t, Traversable (Base t), Monad m) => (Base t a -> m a) -> (t -> m a)
cataM phi = g where g = phi <=< (mapM g . project)