MaybeT from zero to hero

-- 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