Main.hs

{-# LANGUAGE DeriveFunctor #-}
import Control.Applicative
import Control.Monad
import System.IO.Unsafe

class Monad m => Unwrappable m where
    unwrap :: m a -> a

newtype Compose u m a = Compose { runCompose :: m (u a) } deriving Functor

instance (Unwrappable u, Monad m) => Applicative (Compose u m) where
    pure = Compose . pure . pure
    (<*>) ab a = Compose $ liftA2 (<*>) (runCompose ab) (runCompose a)

instance (Unwrappable u, Monad m) => Monad (Compose u m) where
    return = pure
    (>>=) a f = Compose $ runCompose a >>= (runCompose . f . unwrap)

type MaybeT m a = Compose Maybe m a

instance Unwrappable Maybe where
    unwrap (Just a) = a
    unwrap Nothing = error "<< THIS IS WHY! RIGHT HERE!"

-- BONUS INSTANCE!1 :D
instance Unwrappable IO where
    unwrap = unsafePerformIO

-- P.S. From my exprience, Monad is not just a container of a single
-- value. On top of the "visible" value it also contains a internal
-- "invisible" state. By "unwrapping" a Monad (which is absolutely
-- needed to actually compose it) you simply lose that state.