Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 59 lines (48 sloc) 2.016 kb
aa882ef @hiratara more samples
authored
1 {-# LANGUAGE UndecidableInstances, FlexibleInstances, MultiParamTypeClasses #-}
1f3b67d @hiratara more samples
authored
2 module MaybeT where
3
aa882ef @hiratara more samples
authored
4 import Control.Monad.Trans
5 import Control.Monad.State
1f3b67d @hiratara more samples
authored
6 import Control.Monad.Writer
aa882ef @hiratara more samples
authored
7 import Control.Monad ()
8
9 newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
10
11 bindMT :: (Monad m) => MaybeT m a -> (a -> MaybeT m b) -> MaybeT m b
12 -- (MaybeT mm) `bindMT` f = MaybeT $ do
13 -- m <- mm
14 -- case m of
15 -- Nothing -> return Nothing
16 -- Just x -> runMaybeT . f $ x
17 (MaybeT mm) `bindMT` f = MaybeT $ mm >>= maybe (return Nothing) (runMaybeT . f)
18
19 returnMT :: (Monad m) => a -> MaybeT m a
20 returnMT a = MaybeT $ return (Just a)
21
22 failMT :: (Monad m) => t -> MaybeT m a
23 failMT _ = MaybeT $ return Nothing
24
25 instance (Monad m) => Monad (MaybeT m) where
26 return = returnMT
27 (>>=) = bindMT
28 fail = failMT
29
30 instance MonadTrans MaybeT where
31 -- lift m = MaybeT (Just `liftM` m)
32 lift m = MaybeT $ return <$> m
33 where (<$>) = liftM
34
35 instance (MonadIO m) => MonadIO (MaybeT m) where
36 liftIO = lift . liftIO
37
38 instance (MonadState s m) => MonadState s (MaybeT m) where
39 get = lift get
40 put = lift . put
1f3b67d @hiratara more samples
authored
41
42 instance (MonadWriter s m) => MonadWriter s (MaybeT m) where
43 tell = lift . tell
44 -- listen (MaybeT m) = MaybeT $ do
45 -- (a, w) <- listen m
46 -- case a of
47 -- Just a' -> return $ Just (a', w)
48 -- Nothing -> return Nothing
49 listen (MaybeT m) = MaybeT $ do
50 (a, w) <- listen m
51 case a of
52 Just a' -> return $ Just (a', w)
53 Nothing -> return Nothing
54 pass (MaybeT m) = MaybeT $ do
55 x <- m
56 case x of
57 Just x' -> (pass $ return x') >>= (return . Just)
58 Nothing -> return Nothing
Something went wrong with that request. Please try again.