
I propose that we restructure and split the mtl into two packages: mtl-base: a Haskell-98 package containing the monad transformers and non-overloaded versions of the operations, e.g. module Control.Monad.Trans.State where newtype StateT s m a = StateT { runStateT :: s -> m (a,s) } type State s = StateT s Identity instance (Functor m) => Functor (StateT s m) instance (Monad m) => Monad (StateT s m) instance (MonadPlus m) => MonadPlus (StateT s m) instance (MonadFix m) => MonadFix (StateT s m) get :: (Monad m) => StateT s m s put :: (Monad m) => s -> StateT s m () liftStateT :: Monad m => m a -> StateT s m a mtl (depending on mtl-base): multi-parameter+FD type classes with instances for the transformers in mtl-base, e.g. module Control.Monad.State where import qualified Control.Monad.Trans.Error as Error import qualified Control.Monad.Trans.Reader as Reader import qualified Control.Monad.Trans.State as State import qualified Control.Monad.Trans.Writer as Writer class (Monad m) => MonadState s m | m -> s where get :: m s put :: s -> m () instance (Monad m) => MonadState s (StateT s m) instance (Error e, MonadState s m) => MonadState s (ErrorT e m) instance (MonadState s m) => MonadState s (ReaderT r m) instance (Monoid w, MonadState s m) => MonadState s (WriterT w m) One benefit is that it would be possible to use monad transformers in portable programs, at the cost of a little explicit lifting of operations. Often when I use a stack of monad transformers, I define aliases for the new monad and its operations, so this wouldn't be much extra effort. A second benefit is that one could introduce other packages with other interfaces, e.g. one using associated types. The revised mtl would be almost compatible with the existing one, except 1) The monad transformer and corresponding monad would have the same strictness (this has already been done in the HEAD). 2) It wouldn't be possible to declare instances for the corresponding monad.