module Control.IMonad.Trans.Free (
IFreeF(..),
IFreeT(..),
wrap,
liftF
) where
import Control.Category.Index
import Control.IMonad
import Control.IMonad.Trans
data IFreeF f r (x :: * -> *) i = Return (r i) | Wrap (f x i)
data IFreeT f m r i = IFreeT { runIFreeT :: m (IFreeF f r (IFreeT f m r)) i }
instance (IFunctor f, IMonad m) => IFunctor (IFreeT f m) where
fmapI f x = x ?>= returnI . f
instance (IFunctor f, IMonad m) => IMonad (IFreeT f m) where
returnI = IFreeT . returnI . Return
bindI f m = IFreeT $
runIFreeT m ?>= \x ->
runIFreeT $ case x of
Return r -> f r
Wrap w -> wrap $ fmapI (bindI f) w
instance (IFunctor f) => IMonadTrans (IFreeT f) where
liftI = IFreeT . fmapI Return
wrap :: (IMonad m) => f (IFreeT f m r) :-> IFreeT f m r
wrap = IFreeT . returnI . Wrap
liftF :: (IFunctor f, IMonad m) => f r :-> IFreeT f m r
liftF x = wrap $ fmapI returnI x