Move MonadIO to base
Heinrich Apfelmus
apfelmus at quantentunnel.de
Sat Apr 17 08:14:23 EDT 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
>
> [...]
>
> 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
Interesting! (Cross posting this to cafe)
In the light of Conor's remark on the distinction between "operations"
and "control operators"
http://www.haskell.org/pipermail/haskell-cafe/2010-April/076185.html
, it appears that the essence of MonadTransIO is the ability to lift
control operators, whereas MonadTrans can only lift operations. For
instance, here is a lifting of mplus :
mplus' :: MonadPlus m
=> StateT s m a -> StateT s m a -> StateT s m a
mplus' x y = morph $ \down -> down x `mplus` down y
I believe this corresponds to a "commuting product" of State with the
monad m in Gordon Plotkins language?
> 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 would make it possible to lift control operators with more
restricted return types. Not that I know any useful examples.
However, not all control operators can be lifted this way. Essentially,
while you may "downgrade" an arbitrary selection of t m a values you
may only promote one m a in return and all have to share the same
return type a . In particular, it's not possible to implement
lift :: (Monad m, MonadTrans t) => m a -> t m a
in terms of morph.
Is there a way to lift really *any* control operator, or at least a good
overview of those that can be lifted?
There's also the question of how to characterize morph in terms of
equations. The following is immediate
morph ($ m) = m
but relating morph with >>= seems to be tricker because of the
opaque return type b . Maybe this:
morph ((m >>=) . h) = lift m >>= morph . flip h
I haven't found an equation for return .
Regards,
Heinrich Apfelmus
--
http://apfelmus.nfshost.com
More information about the Libraries
mailing list