Indexed functor and monad classes for common monad transformers

gistfile1.hs

{-# LANGUAGE Rank2Types #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State
import Control.Monad.Trans.Writer
import Data.Monoid

class IFunctor h where
  fmapI :: (forall a. f a -> g a) -> h f a -> h g a

instance IFunctor (ReaderT r) where
  fmapI f (ReaderT r) = ReaderT (f . r)

instance IFunctor (StateT s) where
  fmapI f (StateT s) = StateT (f . s)

instance IFunctor (WriterT w) where
  fmapI f (WriterT w) = WriterT (f w)

instance IFunctor MaybeT where
  fmapI f (MaybeT m) = MaybeT (f m)

class IFunctor h => IMonad h where
  bindI :: Functor g => (forall a. f a -> h g a) -> h f a -> h g a
  joinI :: Functor f => h (h f) a -> h f a

instance IMonad (ReaderT r) where
  bindI f (ReaderT r) = ReaderT (\x -> runReaderT (f (r x)) x)
  joinI (ReaderT r) = ReaderT (\x -> runReaderT (r x) x)

instance IMonad (StateT s) where
  -- Not sure about this one, the 'fst' throws away the inner state.
  bindI f (StateT s) = StateT (\x -> fst <$> runStateT (f (s x)) x)
  joinI (StateT s) = StateT (\x -> fst <$> runStateT (s x) x)

instance Monoid w => IMonad (WriterT w) where
  bindI f (WriterT w) = WriterT ((\((b, w'), w) -> (b, w' `mappend` w)) <$> runWriterT (f w))
  joinI = undefined

instance IMonad MaybeT where
  bindI f (MaybeT m) = mergeMaybeT (f m)
    where
      mergeMaybeT :: Functor m => MaybeT m (Maybe a) -> MaybeT m a
      mergeMaybeT (MaybeT m) = MaybeT (join <$> m)
  joinI = undefined