{-# OPTIONS_GHC -fglasgow-exts
                -fallow-overlapping-instances
                -fallow-undecidable-instances #-}

import Control.Monad.Trans (MonadTrans) 
import Control.Monad.State (StateT, evalStateT, get, put, lift)

-- StateA

type StateA = [Integer]                                                         

newtype MonadAT m a = MonadAT (StateT StateA m a)
    deriving (Monad, MonadTrans)

class Monad m => MonadA m where
    getA :: m StateA
    putA :: StateA -> m ()

instance Monad m => MonadA (MonadAT m) where
    getA = MonadAT get
    putA = MonadAT . put

instance (MonadTrans t, MonadA m, Monad (t m)) => MonadA (t m) where
    getA = lift getA
    putA = lift . putA

evalAT :: Monad m => MonadAT m a -> StateA -> m a
evalAT (MonadAT x) = evalStateT x

-- StateB

type StateB = [Integer]                                                         

newtype MonadBT m a = MonadBT (StateT StateB m a)
    deriving (Monad, MonadTrans)

class Monad m => MonadB m where
    getB :: m StateB
    putB :: StateB -> m ()

instance Monad m => MonadB (MonadBT m) where
    getB = MonadBT get
    putB = MonadBT . put

instance (MonadTrans t, MonadB m, Monad (t m)) => MonadB (t m) where
    getB = lift getB
    putB = lift . putB

evalBT :: Monad m => MonadBT m a -> StateB -> m a
evalBT (MonadBT x) = evalStateT x

-- The program

type Monads = MonadBT (MonadAT IO)

main :: IO ()
main = do res <- evalAT (evalBT exec []) []
          print res

exec :: Monads (StateA, StateB)
exec = do foo
          bar
          foo
          foo
          bar
          a <- getA
          b <- getB
          return (a, b)

foo :: MonadA m => m ()
foo = do st <- getA
         putA (1 : st)

bar :: MonadB m => m ()
bar = do st <- getB
         putB (2 : st)