module Control.Monad.Free
( module Control.Monad.Parameterized
, PFree
, Free
, runFree
, free
, MonadFree(inFree)
, RunMonadFree(cataFree)
) where
import Prelude hiding ((.),id)
import Control.Category
import Control.Category.Cartesian
import Control.Functor
import Control.Functor.Algebra
import Control.Functor.Combinators.Biff
import Control.Functor.Fix
import Control.Monad.Parameterized
import Control.Monad.Identity
import Control.Monad.Reader
type Free f = Fix (PFree f)
runFree :: Free f a -> Either a (f (Free f a))
runFree = first runIdentity . runBiff . outB
free :: Either a (f (Free f a)) -> Free f a
free = InB . Biff . first Identity
class MonadFree f m => RunMonadFree f m | m -> f where
cataFree :: (c -> a) -> Algebra f a -> m c -> a
instance Functor f => RunMonadFree f (Free f) where
cataFree l r = (l . runIdentity ||| r . fmap (cataFree l r)) . runBiff . outB
class (Functor f, Monad m) => MonadFree f m | m -> f where
inFree :: f (m a) -> m a
instance Functor f => MonadFree f (Free f) where
inFree = InB . Biff . Right
instance MonadFree f m => MonadFree f (ReaderT e m) where
inFree fma = ReaderT (\e -> inFree $ fmap (flip runReaderT e) fma)