Base.hs 13.2 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,
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
98
        absentError, absentSumFieldError, 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
Ömer Sinan Ağacan's avatar
Ömer Sinan Ağacan committed
402 403 404 405

-- Introduced by unarise for unused unboxed sum fields
absentSumFieldError :: a
absentSumFieldError = absentError " in unboxed sum."#