Morphisms.hs

-- | Scary named folds...

{-# LANGUAGE CPP #-}
module Data.Generics.Fixplate.Morphisms where

--------------------------------------------------------------------------------

import Data.Foldable
import Data.Generics.Fixplate.Base

#ifdef WITH_QUICKCHECK
import Test.QuickCheck
import Data.Generics.Fixplate.Traversals
import Data.Generics.Fixplate.Test.Tools
#endif 

--------------------------------------------------------------------------------

-- | A /paramorphism/ is a generalized (right) fold.
para :: Functor f => (Mu f -> f a -> a) -> Mu f -> a
para h = go where
  go t = h t (fmap go $ unFix t) 

para' :: Functor f => (f (Mu f, a) -> a) -> Mu f -> a
para' h = go where
  go (Fix t) = h (fmap go' $ t)
  go' t = (t, go t) 

paraList :: (Functor f, Foldable f) => (Mu f -> [a] -> a) -> Mu f -> a 
paraList f = go where
  go t = f t (toList $ fmap go $ unFix t)

-- | A /catamorphism/ is a simpler version of a paramorphism
cata :: Functor f => (f a -> a) -> Mu f -> a
cata h = go where
  go = h . fmap go . unFix

-- | An /anamorphism/ is simply an unfold.
ana :: Functor f => (a -> f a) -> a -> Mu f
ana h = go where
  go x = Fix (fmap go (h x))

-- | A /hylomorphism/ is the composition of a catamorphism and an anamorphism.
hylo :: Functor f => (f a -> a) -> (b -> f b) -> (b -> a) 
hylo g h = cata g . ana h

--------------------------------------------------------------------------------