    {-# LANGUAGE Trustworthy #-}
    {-# LANGUAGE NoImplicitPrelude, MagicHash #-}
    {-# LANGUAGE AutoDeriveTypeable, 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(..),
            BlockedIndefinitelyOnSTM(..),
            AllocationLimitExceeded(..),
            Deadlock(..),
            NoMethodError(..),
            PatternMatchFail(..),
            RecConError(..),
            RecSelError(..),
            RecUpdError(..),
            ErrorCall(..),

            -- * 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, irrefutPatError, runtimeError,
            nonExhaustiveGuardsError, patError, noMethodBindingError,
            absentError,
            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.Dynamic
    import Data.Either

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

    -- |This is the simplest of the exception-catching functions.  It
    -- takes a single argument, runs it, and if an exception is raised
    -- the \"handler\" is executed, with the value of the exception passed as an
    -- argument.  Otherwise, the result is returned as normal.  For example:
    --
    -- >   catch (readFile f)
    -- >         (\e -> do let err = show (e :: IOException)
    -- >                   hPutStr stderr ("Warning: Couldn't open " ++ f ++ ": " ++ err)
    -- >                   return "")
    --
    -- Note that we have to give a type signature to @e@, or the program
    -- will not typecheck as the type is ambiguous. While it is possible
    -- to catch exceptions of any type, see the section \"Catching all
    -- exceptions\" (in "Control.Exception") for an explanation of the problems with doing so.
    --
    -- For catching exceptions in pure (non-'IO') expressions, see the
    -- function 'evaluate'.
    --
    -- Note that due to Haskell\'s unspecified evaluation order, an
    -- expression may throw one of several possible exceptions: consider
    -- the expression @(error \"urk\") + (1 \`div\` 0)@.  Does
    -- the expression throw
    -- @ErrorCall \"urk\"@, or @DivideByZero@?
    --
    -- The answer is \"it might throw either\"; the choice is
    -- non-deterministic. If you are catching any type of exception then you
    -- might catch either. If you are calling @catch@ with type
    -- @IO Int -> (ArithException -> IO Int) -> IO Int@ then the handler may
    -- get run with @DivideByZero@ as an argument, or an @ErrorCall \"urk\"@
    -- exception may be propogated further up. If you call it again, you
    -- might get a the opposite behaviour. This is ok, because 'catch' is an
    -- 'IO' computation.
    --
    catch   :: Exception e
            => IO a         -- ^ The computation to run
            -> (e -> IO a)  -- ^ Handler to invoke if an exception is raised
            -> IO a
    catch = catchException

    -- | 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 p a handler = catch a handler'
      where handler' e = case p e of
                            Nothing -> throwIO e
                            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:
    --
    -- >   do handle (\NonTermination -> exitWith (ExitFailure 1)) $
    -- >      ...
    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)
                                              (\x -> throwIO (f 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 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
                            Nothing -> throwIO e
                            Just b  -> return (Left 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 what = io `catch` \e -> do _ <- what
                                              throwIO (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 before after thing =
      mask $ \restore -> do
        a <- before
        r <- restore (thing a) `onException` after a
        _ <- after a
        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 =
      mask $ \restore -> do
        r <- restore a `onException` sequel
        _ <- sequel
        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)

    -- | 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 before after thing =
      mask $ \restore -> do
        a <- before
        restore (thing a) `onException` after a

    -----

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

    instance Show PatternMatchFail where
        showsPrec _ (PatternMatchFail err) = showString err

    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.
    data RecSelError = RecSelError String deriving Typeable

    instance Show RecSelError where
        showsPrec _ (RecSelError err) = showString err

    instance Exception RecSelError

    -----

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

    instance Show RecConError where
        showsPrec _ (RecConError err) = showString err

    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.
    data RecUpdError = RecUpdError String deriving Typeable

    instance Show RecUpdError where
        showsPrec _ (RecUpdError err) = showString err

    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.
    data NoMethodError = NoMethodError String deriving Typeable

    instance Show NoMethodError where
        showsPrec _ (NoMethodError err) = showString err

    instance Exception NoMethodError

    -----

    -- |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 deriving Typeable

    instance Show NonTermination where
        showsPrec _ NonTermination = showString "<<loop>>"

    instance Exception NonTermination

    -----

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

    instance Show NestedAtomically where
        showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested"

    instance Exception NestedAtomically

    -----

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

    recSelError              s = throw (RecSelError ("No match in record selector "
                                                     ++ unpackCStringUtf8# s))  -- No location info unfortunately
    runtimeError             s = error (unpackCStringUtf8# s)                   -- No location info unfortunately
    absentError              s = error ("Oops!  Entered absent arg " ++ unpackCStringUtf8# s)

    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"))

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

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