{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
{-# LANGUAGE StandaloneDeriving #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Control.Exception.Base
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/base/LICENSE)
--
-- 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(..),
        SomeAsyncException(..), AsyncException(..),
        asyncExceptionToException, asyncExceptionFromException,
        NonTermination(..),
        NestedAtomically(..),
        BlockedIndefinitelyOnMVar(..),
        FixIOException (..),
        BlockedIndefinitelyOnSTM(..),
        AllocationLimitExceeded(..),
        CompactionFailed(..),
        Deadlock(..),
        NoMethodError(..),
        PatternMatchFail(..),
        RecConError(..),
        RecSelError(..),
        RecUpdError(..),
        ErrorCall(..),
        TypeError(..), -- #10284, custom error type for deferred type errors

        -- * 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
        mask,
        mask_,
        uninterruptibleMask,
        uninterruptibleMask_,
        MaskingState(..),
        getMaskingState,

        -- * Assertions

        assert,

        -- * Utilities

        bracket,
        bracket_,
        bracketOnError,

        finally,

        -- * Calls for GHC runtime
        recSelError, recConError, runtimeError,
        nonExhaustiveGuardsError, patError, noMethodBindingError,
        absentError, absentSumFieldError, typeError,
        nonTermination, nestedAtomically,
  ) where

import GHC.Base
import GHC.IO hiding (bracket,finally,onException)
import GHC.IO.Exception
import GHC.Exception
import GHC.Show
-- import GHC.Exception hiding ( Exception )
import GHC.Conc.Sync

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.
--
-- > catchJust (\e -> if isDoesNotExistErrorType (ioeGetErrorType e) then Just () else Nothing)
-- >           (readFile f)
-- >           (\_ -> do hPutStrLn stderr ("No such file: " ++ show f)
-- >                     return "")
--
-- Any other exceptions which are not matched by the predicate
-- are re-raised, and may be caught by an enclosing
-- 'catch', 'catchJust', etc.
catchJust
        :: Exception e
        => (e -> Maybe b)         -- ^ Predicate to select exceptions
        -> IO a                   -- ^ Computation to run
        -> (b -> IO a)            -- ^ Handler
        -> IO a
