#ifdef __GLASGOW_HASKELL__
#endif
#include "Typeable.h"
module Control.Exception.Base (
#ifdef __HUGS__
SomeException,
#else
SomeException(..),
#endif
Exception(..),
IOException,
ArithException(..),
ArrayException(..),
AssertionFailed(..),
AsyncException(..),
#if __GLASGOW_HASKELL__ || __HUGS__
NonTermination(..),
NestedAtomically(..),
#endif
BlockedIndefinitelyOnMVar(..),
BlockedIndefinitelyOnSTM(..),
Deadlock(..),
NoMethodError(..),
PatternMatchFail(..),
RecConError(..),
RecSelError(..),
RecUpdError(..),
ErrorCall(..),
throwIO,
throw,
ioError,
#ifdef __GLASGOW_HASKELL__
throwTo,
#endif
catch,
catchJust,
handle,
handleJust,
try,
tryJust,
onException,
evaluate,
mapException,
mask,
#ifndef __NHC__
mask_,
uninterruptibleMask,
uninterruptibleMask_,
MaskingState(..),
getMaskingState,
#endif
block,
unblock,
blocked,
assert,
bracket,
bracket_,
bracketOnError,
finally,
#ifdef __GLASGOW_HASKELL__
recSelError, recConError, irrefutPatError, runtimeError,
nonExhaustiveGuardsError, patError, noMethodBindingError,
absentError,
nonTermination, nestedAtomically,
#endif
) where
#ifdef __GLASGOW_HASKELL__
import GHC.Base
import GHC.IO hiding (bracket,finally,onException)
import GHC.IO.Exception
import GHC.Exception
import GHC.Show
import GHC.Conc.Sync
#endif
#ifdef __HUGS__
import Prelude hiding (catch)
import Hugs.Prelude (ExitCode(..))
import Hugs.IOExts (unsafePerformIO)
import Hugs.Exception (SomeException(DynamicException, IOException,
ArithException, ArrayException, ExitException),
evaluate, IOException, ArithException, ArrayException)
import qualified Hugs.Exception
#endif
import Data.Dynamic
import Data.Either
import Data.Maybe
#ifdef __NHC__
import qualified IO as H'98 (catch)
import IO (bracket,ioError)
import DIOError
import System (ExitCode())
import System.IO.Unsafe (unsafePerformIO)
import Unsafe.Coerce (unsafeCoerce)
class ( Show e) => Exception e where
toException :: e -> SomeException
fromException :: SomeException -> Maybe e
data SomeException = forall e . Exception e => SomeException e
INSTANCE_TYPEABLE0(SomeException,someExceptionTc,"SomeException")
instance Show SomeException where
showsPrec p (SomeException e) = showsPrec p e
instance Exception SomeException where
toException se = se
fromException = Just
type IOException = IOError
instance Exception IOError where
toException = SomeException
fromException (SomeException e) = Just (unsafeCoerce e)
instance Exception ExitCode where
toException = SomeException
fromException (SomeException e) = Just (unsafeCoerce e)
data ArithException
data ArrayException
data AsyncException
data AssertionFailed
data PatternMatchFail
data NoMethodError
data Deadlock
data BlockedIndefinitelyOnMVar
data BlockedIndefinitelyOnSTM
data ErrorCall
data RecConError
data RecSelError
data RecUpdError
instance Show ArithException
instance Show ArrayException
instance Show AsyncException
instance Show AssertionFailed
instance Show PatternMatchFail
instance Show NoMethodError
instance Show Deadlock
instance Show BlockedIndefinitelyOnMVar
instance Show BlockedIndefinitelyOnSTM
instance Show ErrorCall
instance Show RecConError
instance Show RecSelError
instance Show RecUpdError
catch :: Exception e
=> IO a
-> (e -> IO a)
-> IO a
catch io h = H'98.catch io (h . fromJust . fromException . toException)
throwIO :: Exception e => e -> IO a
throwIO = ioError . fromJust . fromException . toException
throw :: Exception e => e -> a
throw = unsafePerformIO . throwIO
evaluate :: a -> IO a
evaluate x = x `seq` return x
assert :: Bool -> a -> a
assert True x = x
assert False _ = throw (toException (UserError "" "Assertion failed"))
mask :: ((IO a-> IO a) -> IO a) -> IO a
mask action = action restore
where restore act = act
#endif
#ifdef __HUGS__
class (Typeable e, Show e) => Exception e where
toException :: e -> SomeException
fromException :: SomeException -> Maybe e
toException e = DynamicException (toDyn e) (flip showsPrec e)
fromException (DynamicException dyn _) = fromDynamic dyn
fromException _ = Nothing
INSTANCE_TYPEABLE0(SomeException,someExceptionTc,"SomeException")
INSTANCE_TYPEABLE0(IOException,iOExceptionTc,"IOException")
INSTANCE_TYPEABLE0(ArithException,arithExceptionTc,"ArithException")
INSTANCE_TYPEABLE0(ArrayException,arrayExceptionTc,"ArrayException")
INSTANCE_TYPEABLE0(ExitCode,exitCodeTc,"ExitCode")
INSTANCE_TYPEABLE0(ErrorCall,errorCallTc,"ErrorCall")
INSTANCE_TYPEABLE0(AssertionFailed,assertionFailedTc,"AssertionFailed")
INSTANCE_TYPEABLE0(AsyncException,asyncExceptionTc,"AsyncException")
INSTANCE_TYPEABLE0(BlockedIndefinitelyOnMVar,blockedIndefinitelyOnMVarTc,"BlockedIndefinitelyOnMVar")
INSTANCE_TYPEABLE0(BlockedIndefinitelyOnSTM,blockedIndefinitelyOnSTM,"BlockedIndefinitelyOnSTM")
INSTANCE_TYPEABLE0(Deadlock,deadlockTc,"Deadlock")
instance Exception SomeException where
toException se = se
fromException = Just
instance Exception IOException where
toException = IOException
fromException (IOException e) = Just e
fromException _ = Nothing
instance Exception ArrayException where
toException = ArrayException
fromException (ArrayException e) = Just e
fromException _ = Nothing
instance Exception ArithException where
toException = ArithException
fromException (ArithException e) = Just e
fromException _ = Nothing
instance Exception ExitCode where
toException = ExitException
fromException (ExitException e) = Just e
fromException _ = Nothing
data ErrorCall = ErrorCall String
instance Show ErrorCall where
showsPrec _ (ErrorCall err) = showString err
instance Exception ErrorCall where
toException (ErrorCall s) = Hugs.Exception.ErrorCall s
fromException (Hugs.Exception.ErrorCall s) = Just (ErrorCall s)
fromException _ = Nothing
data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
data Deadlock = Deadlock
data AssertionFailed = AssertionFailed String
data AsyncException
= StackOverflow
| HeapOverflow
| ThreadKilled
| UserInterrupt
deriving (Eq, Ord)
instance Show BlockedIndefinitelyOnMVar where
showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely"
instance Show BlockedIndefinitely where
showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely"
instance Show Deadlock where
showsPrec _ Deadlock = showString "<<deadlock>>"
instance Show AssertionFailed where
showsPrec _ (AssertionFailed err) = showString err
instance Show AsyncException where
showsPrec _ StackOverflow = showString "stack overflow"
showsPrec _ HeapOverflow = showString "heap overflow"
showsPrec _ ThreadKilled = showString "thread killed"
showsPrec _ UserInterrupt = showString "user interrupt"
instance Exception BlockedOnDeadMVar
instance Exception BlockedIndefinitely
instance Exception Deadlock
instance Exception AssertionFailed
instance Exception AsyncException
throw :: Exception e => e -> a
throw e = Hugs.Exception.throw (toException e)
throwIO :: Exception e => e -> IO a
throwIO e = Hugs.Exception.throwIO (toException e)
#endif
#ifndef __GLASGOW_HASKELL__
block :: IO a -> IO a
block = id
unblock :: IO a -> IO a
unblock = id
blocked :: IO Bool
blocked = return False
#endif
#ifndef __NHC__
catch :: Exception e
=> IO a
-> (e -> IO a)
-> IO a
#if __GLASGOW_HASKELL__
catch = catchException
#elif __HUGS__
catch m h = Hugs.Exception.catchException m h'
where h' e = case fromException e of
Just e' -> h e'
Nothing -> throwIO e
#endif
#endif
catchJust
:: Exception e
=> (e -> Maybe b)
-> IO a
-> (b -> IO a)
-> IO a
catchJust p a handler = catch a handler'
where handler' e = case p e of
Nothing -> throwIO e
Just b -> handler b
handle :: Exception e => (e -> IO a) -> IO a -> IO a
handle = flip catch
handleJust :: Exception e => (e -> Maybe b) -> (b -> IO a) -> IO a -> IO a
handleJust p = flip (catchJust p)
mapException :: (Exception e1, Exception e2) => (e1 -> e2) -> a -> a
mapException f v = unsafePerformIO (catch (evaluate v)
(\x -> throwIO (f x)))
try :: Exception e => IO a -> IO (Either e a)
try a = catch (a >>= \ v -> return (Right v)) (\e -> return (Left e))
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)
onException :: IO a -> IO b -> IO a
onException io what = io `catch` \e -> do _ <- what
throwIO (e :: SomeException)
#ifndef __NHC__
bracket
:: IO a
-> (a -> IO b)
-> (a -> IO c)
-> IO c
bracket before after thing =
mask $ \restore -> do
a <- before
r <- restore (thing a) `onException` after a
_ <- after a
return r
#endif
finally :: IO a
-> IO b
-> IO a
a `finally` sequel =
mask $ \restore -> do
r <- restore a `onException` sequel
_ <- sequel
return r
bracket_ :: IO a -> IO b -> IO c -> IO c
bracket_ before after thing = bracket before (const after) (const thing)
bracketOnError
:: IO a
-> (a -> IO b)
-> (a -> IO c)
-> IO c
bracketOnError before after thing =
mask $ \restore -> do
a <- before
restore (thing a) `onException` after a
#if !(__GLASGOW_HASKELL__ || __NHC__)
assert :: Bool -> a -> a
assert True x = x
assert False _ = throw (AssertionFailed "")
#endif
#if __GLASGOW_HASKELL__ || __HUGS__
data PatternMatchFail = PatternMatchFail String
INSTANCE_TYPEABLE0(PatternMatchFail,patternMatchFailTc,"PatternMatchFail")
instance Show PatternMatchFail where
showsPrec _ (PatternMatchFail err) = showString err
#ifdef __HUGS__
instance Exception PatternMatchFail where
toException (PatternMatchFail err) = Hugs.Exception.PatternMatchFail err
fromException (Hugs.Exception.PatternMatchFail err) = Just (PatternMatchFail err)
fromException _ = Nothing
#else
instance Exception PatternMatchFail
#endif
data RecSelError = RecSelError String
INSTANCE_TYPEABLE0(RecSelError,recSelErrorTc,"RecSelError")
instance Show RecSelError where
showsPrec _ (RecSelError err) = showString err
#ifdef __HUGS__
instance Exception RecSelError where
toException (RecSelError err) = Hugs.Exception.RecSelError err
fromException (Hugs.Exception.RecSelError err) = Just (RecSelError err)
fromException _ = Nothing
#else
instance Exception RecSelError
#endif
data RecConError = RecConError String
INSTANCE_TYPEABLE0(RecConError,recConErrorTc,"RecConError")
instance Show RecConError where
showsPrec _ (RecConError err) = showString err
#ifdef __HUGS__
instance Exception RecConError where
toException (RecConError err) = Hugs.Exception.RecConError err
fromException (Hugs.Exception.RecConError err) = Just (RecConError err)
fromException _ = Nothing
#else
instance Exception RecConError
#endif
data RecUpdError = RecUpdError String
INSTANCE_TYPEABLE0(RecUpdError,recUpdErrorTc,"RecUpdError")
instance Show RecUpdError where
showsPrec _ (RecUpdError err) = showString err
#ifdef __HUGS__
instance Exception RecUpdError where
toException (RecUpdError err) = Hugs.Exception.RecUpdError err
fromException (Hugs.Exception.RecUpdError err) = Just (RecUpdError err)
fromException _ = Nothing
#else
instance Exception RecUpdError
#endif
data NoMethodError = NoMethodError String
INSTANCE_TYPEABLE0(NoMethodError,noMethodErrorTc,"NoMethodError")
instance Show NoMethodError where
showsPrec _ (NoMethodError err) = showString err
#ifdef __HUGS__
instance Exception NoMethodError where
toException (NoMethodError err) = Hugs.Exception.NoMethodError err
fromException (Hugs.Exception.NoMethodError err) = Just (NoMethodError err)
fromException _ = Nothing
#else
instance Exception NoMethodError
#endif
data NonTermination = NonTermination
INSTANCE_TYPEABLE0(NonTermination,nonTerminationTc,"NonTermination")
instance Show NonTermination where
showsPrec _ NonTermination = showString "<<loop>>"
#ifdef __HUGS__
instance Exception NonTermination where
toException NonTermination = Hugs.Exception.NonTermination
fromException Hugs.Exception.NonTermination = Just NonTermination
fromException _ = Nothing
#else
instance Exception NonTermination
#endif
data NestedAtomically = NestedAtomically
INSTANCE_TYPEABLE0(NestedAtomically,nestedAtomicallyTc,"NestedAtomically")
instance Show NestedAtomically where
showsPrec _ NestedAtomically = showString "Control.Concurrent.STM.atomically was nested"
instance Exception NestedAtomically
#endif /* __GLASGOW_HASKELL__ || __HUGS__ */
#ifdef __GLASGOW_HASKELL__
recSelError, recConError, irrefutPatError, runtimeError,
nonExhaustiveGuardsError, patError, noMethodBindingError,
absentError
:: Addr# -> a
recSelError s = throw (RecSelError ("No match in record selector "
++ unpackCStringUtf8# s))
runtimeError s = error (unpackCStringUtf8# s)
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"))
nonTermination :: SomeException
nonTermination = toException NonTermination
nestedAtomically :: SomeException
nestedAtomically = toException NestedAtomically
#endif
RetroSearch is an open source project built by @garambo | Open a GitHub Issue
Search and Browse the WWW like it's 1997 | Search results from DuckDuckGo
HTML:
3.2
| Encoding:
UTF-8
| Version:
0.7.4