Gabriel Gonzales's _Scrap your type classes_ https://www.haskellforall.com/2012/05/scrap-your-type-classes.html

gistfile1.hs

{-# LANGUAGE Rank2Types, ScopedTypeVariables #-}

newtype StateT  s m a = StateT   { runStateT   :: s -> m (a, s) }
newtype ReaderT r m a = ReaderT  { runReaderT  :: r -> m a      }
newtype Identity    a = Identity { runIdentity :: a             }

{- class Monad m where
       return :: a -> m a
       (>>=) :: m a -> (a -> m b) -> m b -}
data MonadI m = MonadI {
    _return :: forall a . a -> m a,
    _bind   :: forall a b . m a -> (a -> m b) -> m b }

{- class MonadTrans t where
       lift :: Monad m => m a -> t m a -}
data MonadTransI t = MonadTransI {
    _lift :: forall a m . MonadI m -> m a -> t m a }

{- class Monad m => MonadState s m | m -> s where
       get :: m s
       put :: s -> m ()
       state :: (s -> (a, s)) -> m a -}
data MonadStateI s m = MonadStateI {
    -- This next line is the secret sauce
    _monad'Super'MonadState :: MonadI m,
    _put :: s -> m (),
    _get :: m s,
    _state :: forall a . (s -> (a, s)) -> m a }

{- class Monad m => Monadreader r m | m -> r where
       ask    :: m r
       local  :: (r -> r) -> m a -> m a
       reader :: (r -> a) -> m a -}
data MonadReaderI r m = MonadReaderI {
    _monad'Super'MonadReader :: MonadI m,
    _ask    :: m r,
    _local  :: forall a . (r -> r) -> m a -> m a,
    _reader :: forall a . (r -> a) -> m a }

{- get :: (Monad m) => StateT s m s
   get = StateT $ \s -> return (s, s) -}
get :: MonadI m -> StateT s m s
get i = StateT $ \s -> (_return i) (s, s)

{- put :: (Monad m) => s -> StateT s m ()
   put s = StateT $ \_ -> return ((), s) -}
put :: MonadI m -> s -> StateT s m ()
put i s = StateT $ \_ -> (_return i) ((), s)

{- state :: (Monad m) => (s -> (a, s)) -> StateT s m a
   state f = StateT (return . f) -}
state :: MonadI m -> (s -> (a, s)) -> StateT s m a
state i f = StateT (_return i . f)

{- ask :: (Monad m) => ReaderT r m r
   ask = ReaderT return -}
ask :: MonadI m -> ReaderT r m r
ask i = ReaderT (_return i)

{- local :: (Monad m) =>
       (r -> r) -> ReaderT r m a -> ReaderT r m a
   local f m = ReaderT $ runReaderT m . f -}
local :: MonadI m -> (r -> r) -> ReaderT r m a -> ReaderT r m a
local _ f m = ReaderT $ runReaderT m . f

{- reader :: (Monad m) => (r -> a) -> ReaderT r m a
   reader f = ReaderT (return . f) -}
reader :: MonadI m -> (r -> a) -> ReaderT r m a
reader i f = ReaderT (_return i . f)

{- instance Monad (Identity) where
       return = Identity
       m >>= k = k $ runIdentity m -}
monad'Identity :: MonadI Identity
monad'Identity = MonadI {
    _return = Identity,
    _bind = \m k -> k $ runIdentity m }

