{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude, MagicHash #-}
{-# LANGUAGE StandaloneDeriving #-}
module Control.Exception.Base (
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(..),
throwIO,
throw,
ioError,
throwTo,
catch,
catchJust,
handle,
handleJust,
try,
tryJust,
onException,
evaluate,
mapException,
mask,
mask_,
uninterruptibleMask,
uninterruptibleMask_,
MaskingState(..),
getMaskingState,
assert,
bracket,
bracket_,
bracketOnError,
finally,
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.Conc.Sync
import Data.Either
catchJust
:: Exception e
=> (e -> Maybe b)
-> IO a
-> (b -> IO a)
-> IO a
catchJust :: (e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
catchJust p :: e -> Maybe b
p a :: IO a
a handler :: 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
e = case e -> Maybe b
p e
e of
Nothing -> e -> IO a
forall e a. Exception e => e -> IO a
throwIO e
e
Just b :: b
b -> b -> IO a
handler b
b
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
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 p :: 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 :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
mapException :: (e1 -> e2) -> a -> a
mapException f :: e1 -> e2
f v :: 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)
(\x :: e1
x -> e2 -> IO a
forall e a. Exception e => e -> IO a
throwIO (e1 -> e2
f e1
x)))
try :: Exception e => IO a -> IO (Either e a)
try :: IO a -> IO (Either e a)
try a :: 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
>>= \ v :: 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
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))
tryJust :: Exception e => (e -> Maybe b) -> IO a -> IO (Either b a)
tryJust :: (e -> Maybe b) -> IO a -> IO (Either b a)
tryJust p :: e -> Maybe b
p a :: 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 v :: 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
e -> case e -> Maybe b
p e
e of
Nothing -> e -> IO (Either b a)
forall e a. Exception e => e -> IO a
throwIO e
e
Just b :: 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)
onException :: IO a -> IO b -> IO a
onException :: IO a -> IO b -> IO a
onException io :: IO a
io what :: 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` \e :: SomeException
e -> do b
_ <- IO b
what
SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO (SomeException
e :: SomeException)
bracket
:: IO a
-> (a -> IO b)
-> (a -> IO c)
-> IO c
bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket before :: IO a
before after :: a -> IO b
after thing :: 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
$ \restore :: 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
finally :: IO a
-> IO b
-> IO a
a :: IO a
a finally :: IO a -> IO b -> IO a
`finally` sequel :: 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
$ \restore :: 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
bracket_ :: IO a -> IO b -> IO c -> IO c
bracket_ :: IO a -> IO b -> IO c -> IO c
bracket_ before :: IO a
before after :: IO b
after thing :: 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)
bracketOnError
:: IO a
-> (a -> IO b)
-> (a -> IO c)
-> IO c
bracketOnError :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError before :: IO a
before after :: a -> IO b
after thing :: 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
$ \restore :: 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
newtype PatternMatchFail = PatternMatchFail String
instance Show PatternMatchFail where
showsPrec :: Int -> PatternMatchFail -> ShowS
showsPrec _ (PatternMatchFail err :: String
err) = String -> ShowS
showString String
err
instance Exception PatternMatchFail
newtype RecSelError = RecSelError String
instance Show RecSelError where
showsPrec :: Int -> RecSelError -> ShowS
showsPrec _ (RecSelError err :: String
err) = String -> ShowS
showString String
err
instance Exception RecSelError
newtype RecConError = RecConError String
instance Show RecConError where
showsPrec :: Int -> RecConError -> ShowS
showsPrec _ (RecConError err :: String
err) = String -> ShowS
showString String
err
instance Exception RecConError
newtype RecUpdError = RecUpdError String
instance Show RecUpdError where
showsPrec :: Int -> RecUpdError -> ShowS
showsPrec _ (RecUpdError err :: String
err) = String -> ShowS
showString String
err
instance Exception RecUpdError
newtype NoMethodError = NoMethodError String
instance Show NoMethodError where
showsPrec :: Int -> NoMethodError -> ShowS
showsPrec _ (NoMethodError err :: String
err) = String -> ShowS
showString String
err
instance Exception NoMethodError
newtype TypeError = TypeError String
instance Show TypeError where
showsPrec :: Int -> TypeError -> ShowS
showsPrec _ (TypeError err :: String
err) = String -> ShowS
showString String
err
instance Exception TypeError
data NonTermination = NonTermination
instance Show NonTermination where
showsPrec :: Int -> NonTermination -> ShowS
showsPrec _ NonTermination = String -> ShowS
showString "<<loop>>"
instance Exception NonTermination
data NestedAtomically = NestedAtomically
instance Show NestedAtomically where
showsPrec :: Int -> NestedAtomically -> ShowS
showsPrec _ NestedAtomically = String -> ShowS
showString "Control.Concurrent.STM.atomically was nested"
instance Exception NestedAtomically
recSelError, recConError, runtimeError,
nonExhaustiveGuardsError, patError, noMethodBindingError,
absentError, typeError
:: Addr# -> a
recSelError :: Addr# -> a
recSelError s :: Addr#
s = RecSelError -> a
forall a e. Exception e => e -> a
throw (String -> RecSelError
RecSelError ("No match in record selector "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ Addr# -> String
unpackCStringUtf8# Addr#
s))
runtimeError :: Addr# -> a
runtimeError s :: Addr#
s = String -> a
forall a. String -> a
errorWithoutStackTrace (Addr# -> String
unpackCStringUtf8# Addr#
s)
absentError :: Addr# -> a
absentError s :: Addr#
s = String -> a
forall a. String -> a
errorWithoutStackTrace ("Oops! Entered absent arg " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Addr# -> String
unpackCStringUtf8# Addr#
s)
nonExhaustiveGuardsError :: Addr# -> a
nonExhaustiveGuardsError s :: Addr#
s = PatternMatchFail -> a
forall a e. Exception e => e -> a
throw (String -> PatternMatchFail
PatternMatchFail (Addr# -> ShowS
untangle Addr#
s "Non-exhaustive guards in"))
recConError :: Addr# -> a
recConError s :: Addr#
s = RecConError -> a
forall a e. Exception e => e -> a
throw (String -> RecConError
RecConError (Addr# -> ShowS
untangle Addr#
s "Missing field in record construction"))
noMethodBindingError :: Addr# -> a
noMethodBindingError s :: Addr#
s = NoMethodError -> a
forall a e. Exception e => e -> a
throw (String -> NoMethodError
NoMethodError (Addr# -> ShowS
untangle Addr#
s "No instance nor default method for class operation"))
patError :: Addr# -> a
patError s :: Addr#
s = PatternMatchFail -> a
forall a e. Exception e => e -> a
throw (String -> PatternMatchFail
PatternMatchFail (Addr# -> ShowS
untangle Addr#
s "Non-exhaustive patterns in"))
typeError :: Addr# -> a
typeError s :: Addr#
s = TypeError -> a
forall a e. Exception e => e -> a
throw (String -> TypeError
TypeError (Addr# -> String
unpackCStringUtf8# Addr#
s))
nonTermination :: SomeException
nonTermination :: SomeException
nonTermination = NonTermination -> SomeException
forall e. Exception e => e -> SomeException
toException NonTermination
NonTermination
nestedAtomically :: SomeException
nestedAtomically :: SomeException
nestedAtomically = NestedAtomically -> SomeException
forall e. Exception e => e -> SomeException
toException NestedAtomically
NestedAtomically
absentSumFieldError :: a
absentSumFieldError :: a
absentSumFieldError = Addr# -> a
forall a. Addr# -> a
absentError " in unboxed sum."#