Play with MaybeT monad transformer a bit.

monad_transformers_play.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Control.Applicative
import Control.Monad
import Control.Monad.Reader
import Control.Monad.Maybe
import Control.Monad.CatchIO hiding (Handler)
import Control.Monad.Trans
import Prelude hiding (catch)

newtype Foo a = Foo { runF :: MaybeT MyHandler a }
              deriving (Monad, MonadCatchIO, MonadIO, MonadPlus, Functor,
                        MonadReader Env)

runFoo :: Env -> Foo a -> IO (Maybe a)
runFoo env foo = (runMyHandler env (runMaybeT (runF foo)))

instance (MonadCatchIO m) => MonadCatchIO (MaybeT m) where
    m `catch` f = mapMaybeT (\m' -> m' `catch` \e -> runMaybeT $ f e) m
    block = mapMaybeT block
    unblock = mapMaybeT unblock

mapMaybeT :: (m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
mapMaybeT f = MaybeT . f . runMaybeT

data Env = Env { howCool :: Int }

newtype MyHandler a = MyHandler { runH :: ReaderT Env IO a }
                    deriving (Monad, Functor, MonadReader Env, MonadIO,
                              MonadCatchIO)

runMyHandler :: Env -> (MyHandler a) -> IO a
runMyHandler env h = (runReaderT (runH h) env)

main :: IO ()
main = do
  res <- runMyHandler (Env 12) hndlr
  putStrLn (show res)
  mfoores <- runFoo (Env 13) foohdlr
  putStrLn $ show mfoores
  return ()

hndlr :: MyHandler Int
hndlr = do
  cool <- howCool <$> ask
  liftIO $ putStrLn $ "Cool points: " ++ (show cool)
  return 10

foohdlr :: Foo String
foohdlr = do
  cool <- howCool <$> ask
  liftIO $ putStrLn $ "Cool points (inside foo): " ++ (show cool)
  val <- nomatter
  return "aaaavavavava"

nomatter :: Foo (MyHandler (Maybe a))
-- nomatter = Foo $ MaybeT $ (return Nothing)
-- nomatter = Foo $ fail "bad :("
-- nomatter = fail "very bad"
-- nomatter = return $ return Nothing
nomatter = mzero