The MonadTrans class is missing a method

My work on pipes-2.4 leads me to the inescapable conclusion that the MonadTrans class is incomplete. In an ideal world, this is what it should actually look like:

{-# LANGUAGE Rank2Types #-}

class MonadTrans t where
    lift  :: (Monad m, Monad (t m)) => m a -> t m a
    embed :: (Monad m, Monad (t m), Monad (t n))
          => (forall a .   m a -> t n a)
          -> (forall b . t m b -> t n b)
          -- This last forall is optional

(>|>)
 :: (Monad f, Monad g, Monad (t g), Monad (t h),
     MonadTrans t)
 => (forall a . f a -> t g a)
 -> (forall b . g b -> t h b)
 -> (forall c . f c -> t h c) -- This last forall is optional
(f >|> g) x = embed g (f x)

squash :: (Monad (t (t m)), Monad (t m), MonadTrans t)
       => t (t m) a -> t m a
squash = embed id

mapT
 :: (Monad m, Monad n, Monad (t m), Monad (t n), MonadTrans t)
 => (forall a . m a -> n a) -> t m b -> t n b
mapT morph = embed (lift . morph)

I can justify this additional method just by changing the names around and using a type operator:

{-# LANGUAGE Rank2Types, TypeOperators #-}

type a :~> b = forall r . a r -> b r

class MonadM m where
    returnM :: (Monad a, Monad (m a))
            =>  a :~> m a
    bindM   :: (Monad a, Monad (m a), Monad (m b))
            => (a :~> m b) -> (m a :~> m b)

(>|>) :: (Monad a, Monad b, Monad (m b), Monad (m c),
          MonadTrans m)
      => (a :~> m b) -> (b :~> m c) -> (a :~> m c)
(f >|> g) x = bindM g (f x)

joinM :: (Monad (m (m a)), Monad (m a), MonadTrans m)
       => m (m a) :~> m a
joinM = bindM id

fmapM
 :: (Monad a, Monad b, Monad (m a), Monad (m b), MonadTrans m)
 => (a :~> b) -> (m a :~> m b)
fmapM f = bindM (returnM . f)

In otherwords, I've stolen a page from Conor McBride's notebook and defined lift and embed as a higher-order monad in the category of monad morphisms. Going back to the previous names, we can establish that certain laws must hold:

-- Categorical version
lift >|> f = f
f >|> lift = f
(f >|> g) >|> h = f >|> (g >|> h)

-- bind/return version
embed lift m = m
embed f (lift m) = f m
embed g (embed f m) = embed (\x -> embed g (f x)) m

-- join/return version
squash (lift m) = m
squash (mapT lift m) = m
squash (squash m) = squash (mapT squash m)

Obviously, I won't suggest we break the existing MonadTrans class by adding an additional method. All we have to do is simply define a new MonadM class and make all existing monad transformers instances of it and possibly make MonadTrans a super-class of it.

I'll bet more experienced Haskell programmers have wanted mapT or squash in one form or another. The above type-class provides a uniform interface to these operations, so that you don't have to rely on transformer-specific functions like mapStateT or mapMaybeT.

Note that all monad transformers have a sensible instance for MonadM that obeys the above laws. Usually the easiest route is to first define squash (i.e. joinM) and mapT (i.e. fmapM). mapT is usually very straight-forward to write and simply involves type-chasing. squash simply takes the inner monad transformer and combines its operations with the outer monad transformer. Once you define these two, then you can easily define embed:

-- i.e.: (bindM f) = joinM . fmapM f
embed f = squash . mapT f

In the near future I will release a package containing this type-class and appropriate instances for the standard monad transformers. Additionally, the pipes-2.4 release will include an extra motivation for defining the above type-class, besides the obvious utility of having mapT and squash functions.