Pasted

-- http://cmsc-16100.cs.uchicago.edu/2018-autumn/ExtraNotes/monad-transformers/
 
module MaybeT where
 
import Control.Applicative
import Control.Monad
import Control.Monad.Trans.Class
import Data.Char
 
readInt0 :: IO (Maybe Int)
readInt0 = do
  s <- getLine
  if all isDigit s
    then pure $ Just (read s)
    else pure Nothing
 
readInt :: IO (Maybe Int)
readInt = do
  s <- getLine
  pure $ do
    guard (all isDigit s)
    Just (read s)
 
addThree0 :: IO (Maybe Int)
addThree0 = do
  mi <- readInt
  mj <- readInt
  mk <- readInt
  case (mi, mj, mk) of
    (Just i, Just j, Just k) -> pure $ Just (i+j+k)
    _                        -> pure Nothing
 
addThree1 :: IO (Maybe Int)
addThree1 = do
  mi <- readInt
  mj <- readInt
  mk <- readInt
  pure $ do
    i <- mi
    j <- mj
    k <- mk
    pure $ i + j + k
 
addThree2 :: IO (Maybe Int)
addThree2 = do
  mi <- readInt
  case mi of
    Nothing -> pure Nothing
    Just i  -> do
      mj <- readInt
      case mj of
        Nothing -> pure Nothing
        Just j -> do
          mk <- readInt
          case mk of
            Nothing -> pure Nothing
            Just k  -> pure $ Just (i+j+k)
 
bindMonadPlusMaybe :: Monad m => m (Maybe a) -> (a -> m (Maybe b)) -> m (Maybe b)
action `bindMonadPlusMaybe` f = do
  ma <- action
  case ma of
    Nothing -> pure Nothing
    Just a  -> f a
 
pureMonadPlusMaybe :: Monad m => a -> m (Maybe a)
pureMonadPlusMaybe a = pure $ Just a
 
addThree :: IO (Maybe Int)
addThree =
  readInt `bindMonadPlusMaybe` \i ->
  readInt `bindMonadPlusMaybe` \j ->
  readInt `bindMonadPlusMaybe` \k ->
  pureMonadPlusMaybe (i+j+k)
 
----------------------------------------------------------------------
 
newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
 
instance Monad m => Monad (MaybeT m) where
 -- return :: a -> MaybeT m a
    return = MaybeT . return . Just
 
 -- (>>=) :: MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b
    MaybeT mma >>= f = MaybeT $ do
      ma <- mma
      case ma of
        Nothing -> pure Nothing
        Just a  -> runMaybeT $ f a
 
instance Monad m => Functor (MaybeT m) where
    fmap f x = pure f <*> x 
 
instance Monad m => Applicative (MaybeT m) where
    pure = return
    (<*>) = ap
 
instance MonadTrans MaybeT where
 -- lift :: Monad m => m a -> MaybeT m a
 -- lift = liftMaybeT
 -- lift ma = MaybeT (fmap Just ma)
    lift = MaybeT . fmap Just
 
instance (Monad m, Alternative m) => Alternative (MaybeT m) where
 -- empty :: MaybeT m a
    empty = MaybeT empty
 
 -- (<|>) :: MaybeT m a -> MaybeT m a -> MaybeT m a
    MaybeT mma <|> MaybeT mmb = MaybeT $ mma <|> mmb
 
----------------------------------------------------------------------
 
 
liftMaybeT :: Monad m => m a -> MaybeT m a
liftMaybeT ma = MaybeT (fmap Just ma)
 
guardMaybeT :: Monad m => Bool -> MaybeT m ()
guardMaybeT True  = MaybeT $ pure $ Just ()
guardMaybeT False = MaybeT $ pure Nothing
 
maybeReadInt0 :: MaybeT IO Int
maybeReadInt0 = do
  s <- liftMaybeT getLine
  if all isDigit s
    then pure $ read s
    else MaybeT $ pure Nothing
 
maybeAddThree0 :: MaybeT IO Int
maybeAddThree0 = do
  i <- maybeReadInt0
  j <- maybeReadInt0
  k <- maybeReadInt0
  pure $ i+j+k
 
maybeReadInt1 :: MaybeT IO Int
maybeReadInt1 = do
  s <- liftMaybeT getLine
  guardMaybeT $ all isDigit s
  pure $ read s
 
maybeReadInt :: MaybeT IO Int
maybeReadInt = do
  s <- lift getLine
  guard $ all isDigit s
  pure $ read s
 
maybeAddThree :: MaybeT IO Int
maybeAddThree = do
  i <- maybeReadInt
  j <- maybeReadInt
  k <- maybeReadInt
  pure $ i+j+k