adc52828ea7aa48715571e1d21480961b4a09c5f
[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 = return
115 (<*>) = ap
116
117 instance (Functor m, Monad m) => Alternative (MaybeT m) where
118 empty = mzero
119 (<|>) = mplus
120
121 instance (Monad m) => Monad (MaybeT m) where
122 fail _ = MaybeT (return Nothing)
123 return = lift . return
124 x >>= f = MaybeT $ do
125 v <- runMaybeT x
126 case v of
127 Nothing -> return Nothing
128 Just y -> runMaybeT (f y)
129
130 instance (Monad m) => MonadPlus (MaybeT m) where
131 mzero = MaybeT (return Nothing)
132 mplus x y = MaybeT $ do
133 v <- runMaybeT x
134 case v of
135 Nothing -> runMaybeT y
136 Just _ -> return v
137
138 instance (MonadFix m) => MonadFix (MaybeT m) where
139 mfix f = MaybeT (mfix (runMaybeT . f . fromMaybe bomb))
140 where bomb = error "mfix (MaybeT): inner computation returned Nothing"
141
142 instance MonadTrans MaybeT where
143 lift = MaybeT . liftM Just
144
145 instance (MonadIO m) => MonadIO (MaybeT m) where
146 liftIO = lift . liftIO
147
148 #if MIN_VERSION_base(4,4,0)
149 instance (MonadZip m) => MonadZip (MaybeT m) where
150 mzipWith f (MaybeT a) (MaybeT b) = MaybeT $ mzipWith (liftA2 f) a b
151 #endif
152
153 -- | Lift a @callCC@ operation to the new monad.
154 liftCallCC :: CallCC m (Maybe a) (Maybe b) -> CallCC (MaybeT m) a b
155 liftCallCC callCC f =
156 MaybeT $ callCC $ \ c -> runMaybeT (f (MaybeT . c . Just))
157
158 -- | Lift a @catchE@ operation to the new monad.
159 liftCatch :: Catch e m (Maybe a) -> Catch e (MaybeT m) a
160 liftCatch f m h = MaybeT $ f (runMaybeT m) (runMaybeT . h)
161
162 -- | Lift a @listen@ operation to the new monad.
163 liftListen :: (Monad m) => Listen w m (Maybe a) -> Listen w (MaybeT m) a
164 liftListen listen = mapMaybeT $ \ m -> do
165 (a, w) <- listen m
166 return $! fmap (\ r -> (r, w)) a
167
168 -- | Lift a @pass@ operation to the new monad.
169 liftPass :: (Monad m) => Pass w m (Maybe a) -> Pass w (MaybeT m) a
170 liftPass pass = mapMaybeT $ \ m -> pass $ do
171 a <- m
172 return $! case a of
173 Nothing -> (Nothing, id)
174 Just (v, f) -> (Just v, f)