Generalize MonadIO to MonadBase

Edward Kmett ekmett at gmail.com
Wed Apr 21 00:17:11 EDT 2010


I don't like this one much. The main point of MonadIO is to eliminate 0 or
more lifts to get to the soft chewy IO center. It also has the benefit of
being Haskell 98, whereas MonadBase requires fundeps, MPTCs, and a whole
passel of extensions.

MonadIO can be cleanly accomodated into base or the platform without
alienating the compilers that stick to their guns and don't leave 98, but
even if they do, the MTL/transformers/etc. can be accomodated without
requiring them to embrace the 'modern marvel' that is UndecidableInstances.
;)

The other problem is that the change from mtl to transformers/whatever
becomes much more visible under this model. The new model eliminates State,
Reader, etc. replacing them with synonyms for StateT s Identity, etc.

If Identity was added as at least one person has proposed in the thread,
then under the existing mtl, the base would terminate at a leaf level State
or Reader, but under the proposed new schema that would terminate at
Identity.

-Edward Kmett



On Mon, Apr 19, 2010 at 7:50 PM, Bas van Dijk <v.dijk.bas at gmail.com> wrote:

> Hello,
>
> (This should actually be a reply to the "Move MonadIO to base"
> thread[1] but I didn't want to break up the extremely interesting
> discussion on the MonadTransMorph class)
>
> Would it be useful if we got rid of MonadIO:
>
> class (Monad m) => MonadIO m where liftIO :: IO a -> m a
>
> and replace it with the generalization:
>
> class (Monad m, Monad n) => MonadBase m n | m -> n where inBase :: n a -> m
> a
>
> which would allow lifting not just IO but any base monad into a stack
> of monad transformers.
>
> It could be implemented as follows:
>
>
> --------------------------------------------------------------------------------------
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE FlexibleContexts #-}
> {-# LANGUAGE FunctionalDependencies #-}
> {-# LANGUAGE UndecidableInstances #-}
>
> module MonadBase where
>
> import Data.Monoid ( Monoid )
> import Control.Monad.ST ( ST )
>
> import Control.Monad.Trans.Class ( MonadTrans, lift )
>
> import Control.Monad.Trans.Cont     ( ContT )
> import Control.Monad.Trans.Error    ( ErrorT, Error )
> import Control.Monad.Trans.Identity ( IdentityT )
> import Control.Monad.Trans.List     ( ListT )
> import Control.Monad.Trans.Maybe    ( MaybeT )
> import Control.Monad.Trans.RWS      ( RWST )
> import Control.Monad.Trans.Reader   ( ReaderT )
> import Control.Monad.Trans.State    ( StateT )
> import Control.Monad.Trans.Writer   ( WriterT )
>
> class (Monad m, Monad n) => MonadBase m n | m -> n where
>    inBase :: n a -> m a
>
> instance MonadBase IO    IO      where inBase = id
> instance MonadBase Maybe Maybe   where inBase = id
> instance MonadBase []    []      where inBase = id
> instance MonadBase (ST s) (ST s) where inBase = id
> -- etc.
>
> -- This would be nice but will cause lots of trouble:
> -- instance Monad m => MonadBase m m where inBase = id
>
> liftInBase :: (MonadTrans t, MonadBase m n) => n a -> t m a
> liftInBase = lift . inBase
>
> instance (MonadBase m n)           => MonadBase (ContT r     m) n
> where inBase = liftInBase
> instance (MonadBase m n)           => MonadBase (IdentityT   m) n
> where inBase = liftInBase
> instance (MonadBase m n)           => MonadBase (ListT       m) n
> where inBase = liftInBase
> instance (MonadBase m n)           => MonadBase (MaybeT      m) n
> where inBase = liftInBase
> instance (MonadBase m n)           => MonadBase (ReaderT r   m) n
> where inBase = liftInBase
> instance (MonadBase m n)           => MonadBase (StateT s    m) n
> where inBase = liftInBase
> instance (MonadBase m n, Error e)  => MonadBase (ErrorT e    m) n
> where inBase = liftInBase
> instance (MonadBase m n, Monoid w) => MonadBase (RWST r w s  m) n
> where inBase = liftInBase
> instance (MonadBase m n, Monoid w) => MonadBase (WriterT w   m) n
> where inBase = liftInBase
>
> {-# DEPRECATED liftIO "Use inBase instead." #-}
> liftIO :: MonadBase m IO => IO a -> m a
> liftIO = inBase
>
>
> --------------------------------------------------------------------------------------
>
> I noticed that MonadLib also provides this class[2].
>
> regards
>
> Bas
>
> [1] http://thread.gmane.org/gmane.comp.lang.haskell.libraries/12877
> [2]
> http://hackage.haskell.org/packages/archive/monadLib/3.6.1/doc/html/MonadLib.html#t%3ABaseM
> _______________________________________________
> Libraries mailing list
> Libraries at haskell.org
> http://www.haskell.org/mailman/listinfo/libraries
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/libraries/attachments/20100420/a89f7f0c/attachment-0001.html


More information about the Libraries mailing list