Exception.hs 12.1 KB
Newer Older
1
{-# LANGUAGE Trustworthy #-}
2
{-# LANGUAGE DeriveGeneric, NoImplicitPrelude, MagicHash,
3
             ExistentialQuantification #-}
4
{-# OPTIONS_GHC -funbox-strict-fields #-}
5
{-# OPTIONS_HADDOCK hide #-}
dterei's avatar
dterei committed
6

7 8 9 10 11
-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.IO.Exception
-- Copyright   :  (c) The University of Glasgow, 2009
-- License     :  see libraries/base/LICENSE
Jan Stolarek's avatar
Jan Stolarek committed
12
--
13 14 15 16 17 18 19 20 21
-- Maintainer  :  libraries@haskell.org
-- Stability   :  internal
-- Portability :  non-portable
--
-- IO-related Exception types and functions
--
-----------------------------------------------------------------------------

module GHC.IO.Exception (
Simon Marlow's avatar
Simon Marlow committed
22 23
  BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,
  BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,
24
  Deadlock(..),
25
  AllocationLimitExceeded(..), allocationLimitExceeded,
26
  AssertionFailed(..),
27 28 29

  SomeAsyncException(..),
  asyncExceptionToException, asyncExceptionFromException,
30
  AsyncException(..), stackOverflow, heapOverflow,
31

32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
  ArrayException(..),
  ExitCode(..),

  ioException,
  ioError,
  IOError,
  IOException(..),
  IOErrorType(..),
  userError,
  assertError,
  unsupportedOperation,
  untangle,
 ) where

import GHC.Base
47
import GHC.Generics
48 49 50 51 52 53 54 55
import GHC.List
import GHC.IO
import GHC.Show
import GHC.Read
import GHC.Exception
import GHC.IO.Handle.Types
import Foreign.C.Types

56
import Data.Typeable ( cast )
57 58 59 60 61 62

-- ------------------------------------------------------------------------
-- 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.
Simon Marlow's avatar
Simon Marlow committed
63
data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
64

Simon Marlow's avatar
Simon Marlow committed
65
instance Exception BlockedIndefinitelyOnMVar
66

Simon Marlow's avatar
Simon Marlow committed
67 68
instance Show BlockedIndefinitelyOnMVar where
    showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation"
69

Simon Marlow's avatar
Simon Marlow committed
70 71
blockedIndefinitelyOnMVar :: SomeException -- for the RTS
blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar
72 73 74

-----

Ian Lynagh's avatar
Ian Lynagh committed
75
-- |The thread is waiting to retry an STM transaction, but there are no
76
-- other references to any @TVar@s involved, so it can't ever continue.
Simon Marlow's avatar
Simon Marlow committed
77
data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
78

Simon Marlow's avatar
Simon Marlow committed
79
instance Exception BlockedIndefinitelyOnSTM
80

Simon Marlow's avatar
Simon Marlow committed
81 82
instance Show BlockedIndefinitelyOnSTM where
    showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction"
83

Simon Marlow's avatar
Simon Marlow committed
84 85
blockedIndefinitelyOnSTM :: SomeException -- for the RTS
blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM
86 87 88 89 90 91 92 93 94 95 96 97 98 99

-----

-- |There are no runnable threads, so the program is deadlocked.
-- The @Deadlock@ exception is raised in the main thread only.
data Deadlock = Deadlock

instance Exception Deadlock

instance Show Deadlock where
    showsPrec _ Deadlock = showString "<<deadlock>>"

-----

100 101 102
-- |This thread has exceeded its allocation limit.  See
-- 'GHC.Conc.setAllocationCounter' and
-- 'GHC.Conc.enableAllocationLimit'.
103
--
104
-- @since 4.8.0.0
105 106
data AllocationLimitExceeded = AllocationLimitExceeded

107 108 109
instance Exception AllocationLimitExceeded where
  toException = asyncExceptionToException
  fromException = asyncExceptionFromException
110 111 112 113 114 115 116 117 118 119

instance Show AllocationLimitExceeded where
    showsPrec _ AllocationLimitExceeded =
      showString "allocation limit exceeded"

allocationLimitExceeded :: SomeException -- for the RTS
allocationLimitExceeded = toException AllocationLimitExceeded

-----

120
-- |'assert' was applied to 'False'.
121 122 123 124 125 126 127 128 129
data AssertionFailed = AssertionFailed String

instance Exception AssertionFailed

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

-----

130 131
-- |Superclass for asynchronous exceptions.
--
132
-- @since 4.7.0.0
133 134 135 136 137 138 139
data SomeAsyncException = forall e . Exception e => SomeAsyncException e

instance Show SomeAsyncException where
    show (SomeAsyncException e) = show e

instance Exception SomeAsyncException

140
-- |@since 4.7.0.0
141 142 143
asyncExceptionToException :: Exception e => e -> SomeException
asyncExceptionToException = toException . SomeAsyncException

144
-- |@since 4.7.0.0
145 146 147 148 149 150
asyncExceptionFromException :: Exception e => SomeException -> Maybe e
asyncExceptionFromException x = do
    SomeAsyncException a <- fromException x
    cast a


151 152 153 154 155 156 157 158 159 160 161 162 163
-- |Asynchronous exceptions.
data AsyncException
  = 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:
        --
164
        --   * It is undefined which thread receives this exception.
165
        --
166
        --   * GHC currently does not throw 'HeapOverflow' exceptions.
167 168 169 170 171 172 173 174 175
  | 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).
176
  deriving (Eq, Ord)
177

178 179 180
instance Exception AsyncException where
  toException = asyncExceptionToException
  fromException = asyncExceptionFromException
181 182 183 184 185 186 187 188 189

-- | Exceptions generated by array operations
data ArrayException
  = 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.
190
  deriving (Eq, Ord)
191 192 193

instance Exception ArrayException

194 195
-- for the RTS
stackOverflow, heapOverflow :: SomeException
196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220
stackOverflow = toException StackOverflow
heapOverflow  = toException HeapOverflow

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 Show ArrayException where
  showsPrec _ (IndexOutOfBounds s)
        = showString "array index out of range"
        . (if not (null s) then showString ": " . showString s
                           else id)
  showsPrec _ (UndefinedElement s)
        = showString "undefined array element"
        . (if not (null s) then showString ": " . showString s
                           else id)

-- -----------------------------------------------------------------------------
-- The ExitCode type

-- We need it here because it is used in ExitException in the
-- Exception datatype (above).

Simon Marlow's avatar
Simon Marlow committed
221
-- | Defines the exit codes that a program can return.
222 223 224 225 226 227 228
data ExitCode
  = 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).
229
  deriving (Eq, Ord, Read, Show, Generic)
230 231 232 233 234 235 236

instance Exception ExitCode

ioException     :: IOException -> IO a
ioException err = throwIO err

-- | Raise an 'IOError' in the 'IO' monad.
Jan Stolarek's avatar
Jan Stolarek committed
237
ioError         :: IOError -> IO a
238 239 240 241 242
ioError         =  ioException

-- ---------------------------------------------------------------------------
-- IOError type

243
-- | The Haskell 2010 type for exceptions in the 'IO' monad.
244 245
-- 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
246
-- in pure code, see 'Control.Exception.Exception'.
247
--
248
-- In Haskell 2010, this is an opaque type.
249 250 251 252 253 254 255 256
type IOError = 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.
data IOException
 = IOError {
Jan Stolarek's avatar
Jan Stolarek committed
257
     ioe_handle   :: Maybe Handle,   -- the handle used by the action flagging
258 259 260 261 262 263 264 265 266 267 268
                                     -- 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.
   }

instance Exception IOException

instance Eq IOException where
Jan Stolarek's avatar
Jan Stolarek committed
269
  (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) =
270 271 272 273
    e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2

-- | An abstract type that contains a value for each variant of 'IOError'.
data IOErrorType
274
  -- Haskell 2010:
275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296
  = AlreadyExists
  | NoSuchThing
  | ResourceBusy
  | ResourceExhausted
  | EOF
  | IllegalOperation
  | PermissionDenied
  | UserError
  -- GHC only:
  | UnsatisfiedConstraints
  | SystemError
  | ProtocolError
  | OtherError
  | InvalidArgument
  | InappropriateType
  | HardwareFault
  | UnsupportedOperation
  | TimeExpired
  | ResourceVanished
  | Interrupted

instance Eq IOErrorType where
297 298
   x == y = isTrue# (getTag x ==# getTag y)

299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319
instance Show IOErrorType where
  showsPrec _ e =
    showString $
    case e of
      AlreadyExists     -> "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"
Gabor Greif's avatar
Gabor Greif committed
320
      UnsatisfiedConstraints -> "unsatisfied constraints" -- ultra-precise!
321 322 323 324 325 326
      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:
--
Jan Stolarek's avatar
Jan Stolarek committed
327
-- > instance Monad IO where
328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346
-- >   ...
-- >   fail s = ioError (userError s)
--
userError       :: String  -> IOError
userError str   =  IOError Nothing UserError "" str Nothing Nothing

-- ---------------------------------------------------------------------------
-- Showing IOErrors

instance Show IOException where
    showsPrec p (IOError hdl iot loc s _ fn) =
      (case fn of
         Nothing -> case hdl of
                        Nothing -> id
                        Just h  -> showsPrec p h . showString ": "
         Just name -> showString name . showString ": ") .
      (case loc of
         "" -> id
         _  -> showString loc . showString ": ") .
Jan Stolarek's avatar
Jan Stolarek committed
347
      showsPrec p iot .
348 349 350 351
      (case s of
         "" -> id
         _  -> showString " (" . showString s . showString ")")

352 353 354
-- Note the use of "lazy". This means that
--     assert False (throw e)
-- will throw the assertion failure rather than e. See trac #5561.
355 356
assertError :: Addr# -> Bool -> a -> a
assertError str predicate v
357
  | predicate = lazy v
358 359 360
  | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))

unsupportedOperation :: IOError
Jan Stolarek's avatar
Jan Stolarek committed
361
unsupportedOperation =
362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387
   (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"
  where
    coded_str = unpackCStringUtf8# coded

    (location, details)
      = case (span not_bar coded_str) of { (loc, rest) ->
        case rest of
          ('|':det) -> (loc, ' ' : det)
          _         -> (loc, "")
        }
    not_bar c = c /= '|'
dterei's avatar
dterei committed
388