Re: Move MonadIO to base

14 Apr 2010

      On Tue, 13 Apr 2010, Anders Kaseorg wrote:
...
The striking similarity between instances of MonadCatchIO suggests to me 
that something deeper is going on.  Is there a cleaner abstraction that 
captures this idea?
Here a possible answer.  I haven’t entirely figured out what it “means” 
yet, but maybe someone who knows more category theory will be able to 
figure that out.  :-)

class Monad m => MonadMorphIO m where
    morphIO :: (forall b. (m a -> IO b) -> IO b) -> m a

instance MonadMorphIO IO where
    morphIO f = f id
instance MonadMorphIO m => MonadMorphIO (ReaderT r m) where
    morphIO f = ReaderT $ \r -> morphIO $ \w -> f $ \m -> w $ runReaderT m r
instance MonadMorphIO m => MonadMorphIO (StateT s m) where
    morphIO f = StateT $ \s -> morphIO $ \w -> f $ \m -> w $ runStateT m s
instance (Error e, MonadMorphIO m) => MonadMorphIO (ErrorT e m) where
    morphIO f = ErrorT $ morphIO $ \w -> f $ \m -> w $ runErrorT m
instance (Monoid w, MonadMorphIO m) => MonadMorphIO (WriterT w m) where
    morphIO f = WriterT $ morphIO $ \w -> f $ \m -> w $ runWriterT m
instance (Monoid w, MonadMorphIO m) => MonadMorphIO (RWST r w s m) where
    morphIO f = RWST $ \r s -> morphIO $ \w -> f $ \m -> w $ runRWST m r s
instance MonadMorphIO m => MonadMorphIO (ListT m) where
    morphIO f = ListT $ morphIO $ \w -> f $ \m -> w $ runListT m
instance MonadMorphIO m => MonadMorphIO (ContT r m) where
    morphIO f = ContT $ \c -> morphIO $ \w -> f $ \m -> w $ runContT m c

catch :: MonadMorphIO m => Exception e => m a -> (e -> m a) -> m a
m `catch` h = morphIO $ \w -> w m `Control.Exception.catch` \e -> w (h e)

mask :: MonadMorphIO m => ((forall b. m b -> m b) -> m a) -> m a
mask io = morphIO $ \w -> mask_IO $ \restore -> w $ io $
          \m -> morphIO $ \w' -> restore (w' m)
    where
      mask_IO :: ((forall b. IO b -> IO b) -> IO a) -> IO a
      mask_IO io = do b <- blocked
                   if b then io id else block $ io unblock

You can avoid all the RankNTypes if you use TypeFamilies (or 
MultiParamTypeClasses+FunctionalDependencies, if you want) to be more 
specific about which type b is:

class Monad m => MonadMorphIO m where
    data Result m :: * -> *
    morphIO :: ((m a -> IO (Result m a)) -> IO (Result m a)) -> m a

instance MonadMorphIO m => MonadMorphIO (StateT s m) where
    newtype Result (StateT s m) a =
        StateTResult { runStateTResult :: Result m (a, s) }
    morphIO f = morphStateT $ \w -> morphIO $ \w' ->
        liftM runStateTResult $ f $ liftM StateTResult . w' . w

This concept can also be generalized to monad transformers:

class MonadTrans t => MonadTransMorph t where
    morph :: Monad m => (forall b. (t m a -> m b) -> m b) -> t m a

instance MonadTransMorph (StateT s) where
    morph f = StateT $ \s -> f $ \m -> runStateT m s

Anders