catchJust :: (e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust e -> Maybe b
p IO a
a b -> IO a
handler = IO a -> (e -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch IO a
a e -> IO a
handler'
  where handler' :: e -> IO a
handler' e
e = case e -> Maybe b
p e
e of
                        Maybe b
Nothing -> e -> IO a
forall e a. Exception e => e -> IO a
throwIO e
e
                        Just b
b  -> b -> IO a
handler b
b

-- | A version of 'catch' with the arguments swapped around; useful in
-- situations where the code for the handler is shorter.  For example:
--
-- >   do handle (\NonTermination -> exitWith (ExitFailure 1)) $
-- >      ...
handle     :: Exception e => (e -> IO a) -> IO a -> IO a
handle :: (e -> IO a) -> IO a -> IO a
handle     =  (IO a -> (e -> IO a) -> IO a) -> (e -> IO a) -> IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip IO a -> (e -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
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 :: (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust e -> Maybe b
p =  (IO a -> (b -> IO a) -> IO a) -> (b -> IO a) -> IO a -> IO a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust e -> Maybe b
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 :: (e1 -> e2) -> a -> a
mapException e1 -> e2
f a
v = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> (e1 -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (a -> IO a
forall a. a -> IO a
evaluate a
v)
                                          (\e1
x -> e2 -> IO a
forall e a. Exception e => e -> IO a
throwIO (e1 -> e2
f e1
x)))

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

-- | Similar to 'catch', but returns an 'Either' result which is
-- @('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.
--
-- >  try a = catch (Right `liftM` a) (return . Left)

try :: Exception e => IO a -> IO (Either e a)
try :: IO a -> IO (Either e a)
try IO a
a = IO (Either e a) -> (e -> IO (Either e a)) -> IO (Either e a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (IO a
a IO a -> (a -> IO (Either e a)) -> IO (Either e a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ a
v -> Either e a -> IO (Either e a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either e a
forall a b. b -> Either a b
Right a
v)) (\e
e -> Either e a -> IO (Either e a)
forall (m :: * -> *) a. Monad m => a -> m a
return (e -> Either e a
forall a b. a -> Either a b
Left e
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 :: (e -> Maybe b) -> IO a -> IO (Either b a)
tryJust e -> Maybe b
p IO a
a = do
  Either e a
r <- IO a -> IO (Either e a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
a
  case Either e a
r of
        Right a
v -> Either b a -> IO (Either b a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Either b a
forall a b. b -> Either a b
Right a
v)
        Left  e
e -> case e -> Maybe b
p e
e of
                        Maybe b
Nothing -> e -> IO (Either b a)
forall e a. Exception e => e -> IO a
throwIO e
e
                        Just b
b  -> Either b a -> IO (Either b a)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Either b a
forall a b. a -> Either a b
Left b
b)

-- | Like 'finally', but only performs the final action if there was an
-- exception raised by the computation.
onException :: IO a -> IO b -> IO a
onException :: IO a -> IO b -> IO a
onException IO a
io IO b
what = IO a
io IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \SomeException
e -> do b
_ <- IO b
what
                                          SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO (SomeException
e :: SomeException)

-----------------------------------------------------------------------------
-- 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)
-- >   (\fileHandle -> do { ... })
--
-- 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 :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO a
before a -> IO b
after a -> IO c
thing =
  ((forall a. IO a -> IO a) -> IO c) -> IO c
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO c) -> IO c)
-> ((forall a. IO a -> IO a) -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
    a
a <- IO a
before
    c
r <- IO c -> IO c
forall a. IO a -> IO a
restore (a -> IO c
thing a
a) IO c -> IO b -> IO c
forall a b. IO a -> IO b -> IO a
`onException` a -> IO b
after a
a
    b
_ <- a -> IO b
after a
a
    c -> IO c
forall (m :: * -> *) a. Monad m => a -> m a
return c
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
IO a
a finally :: IO a -> IO b -> IO a
`finally` IO b
sequel =
  ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
    a
r <- IO a -> IO a
forall a. IO a -> IO a
restore IO a
a IO a -> IO b -> IO a
forall a b. IO a -> IO b -> IO a
`onException` IO b
sequel
    b
_ <- IO b
sequel
    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
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_ :: IO a -> IO b -> IO c -> IO c
bracket_ IO a
before IO b
after IO c
thing = IO a -> (a -> IO b) -> (a -> IO c) -> IO c
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO a
before (IO b -> a -> IO b
forall a b. a -> b -> a
const IO b
after) (IO c -> a -> IO c
forall a b. a -> b -> a
const IO c
thing)

-- | Like 'bracket', but only performs the final action if there was an
-- 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 :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError IO a
before a -> IO b
after a -> IO c
thing =
  ((forall a. IO a -> IO a) -> IO c) -> IO c
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO c) -> IO c)
-> ((forall a. IO a -> IO a) -> IO c) -> IO c
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
    a
a <- IO a
before
    IO c -> IO c
forall a. IO a -> IO a
restore (a -> IO c
thing a
a) IO c -> IO b -> IO c
forall a b. IO a -> IO b -> IO a
`onException` a -> IO b
after a
a

-----

-- |A pattern match failed. The @String@ gives information about the
-- source location of the pattern.
newtype PatternMatchFail = PatternMatchFail String

-- | @since 4.0
instance Show PatternMatchFail where
    showsPrec :: Int -> PatternMatchFail -> ShowS
showsPrec Int
_ (PatternMatchFail String
err) = String -> ShowS
showString String
err

-- | @since 4.0
instance Exception PatternMatchFail

-----

-- |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.
newtype RecSelError = RecSelError String

-- | @since 4.0
instance Show RecSelError where
    showsPrec :: Int -> RecSelError -> ShowS
showsPrec Int
_ (RecSelError String
err) = String -> ShowS
showString String
err

-- | @since 4.0
instance Exception RecSelError

-----

-- |An uninitialised record field was used. The @String@ gives
-- information about the source location where the record was
-- constructed.
newtype RecConError = RecConError String

-- | @since 4.0
instance Show RecConError where
    showsPrec :: Int -> RecConError -> ShowS
showsPrec Int
_ (RecConError String
err) = String -> ShowS
showString String
err

-- | @since 4.0
instance Exception RecConError

-----

-- |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.
newtype RecUpdError = RecUpdError String

-- | @since 4.0
instance Show RecUpdError where
    showsPrec :: Int -> RecUpdError -> ShowS
showsPrec Int
_ (RecUpdError String
err) = String -> ShowS
showString String
err

-- | @since 4.0
instance Exception RecUpdError

-----

-- |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.
newtype NoMethodError = NoMethodError String

-- | @since 4.0
instance Show NoMethodError where
    showsPrec :: Int -> NoMethodError -> ShowS
showsPrec Int
_ (NoMethodError String
err) = String -> ShowS
showString String
err

-- | @since 4.0
instance Exception NoMethodError

-----

-- |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.
--
-- @since 4.9.0.0
newtype TypeError = TypeError String

-- | @since 4.9.0.0
instance Show TypeError where
    showsPrec :: Int -> TypeError -> ShowS
showsPrec Int
_ (TypeError String
err) = String -> ShowS
showString String
err

-- | @since 4.9.0.0
instance Exception TypeError

-----

-- |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.
data NonTermination = NonTermination

-- | @since 4.0
instance Show NonTermination where
    showsPrec :: Int -> NonTermination -> ShowS
showsPrec Int
_ NonTermination
NonTermination = String -> ShowS
showString String
"<<loop>>"

-- | @since 4.0
instance Exception NonTermination

-----

-- |Thrown when the program attempts to call @atomically@, from the @stm@
-- package, inside another call to @atomically@.
data NestedAtomically = NestedAtomically

-- | @since 4.0
instance Show NestedAtomically where
    showsPrec :: Int -> NestedAtomically -> ShowS
showsPrec Int
_ NestedAtomically
NestedAtomically = String -> ShowS
showString String
"Control.Concurrent.STM.atomically was nested"

-- | @since 4.0
instance Exception NestedAtomically

-----

recSelError, recConError, runtimeError,
  nonExhaustiveGuardsError, patError, noMethodBindingError,
  absentError, typeError
        :: Addr# -> a   -- All take a UTF8-encoded C string

recSelError :: Addr# -> a
recSelError              Addr#
s = RecSelError -> a
forall a e. Exception e => e -> a
throw (String -> RecSelError
RecSelError (String
"No match in record selector "
                                                 String -> ShowS
forall a. [a] -> [a] -> [a]
++ Addr# -> String
unpackCStringUtf8# Addr#
s))  -- No location info unfortunately
runtimeError :: Addr# -> a
runtimeError             Addr#
s = String -> a
forall a. String -> a
errorWithoutStackTrace (Addr# -> String
unpackCStringUtf8# Addr#
s)                   -- No location info unfortunately
absentError :: Addr# -> a
absentError              Addr#
s = String -> a
forall a. String -> a
errorWithoutStackTrace (String
"Oops!  Entered absent arg " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Addr# -> String
unpackCStringUtf8# Addr#
s)

nonExhaustiveGuardsError :: Addr# -> a
nonExhaustiveGuardsError Addr#
s = PatternMatchFail -> a
forall a e. Exception e => e -> a
throw (String -> PatternMatchFail
PatternMatchFail (Addr# -> ShowS
untangle Addr#
s String
"Non-exhaustive guards in"))
recConError :: Addr# -> a
recConError              Addr#
s = RecConError -> a
forall a e. Exception e => e -> a
throw (String -> RecConError
RecConError      (Addr# -> ShowS
untangle Addr#
s String
"Missing field in record construction"))
noMethodBindingError :: Addr# -> a
noMethodBindingError     Addr#
s = NoMethodError -> a
forall a e. Exception e => e -> a
throw (String -> NoMethodError
NoMethodError    (Addr# -> ShowS
untangle Addr#
s String
"No instance nor default method for class operation"))
patError :: Addr# -> a
patError                 Addr#
s = PatternMatchFail -> a
forall a e. Exception e => e -> a
throw (String -> PatternMatchFail
PatternMatchFail (Addr# -> ShowS
untangle Addr#
s String
"Non-exhaustive patterns in"))
typeError :: Addr# -> a
typeError                Addr#
s = TypeError -> a
forall a e. Exception e => e -> a
throw (String -> TypeError
TypeError        (Addr# -> String
unpackCStringUtf8# Addr#
s))

-- GHC's RTS calls this
nonTermination :: SomeException
nonTermination :: SomeException
nonTermination = NonTermination -> SomeException
forall e. Exception e => e -> SomeException
toException NonTermination
NonTermination

-- GHC's RTS calls this
nestedAtomically :: SomeException
nestedAtomically :: SomeException
nestedAtomically = NestedAtomically -> SomeException
forall e. Exception e => e -> SomeException
toException NestedAtomically
NestedAtomically

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