{- instance (Monad m) => Monad (StateT s m) where
       return a = state $ \s -> (a, s)
       m >>= k  = StateT $ \s -> do
           (a, s') <- runStateT m s
           runStateT (k a) s' -}
monad'StateT :: forall m s. MonadI m -> MonadI (StateT s m)
monad'StateT i =
    let 
      (>>=) :: forall a b. m a ->  (a -> m b) -> m b
      (>>=) = _bind i
    in MonadI {
            _return = \a -> state i $ \s -> (a, s),
            _bind   = \m k -> StateT $ \s ->
                          runStateT m s >>= \(a, s') ->
                          runStateT (k a) s' }

{- instance (Monad m) => Monad (ReaderT s m) where
       return = lift . return
       m >>= k = ReaderT $ \r -> do
           a <- runReaderT m r
           runReaderT (k a) r -}
monad'ReaderT :: forall m s. MonadI m -> MonadI (ReaderT s m )
monad'ReaderT i =
    let 
        return :: forall a. a -> m a
        return = _return i
        (>>=) :: forall a b. m a ->  (a -> m b) -> m b
        (>>=) = _bind i
     in MonadI {
            _return = _lift monadTrans'ReaderT i . return,
            _bind = \m k -> ReaderT $ \r ->
                runReaderT m r >>= \a ->
                runReaderT (k a) r }

{- instance MonadTrans StateT where
       lift m = StateT $ \s -> do
           a <- m
           return (a, s) -}
monadTrans'StateT :: MonadTransI (StateT s)
monadTrans'StateT = MonadTransI {
    _lift = \i m ->
        let return = _return i
            (>>=)  = _bind   i
         in StateT $ \s ->
                m >>= \a ->
                return (a, s) }

{- instance MonadTrans ReaderT where
       lift m = ReaderT (const m) -}
monadTrans'ReaderT :: MonadTransI (ReaderT r)
monadTrans'ReaderT = MonadTransI {
    _lift = \_ m -> ReaderT (const m) }

{- instance (Monad m) => MonadState s (StateT s m) where
       get = get -- from Control.Monad.Trans.State
       put = put
       state = state -}
monadState'StateT :: MonadI m -> MonadStateI s (StateT s m)
monadState'StateT i = MonadStateI {
    _monad'Super'MonadState = monad'StateT i,
    _get   = get   i,
    _put   = put   i,
    _state = state i }

{- instance (MonadState s m) => MonadState s (ReaderT r m) where
       get   = lift get
       put   = lift . put
       state = lift . state -}
monadState'ReaderT :: forall s r m.
    MonadStateI s m -> MonadStateI s (ReaderT r m)
monadState'ReaderT i =
    let 
        monad'm = _monad'Super'MonadState i
        lift :: forall a. m a -> ReaderT r m a
        lift = _lift monadTrans'ReaderT monad'm
     in MonadStateI {
            _monad'Super'MonadState = monad'ReaderT monad'm,
            _get   = lift $ _get   i,
            _put   = lift . _put   i,
            _state = lift . _state i }

{- instance Monad m => MonadReader r (ReaderT r m) where
       ask = ask
       local = local
       reader = reader -}
monadReader'ReaderT :: MonadI m -> MonadReaderI r (ReaderT r m )
monadReader'ReaderT i = MonadReaderI {
    _monad'Super'MonadReader = monad'ReaderT i,
    _ask    = ask    i,
    _local  = local  i,
    _reader = reader i }

{- instance (MonadReader r m) => MonadReader r (StateT s m) where
       ask = lift ask
       local = \f m -> StateT $ local f . runStateT m
       reader = lift . reader -}
monadReader'StateT ::
    forall s r m. 
    MonadReaderI r m -> MonadReaderI r (StateT s m)
monadReader'StateT i =
    let monad'm = _monad'Super'MonadReader i
        lift :: forall r a. m a -> StateT r m a
        lift = _lift monadTrans'StateT monad'm
     in MonadReaderI {
            _monad'Super'MonadReader = monad'StateT monad'm,
            _ask = lift $ _ask i,
            _local = \f m -> StateT $ _local i f . runStateT m,
            _reader = lift . _reader i }

{- test :: (MonadState a m, MonadReader a m) => m ()
   test = ask >>= put -}
test :: MonadStateI a m -> MonadReaderI a m -> m ()
test = \is ir -> let (>>=)   = _bind (_monad'Super'MonadState is)
                  in _ask ir >>= _put is

example1 :: ReaderT a (StateT a Identity) ()
example1 = test
    (monadState'ReaderT $ monadState'StateT $ monad'Identity)
    (monadReader'ReaderT $ monad'StateT $ monad'Identity)

example2 :: StateT a (ReaderT a Identity) ()
example2 = test
    (monadState'StateT $ monad'ReaderT $ monad'Identity)
    (monadReader'StateT $ monadReader'ReaderT $ monad'Identity)

run1, run2 :: ((), Char)
run1 = runIdentity $ runStateT (runReaderT example1 'A') 'B'
run2 = runIdentity $ runReaderT (runStateT example2 'B') 'A'