Base.hs 13 KB
Newer Older
1
{-# LANGUAGE Trustworthy #-}
2
{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
3
{-# LANGUAGE StandaloneDeriving #-}
4
5
6
7
8
9

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Exception.Base
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
10
--
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
-- Maintainer  :  libraries@haskell.org
-- Stability   :  experimental
-- Portability :  non-portable (extended exceptions)
--
-- Extensible exceptions, except for multiple handlers.
--
-----------------------------------------------------------------------------

module Control.Exception.Base (

        -- * The Exception type
        SomeException(..),
        Exception(..),
        IOException,
        ArithException(..),
        ArrayException(..),
        AssertionFailed(..),
28
29
        SomeAsyncException(..), AsyncException(..),
        asyncExceptionToException, asyncExceptionFromException,
30
31
        NonTermination(..),
        NestedAtomically(..),
Simon Marlow's avatar
Simon Marlow committed
32
        BlockedIndefinitelyOnMVar(..),
David Feuer's avatar
David Feuer committed
33
        FixIOException (..),
Simon Marlow's avatar
Simon Marlow committed
34
        BlockedIndefinitelyOnSTM(..),
35
        AllocationLimitExceeded(..),
36
        CompactionFailed(..),
37
38
39
40
41
42
        Deadlock(..),
        NoMethodError(..),
        PatternMatchFail(..),
        RecConError(..),
        RecSelError(..),
        RecUpdError(..),
43
        ErrorCall(..),
44
        TypeError(..), -- #10284, custom error type for deferred type errors
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

        -- * Throwing exceptions
        throwIO,
        throw,
        ioError,
        throwTo,

        -- * Catching Exceptions

        -- ** The @catch@ functions
        catch,
        catchJust,

        -- ** The @handle@ functions
        handle,
        handleJust,

        -- ** The @try@ functions
        try,
        tryJust,
        onException,

        -- ** The @evaluate@ function
        evaluate,

        -- ** The @mapException@ function
        mapException,

        -- * Asynchronous Exceptions

        -- ** Asynchronous exception control
76
77
78
79
80
81
82
        mask,
        mask_,
        uninterruptibleMask,
        uninterruptibleMask_,
        MaskingState(..),
        getMaskingState,

83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
        -- * Assertions

        assert,

        -- * Utilities

        bracket,
        bracket_,
        bracketOnError,

        finally,

        -- * Calls for GHC runtime
        recSelError, recConError, irrefutPatError, runtimeError,
        nonExhaustiveGuardsError, patError, noMethodBindingError,
98
        absentError, typeError,
99
100
101
102
        nonTermination, nestedAtomically,
  ) where

import GHC.Base
103
import GHC.IO hiding (bracket,finally,onException)
104
105
import GHC.IO.Exception
import GHC.Exception
106
import GHC.Show
107
-- import GHC.Exception hiding ( Exception )
Simon Marlow's avatar
Simon Marlow committed
108
import GHC.Conc.Sync
109
110
111
112
113
114
115
116
117
118

import Data.Either

-----------------------------------------------------------------------------
-- Catching exceptions

-- | The function 'catchJust' is like 'catch', but it takes an extra
-- argument which is an /exception predicate/, a function which
-- selects which type of exceptions we\'re interested in.
--
Ian Lynagh's avatar
Ian Lynagh committed
119
120
121
122
-- > catchJust (\e -> if isDoesNotExistErrorType (ioeGetErrorType e) then Just () else Nothing)
-- >           (readFile f)
-- >           (\_ -> do hPutStrLn stderr ("No such file: " ++ show f)
-- >                     return "")
123
124
125
--
-- Any other exceptions which are not matched by the predicate
-- are re-raised, and may be caught by an enclosing
Ian Lynagh's avatar
Ian Lynagh committed
126
-- 'catch', 'catchJust', etc.
127
128
129
130
131
132
133
134
catchJust
        :: Exception e
        => (e -> Maybe b)         -- ^ Predicate to select exceptions
        -> IO a                   -- ^ Computation to run
        -> (b -> IO a)            -- ^ Handler
        -> IO a
catchJust p a handler = catch a handler'
  where handler' e = case p e of
135
                        Nothing -> throwIO e
136
137
138
139
140
                        Just b  -> handler b

-- | A version of 'catch' with the arguments swapped around; useful in
-- situations where the code for the handler is shorter.  For example:
--
Ian Lynagh's avatar
Ian Lynagh committed
141
-- >   do handle (\NonTermination -> exitWith (ExitFailure 1)) $
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
-- >      ...
handle     :: Exception e => (e -> IO a) -> IO a -> IO a
handle     =  flip catch

-- | A version of 'catchJust' with the arguments swapped around (see
-- 'handle').
handleJust :: Exception e => (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust p =  flip (catchJust p)

-----------------------------------------------------------------------------
-- 'mapException'

-- | This function maps one exception into another as proposed in the
-- paper \"A semantics for imprecise exceptions\".

-- Notice that the usage of 'unsafePerformIO' is safe here.

mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
mapException f v = unsafePerformIO (catch (evaluate v)
161
                                          (\x -> throwIO (f x)))
162
163
164
165
166

-----------------------------------------------------------------------------
-- 'try' and variations.

-- | Similar to 'catch', but returns an 'Either' result which is
Ian Lynagh's avatar
Ian Lynagh committed
167
168
169
170
-- @('Right' a)@ if no exception of type @e@ was raised, or @('Left' ex)@
-- if an exception of type @e@ was raised and its value is @ex@.
-- If any other type of exception is raised than it will be propogated
-- up to the next enclosing exception handler.
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
--
-- >  try a = catch (Right `liftM` a) (return . Left)

try :: Exception e => IO a -> IO (Either e a)
try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))

-- | A variant of 'try' that takes an exception predicate to select
-- which exceptions are caught (c.f. 'catchJust').  If the exception
-- does not match the predicate, it is re-thrown.
tryJust :: Exception e => (e -> Maybe b) -> IO a -> IO (Either b a)
tryJust p a = do
  r <- try a
  case r of
        Right v -> return (Right v)
        Left  e -> case p e of
186
                        Nothing -> throwIO e
187
188
                        Just b  -> return (Left b)

Ian Lynagh's avatar
Ian Lynagh committed
189
190
-- | Like 'finally', but only performs the final action if there was an
-- exception raised by the computation.
191
onException :: IO a -> IO b -> IO a
192
onException io what = io `catch` \e -> do _ <- what
193
                                          throwIO (e :: SomeException)
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209

-----------------------------------------------------------------------------
-- Some Useful Functions

-- | When you want to acquire a resource, do some work with it, and
-- then release the resource, it is a good idea to use 'bracket',
-- because 'bracket' will install the necessary exception handler to
-- release the resource in the event that an exception is raised
-- during the computation.  If an exception is raised, then 'bracket' will
-- re-raise the exception (after performing the release).
--
-- A common example is opening a file:
--
-- > bracket
-- >   (openFile "filename" ReadMode)
-- >   (hClose)
Ian Lynagh's avatar
Ian Lynagh committed
210
-- >   (\fileHandle -> do { ... })
211
212
213
214
215
216
217
218
219
220
221
222
--
-- The arguments to 'bracket' are in this order so that we can partially apply
-- it, e.g.:
--
-- > withFile name mode = bracket (openFile name mode) hClose
--
bracket
        :: IO a         -- ^ computation to run first (\"acquire resource\")
        -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
        -> (a -> IO c)  -- ^ computation to run in-between
        -> IO c         -- returns the value from the in-between computation
bracket before after thing =
223
  mask $ \restore -> do
224
    a <- before
225
    r <- restore (thing a) `onException` after a
226
    _ <- after a
227
228
229
230
231
232
233
234
235
236
    return r

-- | A specialised variant of 'bracket' with just a computation to run
-- afterward.
--
finally :: IO a         -- ^ computation to run first
        -> IO b         -- ^ computation to run afterward (even if an exception
                        -- was raised)
        -> IO a         -- returns the value from the first computation
a `finally` sequel =
237
238
  mask $ \restore -> do
    r <- restore a `onException` sequel
239
    _ <- sequel
240
241
242
243
244
245
246
    return r

-- | A variant of 'bracket' where the return value from the first computation
-- is not required.
bracket_ :: IO a -> IO b -> IO c -> IO c
bracket_ before after thing = bracket before (const after) (const thing)

Ian Lynagh's avatar
Ian Lynagh committed
247
-- | Like 'bracket', but only performs the final action if there was an
248
249
250
251
252
253
254
-- exception raised by the in-between computation.
bracketOnError
        :: IO a         -- ^ computation to run first (\"acquire resource\")
        -> (a -> IO b)  -- ^ computation to run last (\"release resource\")
        -> (a -> IO c)  -- ^ computation to run in-between
        -> IO c         -- returns the value from the in-between computation
bracketOnError before after thing =
255
  mask $ \restore -> do
256
    a <- before
257
    restore (thing a) `onException` after a
258
259
260

-----

Ian Lynagh's avatar
Ian Lynagh committed
261
262
-- |A pattern match failed. The @String@ gives information about the
-- source location of the pattern.
263
newtype PatternMatchFail = PatternMatchFail String
264

265
-- | @since 4.0
266
267
268
instance Show PatternMatchFail where
    showsPrec _ (PatternMatchFail err) = showString err

269
-- | @since 4.0
270
271
272
273
instance Exception PatternMatchFail

-----

Ian Lynagh's avatar
Ian Lynagh committed
274
275
276
277
278
-- |A record selector was applied to a constructor without the
-- appropriate field. This can only happen with a datatype with
-- multiple constructors, where some fields are in one constructor
-- but not another. The @String@ gives information about the source
-- location of the record selector.
279
newtype RecSelError = RecSelError String
280

281
-- | @since 4.0
282
283
284
instance Show RecSelError where
    showsPrec _ (RecSelError err) = showString err

285
-- | @since 4.0
286
287
288
289
instance Exception RecSelError

-----

Ian Lynagh's avatar
Ian Lynagh committed
290
291
292
-- |An uninitialised record field was used. The @String@ gives
-- information about the source location where the record was
-- constructed.
293
newtype RecConError = RecConError String
294

295
-- | @since 4.0
296
297
298
instance Show RecConError where
    showsPrec _ (RecConError err) = showString err

299
-- | @since 4.0
300
301
302
303
instance Exception RecConError

-----

Ian Lynagh's avatar
Ian Lynagh committed
304
305
306
307
308
-- |A record update was performed on a constructor without the
-- appropriate field. This can only happen with a datatype with
-- multiple constructors, where some fields are in one constructor
-- but not another. The @String@ gives information about the source
-- location of the record update.
309
newtype RecUpdError = RecUpdError String
310

311
-- | @since 4.0
312
313
314
instance Show RecUpdError where
    showsPrec _ (RecUpdError err) = showString err

315
-- | @since 4.0
316
317
318
319
instance Exception RecUpdError

-----

Ian Lynagh's avatar
Ian Lynagh committed
320
321
322
-- |A class method without a definition (neither a default definition,
-- nor a definition in the appropriate instance) was called. The
-- @String@ gives information about which method it was.
323
newtype NoMethodError = NoMethodError String
324

325
-- | @since 4.0
326
327
328
instance Show NoMethodError where
    showsPrec _ (NoMethodError err) = showString err

329
-- | @since 4.0
330
331
332
333
instance Exception NoMethodError

-----

334
335
336
-- |An expression that didn't typecheck during compile time was called.
-- This is only possible with -fdefer-type-errors. The @String@ gives
-- details about the failed type check.
337
338
339
--
-- @since 4.9.0.0
newtype TypeError = TypeError String
340

341
-- | @since 4.9.0.0
342
343
344
instance Show TypeError where
    showsPrec _ (TypeError err) = showString err

345
-- | @since 4.9.0.0
346
347
348
349
instance Exception TypeError

-----

Ian Lynagh's avatar
Ian Lynagh committed
350
351
352
353
-- |Thrown when the runtime system detects that the computation is
-- guaranteed not to terminate. Note that there is no guarantee that
-- the runtime system will notice whether any given computation is
-- guaranteed to terminate or not.
354
data NonTermination = NonTermination
355

356
-- | @since 4.0
357
358
359
instance Show NonTermination where
    showsPrec _ NonTermination = showString "<<loop>>"

360
-- | @since 4.0
361
362
363
364
instance Exception NonTermination

-----

Ian Lynagh's avatar
Ian Lynagh committed
365
366
-- |Thrown when the program attempts to call @atomically@, from the @stm@
-- package, inside another call to @atomically@.
367
data NestedAtomically = NestedAtomically
368

369
-- | @since 4.0
370
371
372
instance Show NestedAtomically where
    showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested"

373
-- | @since 4.0
374
375
376
377
378
instance Exception NestedAtomically

-----

recSelError, recConError, irrefutPatError, runtimeError,
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
379
  nonExhaustiveGuardsError, patError, noMethodBindingError,
380
  absentError, typeError
381
382
        :: Addr# -> a   -- All take a UTF8-encoded C string

383
recSelError              s = throw (RecSelError ("No match in record selector "
384
                                                 ++ unpackCStringUtf8# s))  -- No location info unfortunately
Eric Seidel's avatar
Eric Seidel committed
385
386
runtimeError             s = errorWithoutStackTrace (unpackCStringUtf8# s)                   -- No location info unfortunately
absentError              s = errorWithoutStackTrace ("Oops!  Entered absent arg " ++ unpackCStringUtf8# s)
387
388
389
390
391
392

nonExhaustiveGuardsError s = throw (PatternMatchFail (untangle s "Non-exhaustive guards in"))
irrefutPatError          s = throw (PatternMatchFail (untangle s "Irrefutable pattern failed for pattern"))
recConError              s = throw (RecConError      (untangle s "Missing field in record construction"))
noMethodBindingError     s = throw (NoMethodError    (untangle s "No instance nor default method for class operation"))
patError                 s = throw (PatternMatchFail (untangle s "Non-exhaustive patterns in"))
393
typeError                s = throw (TypeError        (unpackCStringUtf8# s))
394
395
396
397
398
399
400
401

-- GHC's RTS calls this
nonTermination :: SomeException
nonTermination = toException NonTermination

-- GHC's RTS calls this
nestedAtomically :: SomeException
nestedAtomically = toException NestedAtomically