{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE UnicodeSyntax #-}
module Data.Functor.Foldable.Exotic
(
cataM
, anaM
, hyloM
, dendro
, scolio
, chema
, dicata
, micro
, mutu
, Trans
, finish
) where
import Control.Arrow
import Control.Composition
import Control.Lens
import Control.Monad
import Data.Functor.Foldable
dock :: (Eq a) => [a] -> a
dock [x] = x
dock [] = undefined
dock (x:ys@(y:_))
| x == y = y
| otherwise = dock ys
finish :: (Eq a) => (a -> a) -> a -> a
finish = dock .* iterate
type Trans s a = ∀ f. Functor f => (f a -> a) -> f s -> s
mutu :: Recursive t => (Base t (b, a) -> b) -> (Base t (b, a) -> a) -> t -> a
mutu f g = snd . cata (f &&& g)
scolio :: (Functor f, Functor g)
=> ((f b -> b) -> Trans b b)
-> ((a -> f a) -> Lens' a a)
-> (g b -> b)
-> (a -> g a)
-> (f b -> b)
-> (a -> f a)
-> a -> b
scolio p l alg coalg alg' coalg' = hylo (p alg' alg) (l coalg' coalg)
chema :: (Corecursive t', Functor f)
=> ((a -> f a) -> Lens' b b)
-> (a -> f a)
-> (b -> Base t' b)
-> b -> t'
chema = (ana .*)
dendro :: (Recursive t', Functor f)
=> ((f a -> a) -> Trans b b)
-> (f a -> a)
-> (Base t' b -> b)
-> t' -> b
dendro = (cata .*)
dicata :: (Recursive a) => (Base a (b, a) -> b) -> (Base a (b, a) -> a) -> a -> b
dicata = fst .** (cata .* (&&&))
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 = c where c = phi <=< (traverse c . project)
anaM :: (Corecursive t, Traversable (Base t), Monad m) => (a -> m (Base t a)) -> (a -> m t)
anaM psi = a where a = (fmap embed . traverse a) <=< psi
hyloM :: (Functor f, Monad m, Traversable f) => (f b -> m b) -> (a -> m (f a)) -> a -> m b
hyloM phi psi = h where h = phi <=< traverse h <=< psi