module Control.Monad.Free.Class
( MonadFree(..)
) where
import Control.Applicative
import Control.Monad.Trans.Free (Free(..))
import Control.Monad.Trans.Reader
import qualified Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.State.Lazy as Lazy
import qualified Control.Monad.Trans.Writer.Strict as Strict
import qualified Control.Monad.Trans.Writer.Lazy as Lazy
import qualified Control.Monad.Trans.RWS.Strict as Strict
import qualified Control.Monad.Trans.RWS.Lazy as Lazy
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.List
import Control.Monad.Trans.Error
import Control.Monad.Trans.Identity
import Data.Monoid
class (Functor f, Monad m) => MonadFree f m | m -> f where
wrap :: f (m a) -> m a
instance Functor f => MonadFree f (Free f) where
wrap = Free
instance MonadFree f m => MonadFree f (ReaderT e m) where
wrap fm = ReaderT $ \e -> wrap $ flip runReaderT e <$> fm
instance MonadFree f m => MonadFree f (Lazy.StateT s m) where
wrap fm = Lazy.StateT $ \s -> wrap $ flip Lazy.runStateT s <$> fm
instance MonadFree f m => MonadFree f (Strict.StateT s m) where
wrap fm = Strict.StateT $ \s -> wrap $ flip Strict.runStateT s <$> fm
instance (MonadFree f m, Monoid w) => MonadFree f (Lazy.WriterT w m) where
wrap = Lazy.WriterT . wrap . fmap Lazy.runWriterT
instance (MonadFree f m, Monoid w) => MonadFree f (Strict.WriterT w m) where
wrap = Strict.WriterT . wrap . fmap Strict.runWriterT
instance (MonadFree f m, Monoid w) => MonadFree f (Strict.RWST r w s m) where
wrap fm = Strict.RWST $ \r s -> wrap $ fmap (\m -> Strict.runRWST m r s) fm
instance (MonadFree f m, Monoid w) => MonadFree f (Lazy.RWST r w s m) where
wrap fm = Lazy.RWST $ \r s -> wrap $ fmap (\m -> Lazy.runRWST m r s) fm
instance MonadFree f m => MonadFree f (MaybeT m) where
wrap = MaybeT . wrap . fmap runMaybeT
instance MonadFree f m => MonadFree f (IdentityT m) where
wrap = IdentityT . wrap . fmap runIdentityT
instance MonadFree f m => MonadFree f (ListT m) where
wrap = ListT . wrap . fmap runListT
instance (MonadFree f m, Error e) => MonadFree f (ErrorT e m) where
wrap = ErrorT . wrap . fmap runErrorT