{-# LANGUAGE Trustworthy #-}{-# LANGUAGE DeriveGeneric, NoImplicitPrelude, MagicHash,
 ExistentialQuantification, ImplicitParams #-}{-# OPTIONS_GHC -funbox-strict-fields #-}{-# OPTIONS_HADDOCK hide #-}------------------------------------------------------------------------------- |-- Module : GHC.IO.Exception-- Copyright : (c) The University of Glasgow, 2009-- License : see libraries/base/LICENSE---- Maintainer : libraries@haskell.org-- Stability : internal-- Portability : non-portable---- IO-related Exception types and functions-------------------------------------------------------------------------------moduleGHC.IO.Exception(BlockedIndefinitelyOnMVar (..),blockedIndefinitelyOnMVar ,BlockedIndefinitelyOnSTM (..),blockedIndefinitelyOnSTM ,Deadlock (..),AllocationLimitExceeded (..),allocationLimitExceeded ,AssertionFailed (..),SomeAsyncException (..),asyncExceptionToException ,asyncExceptionFromException ,AsyncException (..),stackOverflow ,heapOverflow ,ArrayException (..),ExitCode (..),ioException ,ioError ,IOError ,IOException (..),IOErrorType (..),userError ,assertError ,unsupportedOperation ,untangle ,)whereimportGHC.Base importGHC.Generics importGHC.List importGHC.IO importGHC.Show importGHC.Read importGHC.Exception importGHC.IO.Handle.Types importGHC.OldList (intercalate )import{-# SOURCE #-}GHC.Stack.CCS importForeign.C.Types importData.Typeable (cast )-- -------------------------------------------------------------------------- Exception datatypes and operations-- |The thread is blocked on an @MVar@, but there are no other references-- to the @MVar@ so it can't ever continue.dataBlockedIndefinitelyOnMVar =BlockedIndefinitelyOnMVar instanceException BlockedIndefinitelyOnMVar instanceShow BlockedIndefinitelyOnMVar whereshowsPrec _BlockedIndefinitelyOnMVar =showString "thread blocked indefinitely in an MVar operation"blockedIndefinitelyOnMVar::SomeException -- for the RTSblockedIndefinitelyOnMVar =toException BlockedIndefinitelyOnMVar ------- |The thread is waiting to retry an STM transaction, but there are no-- other references to any @TVar@s involved, so it can't ever continue.dataBlockedIndefinitelyOnSTM =BlockedIndefinitelyOnSTM instanceException BlockedIndefinitelyOnSTM instanceShow BlockedIndefinitelyOnSTM whereshowsPrec _BlockedIndefinitelyOnSTM =showString "thread blocked indefinitely in an STM transaction"blockedIndefinitelyOnSTM::SomeException -- for the RTSblockedIndefinitelyOnSTM =toException BlockedIndefinitelyOnSTM ------- |There are no runnable threads, so the program is deadlocked.-- The @Deadlock@ exception is raised in the main thread only.dataDeadlock =Deadlock instanceException Deadlock instanceShow Deadlock whereshowsPrec _Deadlock =showString "<<deadlock>>"------- |This thread has exceeded its allocation limit. See-- 'System.Mem.setAllocationCounter' and-- 'System.Mem.enableAllocationLimit'.---- @since 4.8.0.0dataAllocationLimitExceeded =AllocationLimitExceeded instanceException AllocationLimitExceeded wheretoException =asyncExceptionToException fromException =asyncExceptionFromException instanceShow AllocationLimitExceeded whereshowsPrec _AllocationLimitExceeded =showString "allocation limit exceeded"allocationLimitExceeded::SomeException -- for the RTSallocationLimitExceeded =toException AllocationLimitExceeded ------- |'assert' was applied to 'False'.newtypeAssertionFailed =AssertionFailed String instanceException AssertionFailed instanceShow AssertionFailed whereshowsPrec _(AssertionFailed err )=showString err ------- |Superclass for asynchronous exceptions.---- @since 4.7.0.0dataSomeAsyncException =foralle .Exception e =>SomeAsyncException e instanceShow SomeAsyncException whereshow (SomeAsyncException e )=show e instanceException SomeAsyncException -- |@since 4.7.0.0asyncExceptionToException::Exception e =>e ->SomeException asyncExceptionToException =toException . SomeAsyncException -- |@since 4.7.0.0asyncExceptionFromException::Exception e =>SomeException ->Maybe e asyncExceptionFromException x =doSomeAsyncException a <-fromException x cast a -- |Asynchronous exceptions.dataAsyncException =StackOverflow -- ^The current thread\'s stack exceeded its limit.-- Since an exception has been raised, the thread\'s stack-- will certainly be below its limit again, but the-- programmer should take remedial action-- immediately.|HeapOverflow -- ^The program\'s heap is reaching its limit, and-- the program should take action to reduce the amount of-- live data it has. Notes:---- * It is undefined which thread receives this exception.---- * GHC currently does not throw 'HeapOverflow' exceptions.|ThreadKilled -- ^This exception is raised by another thread-- calling 'Control.Concurrent.killThread', or by the system-- if it needs to terminate the thread for some-- reason.|UserInterrupt -- ^This exception is raised by default in the main thread of-- the program when the user requests to terminate the program-- via the usual mechanism(s) (e.g. Control-C in the console).deriving(Eq,Ord)instanceException AsyncException wheretoException =asyncExceptionToException fromException =asyncExceptionFromException -- | Exceptions generated by array operationsdataArrayException =IndexOutOfBounds String -- ^An attempt was made to index an array outside-- its declared bounds.|UndefinedElement String -- ^An attempt was made to evaluate an element of an-- array that had not been initialized.deriving(Eq,Ord)instanceException ArrayException -- for the RTSstackOverflow,heapOverflow::SomeException stackOverflow =toException StackOverflow heapOverflow =toException HeapOverflow instanceShow AsyncException whereshowsPrec _StackOverflow =showString "stack overflow"showsPrec_HeapOverflow =showString "heap overflow"showsPrec_ThreadKilled =showString "thread killed"showsPrec_UserInterrupt =showString "user interrupt"instanceShow ArrayException whereshowsPrec _(IndexOutOfBounds s )=showString "array index out of range". (ifnot(null s )thenshowString ": ". showString s elseid )showsPrec_(UndefinedElement s )=showString "undefined array element". (ifnot(null s )thenshowString ": ". showString s elseid )-- ------------------------------------------------------------------------------- The ExitCode type-- We need it here because it is used in ExitException in the-- Exception datatype (above).-- | Defines the exit codes that a program can return.dataExitCode =ExitSuccess -- ^ indicates successful termination;|ExitFailure Int-- ^ indicates program failure with an exit code.-- The exact interpretation of the code is-- operating-system dependent. In particular, some values-- may be prohibited (e.g. 0 on a POSIX-compliant system).deriving(Eq,Ord,Read ,Show ,Generic )instanceException ExitCode ioException::IOException ->IOa ioException err =throwIO err -- | Raise an 'IOError' in the 'IO' monad.ioError::IOError ->IOa ioError =ioException -- ----------------------------------------------------------------------------- IOError type-- | The Haskell 2010 type for exceptions in the 'IO' monad.-- Any I\/O operation may raise an 'IOError' instead of returning a result.-- For a more general type of exception, including also those that arise-- in pure code, see 'Control.Exception.Exception'.---- In Haskell 2010, this is an opaque type.typeIOError =IOException -- |Exceptions that occur in the @IO@ monad.-- An @IOException@ records a more specific error type, a descriptive-- string and maybe the handle that was used when the error was-- flagged.dataIOException =IOError {ioe_handle ::Maybe Handle ,-- the handle used by the action flagging-- the error.ioe_type ::IOErrorType ,-- what it was.ioe_location ::String ,-- location.ioe_description ::String ,-- error type specific information.ioe_errno ::Maybe CInt ,-- errno leading to this error, if any.ioe_filename ::Maybe FilePath -- filename the error is related to.}instanceException IOException instanceEqIOException where(IOError h1 e1 loc1 str1 en1 fn1 )== (IOError h2 e2 loc2 str2 en2 fn2 )=e1 ==e2 &&str1 ==str2 &&h1 ==h2 &&loc1 ==loc2 &&en1 ==en2 &&fn1 ==fn2 -- | An abstract type that contains a value for each variant of 'IOError'.dataIOErrorType -- Haskell 2010:=AlreadyExists |NoSuchThing |ResourceBusy |ResourceExhausted |EOF |IllegalOperation |PermissionDenied |UserError -- GHC only:|UnsatisfiedConstraints |SystemError |ProtocolError |OtherError |InvalidArgument |InappropriateType |HardwareFault |UnsupportedOperation |TimeExpired |ResourceVanished |Interrupted instanceEqIOErrorType wherex == y =isTrue#(getTag x ==#getTag y )instanceShow IOErrorType whereshowsPrec _e =showString $ casee ofAlreadyExists ->"already exists"NoSuchThing ->"does not exist"ResourceBusy ->"resource busy"ResourceExhausted ->"resource exhausted"EOF ->"end of file"IllegalOperation ->"illegal operation"PermissionDenied ->"permission denied"UserError ->"user error"HardwareFault ->"hardware fault"InappropriateType ->"inappropriate type"Interrupted ->"interrupted"InvalidArgument ->"invalid argument"OtherError ->"failed"ProtocolError ->"protocol error"ResourceVanished ->"resource vanished"SystemError ->"system error"TimeExpired ->"timeout"UnsatisfiedConstraints ->"unsatisfied constraints"-- ultra-precise!UnsupportedOperation ->"unsupported operation"-- | Construct an 'IOError' value with a string describing the error.-- The 'fail' method of the 'IO' instance of the 'Monad' class raises a-- 'userError', thus:---- > instance Monad IO where-- > ...-- > fail s = ioError (userError s)--userError::String ->IOError userError str =IOError Nothing UserError ""str Nothing Nothing -- ----------------------------------------------------------------------------- Showing IOErrorsinstanceShow IOException whereshowsPrec p (IOError hdl iot loc s _fn )=(casefn ofNothing ->casehdl ofNothing ->id Just h ->showsPrec p h . showString ": "Just name ->showString name . showString ": "). (caseloc of""->id _->showString loc . showString ": "). showsPrec p iot . (cases of""->id _->showString " (". showString s . showString ")")-- Note the use of "lazy". This means that-- assert False (throw e)-- will throw the assertion failure rather than e. See trac #5561.assertError::(?callStack::CallStack )=>Bool->a ->a assertError predicate v |predicate =lazyv |otherwise =unsafeDupablePerformIO $ doccsStack <-currentCallStack letimplicitParamCallStack =prettyCallStackLines ?callStackccsCallStack =showCCSStack ccsStack stack =intercalate "\n"$ implicitParamCallStack ++ ccsCallStack throwIO (AssertionFailed ("Assertion failed\n"++ stack ))unsupportedOperation::IOError unsupportedOperation =(IOError Nothing UnsupportedOperation """Operation is not supported"Nothing Nothing ){-
(untangle coded message) expects "coded" to be of the form
 "location|details"
It prints
 location message details
-}untangle::Addr#->String ->String untangle coded message =location ++ ": "++ message ++ details ++ "\n"wherecoded_str =unpackCStringUtf8#coded (location ,details )=case(span not_bar coded_str )of{(loc ,rest )->caserest of('|':det )->(loc ,' ':det )_->(loc ,"")}not_bar c =c /='|'