expand definitions of Applicative and Alternative methods (fixes #4)
[packages/transformers.git] / Control / Monad / Trans / Maybe.hs
1 {-# LANGUAGE CPP #-}
2 #if __GLASGOW_HASKELL__ >= 702
3 {-# LANGUAGE Safe #-}
4 #endif
5 #if __GLASGOW_HASKELL__ >= 710
6 {-# LANGUAGE AutoDeriveTypeable #-}
7 #endif
8 -----------------------------------------------------------------------------
9 -- |
10 -- Module : Control.Monad.Trans.Maybe
11 -- Copyright : (c) 2007 Yitzak Gale, Eric Kidd
12 -- License : BSD-style (see the file LICENSE)
13 --
14 -- Maintainer : R.Paterson@city.ac.uk
15 -- Stability : experimental
16 -- Portability : portable
17 --
18 -- The 'MaybeT' monad transformer extends a monad with the ability to exit
19 -- the computation without returning a value.
20 --
21 -- A sequence of actions produces a value only if all the actions in
22 -- the sequence do. If one exits, the rest of the sequence is skipped
23 -- and the composite action exits.
24 --
25 -- For a variant allowing a range of exception values, see
26 -- "Control.Monad.Trans.Except".
27 -----------------------------------------------------------------------------
28
29 module Control.Monad.Trans.Maybe (
30 -- * The MaybeT monad transformer
31 MaybeT(..),
32 mapMaybeT,
33 -- * Conversion
34 maybeToExceptT,
35 exceptToMaybeT,
36 -- * Lifting other operations
37 liftCallCC,
38 liftCatch,
39 liftListen,
40 liftPass,
41 ) where
42
43 import Control.Monad.IO.Class
44 import Control.Monad.Signatures
45 import Control.Monad.Trans.Class
46 import Control.Monad.Trans.Except (ExceptT(..))
47 import Data.Functor.Classes
48
49 import Control.Applicative
50 import Control.Monad (MonadPlus(mzero, mplus), liftM, ap)
51 import Control.Monad.Fix (MonadFix(mfix))
52 #if MIN_VERSION_base(4,4,0)
53 import Control.Monad.Zip (MonadZip(mzipWith))
54 #endif
55 import Data.Foldable (Foldable(foldMap))
56 import Data.Maybe (fromMaybe)
57 import Data.Traversable (Traversable(traverse))
58
59 -- | The parameterizable maybe monad, obtained by composing an arbitrary
60 -- monad with the 'Maybe' monad.
61 --
62 -- Computations are actions that may produce a value or exit.
63 --
64 -- The 'return' function yields a computation that produces that
65 -- value, while @>>=@ sequences two subcomputations, exiting if either
66 -- computation does.
67 newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }
68
69 instance (Eq1 m) => Eq1 (MaybeT m) where
70 eqWith eq (MaybeT x) (MaybeT y) = eqWith (eqWith eq) x y
71
72 instance (Ord1 m) => Ord1 (MaybeT m) where
73 compareWith comp (MaybeT x) (MaybeT y) = compareWith (compareWith comp) x y
74
75 instance (Read1 m) => Read1 (MaybeT m) where
76 readsPrecWith rp = readsData $
77 readsUnaryWith (readsPrecWith (readsPrecWith rp)) "MaybeT" MaybeT
78
79 instance (Show1 m) => Show1 (MaybeT m) where
80 showsPrecWith sp d (MaybeT m) =
81 showsUnaryWith (showsPrecWith (showsPrecWith sp)) "MaybeT" d m
82
83 instance (Eq1 m, Eq a) => Eq (MaybeT m a) where (==) = eq1
84 instance (Ord1 m, Ord a) => Ord (MaybeT m a) where compare = compare1
85 instance (Read1 m, Read a) => Read (MaybeT m a) where readsPrec = readsPrec1
86 instance (Show1 m, Show a) => Show (MaybeT m a) where showsPrec = showsPrec1
87
88 -- | Transform the computation inside a @MaybeT@.
89 --
90 -- * @'runMaybeT' ('mapMaybeT' f m) = f ('runMaybeT' m)@
91 mapMaybeT :: (m (Maybe a) -> n (Maybe b)) -> MaybeT m a -> MaybeT n b
92 mapMaybeT f = MaybeT . f . runMaybeT
93
94 -- | Convert a 'MaybeT' computation to 'ExceptT', with a default
95 -- exception value.
96 maybeToExceptT :: (Functor m) => e -> MaybeT m a -> ExceptT e m a
97 maybeToExceptT e (MaybeT m) = ExceptT $ fmap (maybe (Left e) Right) m
98
99 -- | Convert a 'ExceptT' computation to 'MaybeT', discarding the
100 -- value of any exception.
101 exceptToMaybeT :: (Functor m) => ExceptT e m a -> MaybeT m a
102 exceptToMaybeT (ExceptT m) = MaybeT $ fmap (either (const Nothing) Just) m
103
104 instance (Functor m) => Functor (MaybeT m) where
105 fmap f = mapMaybeT (fmap (fmap f))
106
107 instance (Foldable f) => Foldable (MaybeT f) where
108 foldMap f (MaybeT a) = foldMap (foldMap f) a
109
110 instance (Traversable f) => Traversable (MaybeT f) where
111 traverse f (MaybeT a) = MaybeT <$> traverse (traverse f) a
112
113 instance (Functor m, Monad m) => Applicative (MaybeT m) where
114 pure = lift . return
115 mf <*> mx = MaybeT $ do
116 mb_f <- runMaybeT mf
117 case mb_f of
118 Nothing -> return Nothing
119 Just f -> do
120 mb_x <- runMaybeT mx
121 case mb_x of
122 Nothing -> return Nothing
123 Just x -> return (Just (f x))
124
125 instance (Functor m, Monad m) => Alternative (MaybeT m) where
126 empty = MaybeT (return Nothing)
127 x <|> y = MaybeT $ do
128 v <- runMaybeT x
129 case v of
130 Nothing -> runMaybeT y
131 Just _ -> return v
132
133 instance (Monad m) => Monad (MaybeT m) where
134 fail _ = MaybeT (return Nothing)
135 return = lift . return
136 x >>= f = MaybeT $ do
137 v <- runMaybeT x
138 case v of
139 Nothing -> return Nothing
140 Just y -> runMaybeT (f y)
141
142 instance (Monad m) => MonadPlus (MaybeT m) where
143 mzero = MaybeT (return Nothing)
144 mplus x y = MaybeT $ do
145 v <- runMaybeT x
146 case v of
147 Nothing -> runMaybeT y
148 Just _ -> return v
149
150 instance (MonadFix m) => MonadFix (MaybeT m) where
151 mfix f = MaybeT (mfix (runMaybeT . f . fromMaybe bomb))
152 where bomb = error "mfix (MaybeT): inner computation returned Nothing"
153
154 instance MonadTrans MaybeT where
155 lift = MaybeT . liftM Just
156
157 instance (MonadIO m) => MonadIO (MaybeT m) where
158 liftIO = lift . liftIO
159
160 #if MIN_VERSION_base(4,4,0)
161 instance (MonadZip m) => MonadZip (MaybeT m) where
162 mzipWith f (MaybeT a) (MaybeT b) = MaybeT $ mzipWith (liftA2 f) a b
163 #endif
164
165 -- | Lift a @callCC@ operation to the new monad.
166 liftCallCC :: CallCC m (Maybe a) (Maybe b) -> CallCC (MaybeT m) a b
167 liftCallCC callCC f =
168 MaybeT $ callCC $ \ c -> runMaybeT (f (MaybeT . c . Just))
169
170 -- | Lift a @catchE@ operation to the new monad.
171 liftCatch :: Catch e m (Maybe a) -> Catch e (MaybeT m) a
172 liftCatch f m h = MaybeT $ f (runMaybeT m) (runMaybeT . h)
173
174 -- | Lift a @listen@ operation to the new monad.
175 liftListen :: (Monad m) => Listen w m (Maybe a) -> Listen w (MaybeT m) a
176 liftListen listen = mapMaybeT $ \ m -> do
177 (a, w) <- listen m
178 return $! fmap (\ r -> (r, w)) a
179
180 -- | Lift a @pass@ operation to the new monad.
181 liftPass :: (Monad m) => Pass w m (Maybe a) -> Pass w (MaybeT m) a
182 liftPass pass = mapMaybeT $ \ m -> pass $ do
183 a <- m
184 return $! case a of
185 Nothing -> (Nothing, id)
186 Just (v, f) -> (Just v, f)