expand definitions of Applicative and Alternative methods (fixes #4)
[darcs-mirrors/transformers.git] / Control / Monad / Trans / Except.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.Except
11 -- Copyright : (C) 2013 Ross Paterson
12 -- License : BSD-style (see the file LICENSE)
13 --
14 -- Maintainer : R.Paterson@city.ac.uk
15 -- Stability : experimental
16 -- Portability : portable
17 --
18 -- This monad transformer extends a monad with the ability throw exceptions.
19 --
20 -- A sequence of actions terminates normally, producing a value,
21 -- only if none of the actions in the sequence throws an exception.
22 -- If one throws an exception, the rest of the sequence is skipped and
23 -- the composite action exits with that exception.
24 --
25 -- If the value of the exception is not required, the variant in
26 -- "Control.Monad.Trans.Maybe" may be used instead.
27 -----------------------------------------------------------------------------
28
29 module Control.Monad.Trans.Except (
30 -- * The Except monad
31 Except,
32 except,
33 runExcept,
34 mapExcept,
35 withExcept,
36 -- * The ExceptT monad transformer
37 ExceptT(ExceptT),
38 runExceptT,
39 mapExceptT,
40 withExceptT,
41 -- * Exception operations
42 throwE,
43 catchE,
44 -- * Lifting other operations
45 liftCallCC,
46 liftListen,
47 liftPass,
48 ) where
49
50 import Control.Monad.IO.Class
51 import Control.Monad.Signatures
52 import Control.Monad.Trans.Class
53 import Data.Functor.Classes
54 import Data.Functor.Identity
55
56 import Control.Applicative
57 import Control.Monad
58 import Control.Monad.Fix
59 #if MIN_VERSION_base(4,4,0)
60 import Control.Monad.Zip (MonadZip(mzipWith))
61 #endif
62 import Data.Foldable (Foldable(foldMap))
63 import Data.Monoid
64 import Data.Traversable (Traversable(traverse))
65
66 -- | The parameterizable exception monad.
67 --
68 -- Computations are either exceptions or normal values.
69 --
70 -- The 'return' function returns a normal value, while @>>=@ exits on
71 -- the first exception. For a variant that continues after an error
72 -- and collects all the errors, see 'Control.Applicative.Lift.Errors'.
73 type Except e = ExceptT e Identity
74
75 -- | Constructor for computations in the exception monad.
76 -- (The inverse of 'runExcept').
77 except :: Either e a -> Except e a
78 except m = ExceptT (Identity m)
79
80 -- | Extractor for computations in the exception monad.
81 -- (The inverse of 'except').
82 runExcept :: Except e a -> Either e a
83 runExcept (ExceptT m) = runIdentity m
84
85 -- | Map the unwrapped computation using the given function.
86 --
87 -- * @'runExcept' ('mapExcept' f m) = f ('runExcept' m)@
88 mapExcept :: (Either e a -> Either e' b)
89 -> Except e a
90 -> Except e' b
91 mapExcept f = mapExceptT (Identity . f . runIdentity)
92
93 -- | Transform any exceptions thrown by the computation using the given
94 -- function (a specialization of 'withExceptT').
95 withExcept :: (e -> e') -> Except e a -> Except e' a
96 withExcept = withExceptT
97
98 -- | A monad transformer that adds exceptions to other monads.
99 --
100 -- @ExceptT@ constructs a monad parameterized over two things:
101 --
102 -- * e - The exception type.
103 --
104 -- * m - The inner monad.
105 --
106 -- The 'return' function yields a computation that produces the given
107 -- value, while @>>=@ sequences two subcomputations, exiting on the
108 -- first exception.
109 newtype ExceptT e m a = ExceptT (m (Either e a))
110
111 instance (Eq e, Eq1 m) => Eq1 (ExceptT e m) where
112 eqWith eq (ExceptT x) (ExceptT y) = eqWith (eqWith eq) x y
113
114 instance (Ord e, Ord1 m) => Ord1 (ExceptT e m) where
115 compareWith comp (ExceptT x) (ExceptT y) =
116 compareWith (compareWith comp) x y
117
118 instance (Read e, Read1 m) => Read1 (ExceptT e m) where
119 readsPrecWith rp = readsData $
120 readsUnaryWith (readsPrecWith (readsPrecWith rp)) "ExceptT" ExceptT
121
122 instance (Show e, Show1 m) => Show1 (ExceptT e m) where
123 showsPrecWith sp d (ExceptT m) =
124 showsUnaryWith (showsPrecWith (showsPrecWith sp)) "ExceptT" d m
125
126 instance (Eq e, Eq1 m, Eq a) => Eq (ExceptT e m a) where (==) = eq1
127 instance (Ord e, Ord1 m, Ord a) => Ord (ExceptT e m a) where compare = compare1
128 instance (Read e, Read1 m, Read a) => Read (ExceptT e m a) where
129 readsPrec = readsPrec1
130 instance (Show e, Show1 m, Show a) => Show (ExceptT e m a) where
131 showsPrec = showsPrec1
132
133 -- | The inverse of 'ExceptT'.
134 runExceptT :: ExceptT e m a -> m (Either e a)
135 runExceptT (ExceptT m) = m
136
137 -- | Map the unwrapped computation using the given function.
138 --
139 -- * @'runExceptT' ('mapExceptT' f m) = f ('runExceptT' m)@
140 mapExceptT :: (m (Either e a) -> n (Either e' b))
141 -> ExceptT e m a
142 -> ExceptT e' n b
143 mapExceptT f m = ExceptT $ f (runExceptT m)
144
145 -- | Transform any exceptions thrown by the computation using the
146 -- given function.
147 withExceptT :: (Functor m) => (e -> e') -> ExceptT e m a -> ExceptT e' m a
148 withExceptT f = mapExceptT $ fmap $ either (Left . f) Right
149
150 instance (Functor m) => Functor (ExceptT e m) where
151 fmap f = ExceptT . fmap (fmap f) . runExceptT
152
153 instance (Foldable f) => Foldable (ExceptT e f) where
154 foldMap f (ExceptT a) = foldMap (either (const mempty) f) a
155
156 instance (Traversable f) => Traversable (ExceptT e f) where
157 traverse f (ExceptT a) =
158 ExceptT <$> traverse (either (pure . Left) (fmap Right . f)) a
159
160 instance (Functor m, Monad m) => Applicative (ExceptT e m) where
161 pure a = ExceptT $ return (Right a)
162 ExceptT f <*> ExceptT v = ExceptT $ do
163 mf <- f
164 case mf of
165 Left e -> return (Left e)
166 Right k -> do
167 mv <- v
168 case mv of
169 Left e -> return (Left e)
170 Right x -> return (Right (k x))
171
172 instance (Functor m, Monad m, Monoid e) => Alternative (ExceptT e m) where
173 empty = ExceptT $ return (Left mempty)
174 ExceptT mx <|> ExceptT my = ExceptT $ do
175 ex <- mx
176 case ex of
177 Left e -> liftM (either (Left . mappend e) Right) my
178 Right x -> return (Right x)
179
180 instance (Monad m) => Monad (ExceptT e m) where
181 return a = ExceptT $ return (Right a)
182 m >>= k = ExceptT $ do
183 a <- runExceptT m
184 case a of
185 Left e -> return (Left e)
186 Right x -> runExceptT (k x)
187 fail = ExceptT . fail
188
189 instance (Monad m, Monoid e) => MonadPlus (ExceptT e m) where
190 mzero = ExceptT $ return (Left mempty)
191 ExceptT mx `mplus` ExceptT my = ExceptT $ do
192 ex <- mx
193 case ex of
194 Left e -> liftM (either (Left . mappend e) Right) my
195 Right x -> return (Right x)
196
197 instance (MonadFix m) => MonadFix (ExceptT e m) where
198 mfix f = ExceptT (mfix (runExceptT . f . either (const bomb) id))
199 where bomb = error "mfix (ExceptT): inner computation returned Left value"
200
201 instance MonadTrans (ExceptT e) where
202 lift = ExceptT . liftM Right
203
204 instance (MonadIO m) => MonadIO (ExceptT e m) where
205 liftIO = lift . liftIO
206
207 #if MIN_VERSION_base(4,4,0)
208 instance (MonadZip m) => MonadZip (ExceptT e m) where
209 mzipWith f (ExceptT a) (ExceptT b) = ExceptT $ mzipWith (liftA2 f) a b
210 #endif
211
212 -- | Signal an exception value @e@.
213 --
214 -- * @'runExceptT' ('throwE' e) = 'return' ('Left' e)@
215 --
216 -- * @'throwE' e >>= m = 'throwE' e@
217 throwE :: (Monad m) => e -> ExceptT e m a
218 throwE = ExceptT . return . Left
219
220 -- | Handle an exception.
221 --
222 -- * @'catchE' h ('lift' m) = 'lift' m@
223 --
224 -- * @'catchE' h ('throwE' e) = h e@
225 catchE :: (Monad m) =>
226 ExceptT e m a -- ^ the inner computation
227 -> (e -> ExceptT e' m a) -- ^ a handler for exceptions in the inner
228 -- computation
229 -> ExceptT e' m a
230 m `catchE` h = ExceptT $ do
231 a <- runExceptT m
232 case a of
233 Left l -> runExceptT (h l)
234 Right r -> return (Right r)
235
236 -- | Lift a @callCC@ operation to the new monad.
237 liftCallCC :: CallCC m (Either e a) (Either e b) -> CallCC (ExceptT e m) a b
238 liftCallCC callCC f = ExceptT $
239 callCC $ \ c ->
240 runExceptT (f (\ a -> ExceptT $ c (Right a)))
241
242 -- | Lift a @listen@ operation to the new monad.
243 liftListen :: (Monad m) => Listen w m (Either e a) -> Listen w (ExceptT e m) a
244 liftListen listen = mapExceptT $ \ m -> do
245 (a, w) <- listen m
246 return $! fmap (\ r -> (r, w)) a
247
248 -- | Lift a @pass@ operation to the new monad.
249 liftPass :: (Monad m) => Pass w m (Either e a) -> Pass w (ExceptT e m) a
250 liftPass pass = mapExceptT $ \ m -> pass $ do
251 a <- m
252 return $! case a of
253 Left l -> (Left l, id)
254 Right (r, f) -> (Right r, f)