1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

module Control.Monad.Trans.Maybe where

import Control.Monad.Trans.Class
import Control.Monad.IO.Class

newtype MaybeT m a = MaybeT {
    runMaybeT :: m (Maybe a)
  }

instance Functor Maybe where
  fmap _ Nothing  = Nothing
  fmap f (Just x) = Just (f x)

instance Functor m => Functor (MaybeT m) where
  fmap f m = MaybeT (fmap (fmap f) (runMaybeT m))

-- instance Monad m => Applicative (MaybeT m) where
--   pure x = MaybeT (return (Just x))
-- 
--   mf <*> m = MaybeT $ do f <- runMaybeT mf
--                          v <- runMaybeT m
--                          return (f <*> v)

-- instance Monad m => Alternative (MaybeT m) where
--   empty = MaybeT (return Nothing)
-- 
--   x <|> y = MaybeT $ do v <- runMaybeT x
--                         case v of
--                           Nothing -> runMaybeT y
--                           Just _  -> return v

instance Monad m => Monad (MaybeT m) where
  return x = MaybeT (return (Just x)) -- pure

  m >>= f = MaybeT $ do v <- runMaybeT m
                        maybe (return Nothing) (runMaybeT . f) v

-- instance MonadFail m => MonadFail (MaybeT m) where
--   fail _ = MaybeT (return Nothing)

-- instance MonadTrans MaybeT where
--   lift m = MaybeT (fmap Just m)

-- instance MonadIO m => MonadIO (MaybeT m) where
--   liftIO = lift . Control.Monad.IO.Class.liftIO

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