{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Data.Foldable.Functor.Extensions
    ( dicata
    , dendro
    , micro
    , cataM
    ) where

import           Control.Arrow         ((&&&))
import           Control.Monad         ((<=<))
import           Data.Composition      ((.*))
import           Data.Functor.Foldable (Base, Corecursive, Recursive, cata,
                                        elgot, embed, project)

-- | Class that yields F-algebra homomorphisms between mutually recursive types
class (Functor f, Functor g) => SubHom f g a b where
    homo :: (f a -> a) -> (g b -> b) -> (g b -> b)

-- FIXME codependent data types in test suite should be called "Ernie" and "Bert"

dendro :: (SubHom (Base t1) (Base t2) a b, Recursive t2) => (Base t1 a -> a) -> (Base t2 b -> b) -> t2 -> b
dendro = cata .* homo

-- | Catamorphism collapsing mutually data types simultaneously
dicata :: (Recursive a) => (Base a (b, a) -> b) -> (Base a (b, a) -> a) -> a -> b
dicata f g = fst . cata (f &&& g)

-- | A micromorphism is an Elgot algebra specialized to unfolding.
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)