MonadTrans with explicit dictionaries

gistfile1.hs

{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ConstraintKinds, GADTs #-}
{-# LANGUAGE FlexibleContexts #-}

import GHC.Exts

-- see http://www.reddit.com/r/haskell/comments/117r1p/whats_wrong_with_ghc_haskells_current_constraint/

data Dict :: Constraint -> * where
    Dict :: c => Dict c

class MonadTrans (t :: (* -> *) -> (* -> *)) where
    lift :: Monad m => m r -> t m r
    isMonadTrans :: Dict (Monad m) -> Dict (Monad (t m))

-- MonadTrans for composition

data Compose (t1 :: (* -> *) -> (* -> *)) (t2 :: (* -> *) -> (* -> *)) m r = C { unC :: t1 (t2 m) r }

instance Monad (t1 (t2 m)) => Monad (Compose t1 t2 m) where
    return = C . return
    x >>= y = C ((unC x) >>= (unC . y))

instance (MonadTrans t1, MonadTrans t2) => MonadTrans (Compose t1 t2) where
    lift = C . liftD (isMonadTrans Dict) . liftD Dict
     where
       liftD :: MonadTrans t => Dict (Monad m) -> m a -> t m a
       liftD Dict = lift
    isMonadTrans = aux . isMonadTrans . isMonadTrans
      where
        aux :: Dict (Monad (t1 (t2 m))) -> Dict (Monad (Compose t1 t2 m))
        aux Dict = Dict

-- just as an example

data ReaderT e m r = R { unR :: e -> m r }

instance Monad m => Monad (ReaderT e m) where
    return = R . const . return
    x >>= y = R (\ e -> (unR x e) >>= (($e) . unR . y))

instance MonadTrans (ReaderT e) where
    lift = R . const
    isMonadTrans Dict = Dict