1{-# LANGUAGE Trustworthy #-} 2{-# LANGUAGE DeriveGeneric, NoImplicitPrelude, MagicHash, 3 ExistentialQuantification, ImplicitParams #-} 4{-# OPTIONS_GHC -funbox-strict-fields #-} 5{-# OPTIONS_HADDOCK not-home #-} 6 7----------------------------------------------------------------------------- 8-- | 9-- Module : GHC.IO.Exception 10-- Copyright : (c) The University of Glasgow, 2009 11-- License : see libraries/base/LICENSE 12-- 13-- Maintainer : libraries@haskell.org 14-- Stability : internal 15-- Portability : non-portable 16-- 17-- IO-related Exception types and functions 18-- 19----------------------------------------------------------------------------- 20 21module GHC.IO.Exception ( 22 BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar, 23 BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM, 24 Deadlock(..), 25 AllocationLimitExceeded(..), allocationLimitExceeded, 26 AssertionFailed(..), 27 CompactionFailed(..), 28 cannotCompactFunction, cannotCompactPinned, cannotCompactMutable, 29 30 SomeAsyncException(..), 31 asyncExceptionToException, asyncExceptionFromException, 32 AsyncException(..), stackOverflow, heapOverflow, 33 34 ArrayException(..), 35 ExitCode(..), 36 FixIOException (..), 37 38 ioException, 39 ioError, 40 IOError, 41 IOException(..), 42 IOErrorType(..), 43 userError, 44 assertError, 45 unsupportedOperation, 46 untangle, 47 ) where 48 49import GHC.Base 50import GHC.Generics 51import GHC.List 52import GHC.IO 53import GHC.Show 54import GHC.Read 55import GHC.Exception 56import GHC.IO.Handle.Types 57import GHC.OldList ( intercalate ) 58import {-# SOURCE #-} GHC.Stack.CCS 59import Foreign.C.Types 60 61import Data.Typeable ( cast ) 62 63-- ------------------------------------------------------------------------ 64-- Exception datatypes and operations 65 66-- |The thread is blocked on an @MVar@, but there are no other references 67-- to the @MVar@ so it can't ever continue. 68data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar 69 70-- | @since 4.1.0.0 71instance Exception BlockedIndefinitelyOnMVar 72 73-- | @since 4.1.0.0 74instance Show BlockedIndefinitelyOnMVar where 75 showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation" 76 77blockedIndefinitelyOnMVar :: SomeException -- for the RTS 78blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar 79 80----- 81 82-- |The thread is waiting to retry an STM transaction, but there are no 83-- other references to any @TVar@s involved, so it can't ever continue. 84data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM 85 86-- | @since 4.1.0.0 87instance Exception BlockedIndefinitelyOnSTM 88 89-- | @since 4.1.0.0 90instance Show BlockedIndefinitelyOnSTM where 91 showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction" 92 93blockedIndefinitelyOnSTM :: SomeException -- for the RTS 94blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM 95 96----- 97 98-- |There are no runnable threads, so the program is deadlocked. 99-- The @Deadlock@ exception is raised in the main thread only. 100data Deadlock = Deadlock 101 102-- | @since 4.1.0.0 103instance Exception Deadlock 104 105-- | @since 4.1.0.0 106instance Show Deadlock where 107 showsPrec _ Deadlock = showString "<<deadlock>>" 108 109----- 110 111-- |This thread has exceeded its allocation limit. See 112-- 'System.Mem.setAllocationCounter' and 113-- 'System.Mem.enableAllocationLimit'. 114-- 115-- @since 4.8.0.0 116data AllocationLimitExceeded = AllocationLimitExceeded 117 118-- | @since 4.8.0.0 119instance Exception AllocationLimitExceeded where 120 toException = asyncExceptionToException 121 fromException = asyncExceptionFromException 122 123-- | @since 4.7.1.0 124instance Show AllocationLimitExceeded where 125 showsPrec _ AllocationLimitExceeded = 126 showString "allocation limit exceeded" 127 128allocationLimitExceeded :: SomeException -- for the RTS 129allocationLimitExceeded = toException AllocationLimitExceeded 130 131----- 132 133-- | Compaction found an object that cannot be compacted. Functions 134-- cannot be compacted, nor can mutable objects or pinned objects. 135-- See 'GHC.Compact.compact'. 136-- 137-- @since 4.10.0.0 138newtype CompactionFailed = CompactionFailed String 139 140-- | @since 4.10.0.0 141instance Exception CompactionFailed where 142 143-- | @since 4.10.0.0 144instance Show CompactionFailed where 145 showsPrec _ (CompactionFailed why) = 146 showString ("compaction failed: " ++ why) 147 148cannotCompactFunction :: SomeException -- for the RTS 149cannotCompactFunction = 150 toException (CompactionFailed "cannot compact functions") 151 152cannotCompactPinned :: SomeException -- for the RTS 153cannotCompactPinned = 154 toException (CompactionFailed "cannot compact pinned objects") 155 156cannotCompactMutable :: SomeException -- for the RTS 157cannotCompactMutable = 158 toException (CompactionFailed "cannot compact mutable objects") 159 160----- 161 162-- |'assert' was applied to 'False'. 163newtype AssertionFailed = AssertionFailed String 164 165-- | @since 4.1.0.0 166instance Exception AssertionFailed 167 168-- | @since 4.1.0.0 169instance Show AssertionFailed where 170 showsPrec _ (AssertionFailed err) = showString err 171 172----- 173 174-- |Superclass for asynchronous exceptions. 175-- 176-- @since 4.7.0.0 177data SomeAsyncException = forall e . Exception e => SomeAsyncException e 178 179-- | @since 4.7.0.0 180instance Show SomeAsyncException where 181 showsPrec p (SomeAsyncException e) = showsPrec p e 182 183-- | @since 4.7.0.0 184instance Exception SomeAsyncException 185 186-- |@since 4.7.0.0 187asyncExceptionToException :: Exception e => e -> SomeException 188asyncExceptionToException = toException . SomeAsyncException 189 190-- |@since 4.7.0.0 191asyncExceptionFromException :: Exception e => SomeException -> Maybe e 192asyncExceptionFromException x = do 193 SomeAsyncException a <- fromException x 194 cast a 195 196 197-- |Asynchronous exceptions. 198data AsyncException 199 = StackOverflow 200 -- ^The current thread\'s stack exceeded its limit. 201 -- Since an exception has been raised, the thread\'s stack 202 -- will certainly be below its limit again, but the 203 -- programmer should take remedial action 204 -- immediately. 205 | HeapOverflow 206 -- ^The program\'s heap is reaching its limit, and 207 -- the program should take action to reduce the amount of 208 -- live data it has. Notes: 209 -- 210 -- * It is undefined which thread receives this exception. 211 -- GHC currently throws this to the same thread that 212 -- receives 'UserInterrupt', but this may change in the 213 -- future. 214 -- 215 -- * The GHC RTS currently can only recover from heap overflow 216 -- if it detects that an explicit memory limit (set via RTS flags). 217 -- has been exceeded. Currently, failure to allocate memory from 218 -- the operating system results in immediate termination of the 219 -- program. 220 | ThreadKilled 221 -- ^This exception is raised by another thread 222 -- calling 'Control.Concurrent.killThread', or by the system 223 -- if it needs to terminate the thread for some 224 -- reason. 225 | UserInterrupt 226 -- ^This exception is raised by default in the main thread of 227 -- the program when the user requests to terminate the program 228 -- via the usual mechanism(s) (e.g. Control-C in the console). 229 deriving ( Eq -- ^ @since 4.2.0.0 230 , Ord -- ^ @since 4.2.0.0 231 ) 232 233-- | @since 4.7.0.0 234instance Exception AsyncException where 235 toException = asyncExceptionToException 236 fromException = asyncExceptionFromException 237 238-- | Exceptions generated by array operations 239data ArrayException 240 = IndexOutOfBounds String 241 -- ^An attempt was made to index an array outside 242 -- its declared bounds. 243 | UndefinedElement String 244 -- ^An attempt was made to evaluate an element of an 245 -- array that had not been initialized. 246 deriving ( Eq -- ^ @since 4.2.0.0 247 , Ord -- ^ @since 4.2.0.0 248 ) 249 250-- | @since 4.1.0.0 251instance Exception ArrayException 252 253-- for the RTS 254stackOverflow, heapOverflow :: SomeException 255stackOverflow = toException StackOverflow 256heapOverflow = toException HeapOverflow 257 258-- | @since 4.1.0.0 259instance Show AsyncException where 260 showsPrec _ StackOverflow = showString "stack overflow" 261 showsPrec _ HeapOverflow = showString "heap overflow" 262 showsPrec _ ThreadKilled = showString "thread killed" 263 showsPrec _ UserInterrupt = showString "user interrupt" 264 265-- | @since 4.1.0.0 266instance Show ArrayException where 267 showsPrec _ (IndexOutOfBounds s) 268 = showString "array index out of range" 269 . (if not (null s) then showString ": " . showString s 270 else id) 271 showsPrec _ (UndefinedElement s) 272 = showString "undefined array element" 273 . (if not (null s) then showString ": " . showString s 274 else id) 275 276-- | The exception thrown when an infinite cycle is detected in 277-- 'System.IO.fixIO'. 278-- 279-- @since 4.11.0.0 280data FixIOException = FixIOException 281 282-- | @since 4.11.0.0 283instance Exception FixIOException 284 285-- | @since 4.11.0.0 286instance Show FixIOException where 287 showsPrec _ FixIOException = showString "cyclic evaluation in fixIO" 288 289-- ----------------------------------------------------------------------------- 290-- The ExitCode type 291 292-- We need it here because it is used in ExitException in the 293-- Exception datatype (above). 294 295-- | Defines the exit codes that a program can return. 296data ExitCode 297 = ExitSuccess -- ^ indicates successful termination; 298 | ExitFailure Int 299 -- ^ indicates program failure with an exit code. 300 -- The exact interpretation of the code is 301 -- operating-system dependent. In particular, some values 302 -- may be prohibited (e.g. 0 on a POSIX-compliant system). 303 deriving (Eq, Ord, Read, Show, Generic) 304 305-- | @since 4.1.0.0 306instance Exception ExitCode 307 308ioException :: IOException -> IO a 309ioException err = throwIO err 310 311-- | Raise an 'IOError' in the 'IO' monad. 312ioError :: IOError -> IO a 313ioError = ioException 314 315-- --------------------------------------------------------------------------- 316-- IOError type 317 318-- | The Haskell 2010 type for exceptions in the 'IO' monad. 319-- Any I\/O operation may raise an 'IOError' instead of returning a result. 320-- For a more general type of exception, including also those that arise 321-- in pure code, see 'Control.Exception.Exception'. 322-- 323-- In Haskell 2010, this is an opaque type. 324type IOError = IOException 325 326-- |Exceptions that occur in the @IO@ monad. 327-- An @IOException@ records a more specific error type, a descriptive 328-- string and maybe the handle that was used when the error was 329-- flagged. 330data IOException 331 = IOError { 332 ioe_handle :: Maybe Handle, -- the handle used by the action flagging 333 -- the error. 334 ioe_type :: IOErrorType, -- what it was. 335 ioe_location :: String, -- location. 336 ioe_description :: String, -- error type specific information. 337 ioe_errno :: Maybe CInt, -- errno leading to this error, if any. 338 ioe_filename :: Maybe FilePath -- filename the error is related to. 339 } 340 341-- | @since 4.1.0.0 342instance Exception IOException 343 344-- | @since 4.1.0.0 345instance Eq IOException where 346 (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) = 347 e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2 348 349-- | An abstract type that contains a value for each variant of 'IOError'. 350data IOErrorType 351 -- Haskell 2010: 352 = AlreadyExists 353 | NoSuchThing 354 | ResourceBusy 355 | ResourceExhausted 356 | EOF 357 | IllegalOperation 358 | PermissionDenied 359 | UserError 360 -- GHC only: 361 | UnsatisfiedConstraints 362 | SystemError 363 | ProtocolError 364 | OtherError 365 | InvalidArgument 366 | InappropriateType 367 | HardwareFault 368 | UnsupportedOperation 369 | TimeExpired 370 | ResourceVanished 371 | Interrupted 372 373-- | @since 4.1.0.0 374instance Eq IOErrorType where 375 x == y = isTrue# (getTag x ==# getTag y) 376 377-- | @since 4.1.0.0 378instance Show IOErrorType where 379 showsPrec _ e = 380 showString $ 381 case e of 382 AlreadyExists -> "already exists" 383 NoSuchThing -> "does not exist" 384 ResourceBusy -> "resource busy" 385 ResourceExhausted -> "resource exhausted" 386 EOF -> "end of file" 387 IllegalOperation -> "illegal operation" 388 PermissionDenied -> "permission denied" 389 UserError -> "user error" 390 HardwareFault -> "hardware fault" 391 InappropriateType -> "inappropriate type" 392 Interrupted -> "interrupted" 393 InvalidArgument -> "invalid argument" 394 OtherError -> "failed" 395 ProtocolError -> "protocol error" 396 ResourceVanished -> "resource vanished" 397 SystemError -> "system error" 398 TimeExpired -> "timeout" 399 UnsatisfiedConstraints -> "unsatisfied constraints" -- ultra-precise! 400 UnsupportedOperation -> "unsupported operation" 401 402-- | Construct an 'IOError' value with a string describing the error. 403-- The 'fail' method of the 'IO' instance of the 'Monad' class raises a 404-- 'userError', thus: 405-- 406-- > instance Monad IO where 407-- > ... 408-- > fail s = ioError (userError s) 409-- 410userError :: String -> IOError 411userError str = IOError Nothing UserError "" str Nothing Nothing 412 413-- --------------------------------------------------------------------------- 414-- Showing IOErrors 415 416-- | @since 4.1.0.0 417instance Show IOException where 418 showsPrec p (IOError hdl iot loc s _ fn) = 419 (case fn of 420 Nothing -> case hdl of 421 Nothing -> id 422 Just h -> showsPrec p h . showString ": " 423 Just name -> showString name . showString ": ") . 424 (case loc of 425 "" -> id 426 _ -> showString loc . showString ": ") . 427 showsPrec p iot . 428 (case s of 429 "" -> id 430 _ -> showString " (" . showString s . showString ")") 431 432-- Note the use of "lazy". This means that 433-- assert False (throw e) 434-- will throw the assertion failure rather than e. See trac #5561. 435assertError :: (?callStack :: CallStack) => Bool -> a -> a 436assertError predicate v 437 | predicate = lazy v 438 | otherwise = unsafeDupablePerformIO $ do 439 ccsStack <- currentCallStack 440 let 441 implicitParamCallStack = prettyCallStackLines ?callStack 442 ccsCallStack = showCCSStack ccsStack 443 stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack 444 throwIO (AssertionFailed ("Assertion failed\n" ++ stack)) 445 446unsupportedOperation :: IOError 447unsupportedOperation = 448 (IOError Nothing UnsupportedOperation "" 449 "Operation is not supported" Nothing Nothing) 450 451{- 452(untangle coded message) expects "coded" to be of the form 453 "location|details" 454It prints 455 location message details 456-} 457untangle :: Addr# -> String -> String 458untangle coded message 459 = location 460 ++ ": " 461 ++ message 462 ++ details 463 ++ "\n" 464 where 465 coded_str = unpackCStringUtf8# coded 466 467 (location, details) 468 = case (span not_bar coded_str) of { (loc, rest) -> 469 case rest of 470 ('|':det) -> (loc, ' ' : det) 471 _ -> (loc, "") 472 } 473 not_bar c = c /= '|' 474 475