module Control.Monad.Free
( Free()
, inFree
, cataFree
, distribFree
) where
import Control.Arrow ((|||), (+++), (>>>))
import Control.Applicative
import Control.Monad
newtype Free f a = Free { unFree :: Either a (f (Free f a)) }
instance (Functor f) => Functor (Free f) where
fmap f = unFree >>> f +++ fmap (fmap f) >>> Free
instance (Functor f) => Applicative (Free f) where
pure = return
(<*>) = ap
instance (Functor f) => Monad (Free f) where
return = Free . Left
(Free e) >>= f = either f (inFree . fmap (>>= f)) e
cataFree :: Functor f => (a -> b) -> (f b -> b) -> Free f a -> b
cataFree f g = unFree >>> f ||| g . fmap (cataFree f g)
inFree :: f (Free f a) -> Free f a
inFree = Free . Right
distribFree :: (Functor f, Functor h) =>
(forall a. h (f a) -> f (h a))
-> (forall a. Free h (f a) -> f (Free h a))
distribFree d = cataFree (fmap return) (fmap inFree . d)