recursion schemes, based on the paper

bananas.hs

{-# LANGUAGE DeriveTraversable #-}

import Prelude hiding (iterate)
import Control.Monad ((<=<))

data Fix m = In {out :: m (Fix m)}

data ListF x xs = Nil | Cons x xs 
  deriving (Functor, Foldable, Traversable)

type List a = Fix (ListF a)

-- Recursion Schemes

cata :: Functor f => (f a -> a) -> Fix f -> a
cata f = h where h = f . fmap h . out

cataM :: (Traversable f, Monad m) => (f a -> m a) -> Fix f -> m a
cataM f = h where h = f <=< traverse h . out 

ana :: Functor f => (a -> f a) -> a -> Fix f
ana f = h where h = In . fmap h . f

anaM :: (Traversable f, Monad m) => (a -> m (f a)) -> a -> m (Fix f)
anaM f = h where h = fmap In . traverse h <=< f

hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
hylo f g = h where h = f . fmap h . g
{- hylo f g = cata f . ana g -}

hyloM :: (Traversable f, Monad m) => (f b -> m b) -> (a -> m (f a)) -> a -> m b
hyloM f g = h where h = f <=< traverse h <=< g

para :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a
para f = h where h = f . fmap ((,) <*> h) . out

-- Useful Functions, Use showcase

iterate :: (a -> a) -> a -> List a
iterate f = ana alg
  where
    alg a = Cons a (f a)

fromList' :: [a] -> ListF a [a]
fromList' [] = Nil
fromList' (x:xs) = Cons x xs

fromList :: [a] -> List a
fromList = foldr ((In .). Cons) (In Nil) 

toList :: List a -> [a]
toList = cata alg
  where
    alg Nil = []
    alg (Cons x xs) = x:xs

fact :: Integer -> Integer
fact = hylo algC algA
  where
    algC Nil = 1
    algC (Cons x xs) = x*xs
    algA 1 = Nil
    algA x = Cons <*> subtract 1 $ x