GHC/IO/Exception.hs

   1 {-# LANGUAGE NoImplicitPrelude, DeriveDataTypeable, MagicHash #-}
   2 {-# OPTIONS_GHC -funbox-strict-fields #-}
   3 {-# OPTIONS_HADDOCK hide #-}
   4 -----------------------------------------------------------------------------
   5 -- |
   6 -- Module      :  GHC.IO.Exception
   7 -- Copyright   :  (c) The University of Glasgow, 2009
   8 -- License     :  see libraries/base/LICENSE
   9 --
  10 -- Maintainer  :  libraries@haskell.org
  11 -- Stability   :  internal
  12 -- Portability :  non-portable
  13 --
  14 -- IO-related Exception types and functions
  15 --
  16 -----------------------------------------------------------------------------
  17
  18 module GHC.IO.Exception (
  19   BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,
  20   BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,
  21   Deadlock(..),
  22   AssertionFailed(..),
  23   AsyncException(..), stackOverflow, heapOverflow,
  24   ArrayException(..),
  25   ExitCode(..),
  26
  27   ioException,
  28   ioError,
  29   IOError,
  30   IOException(..),
  31   IOErrorType(..),
  32   userError,
  33   assertError,
  34   unsupportedOperation,
  35   untangle,
  36  ) where
  37
  38 import GHC.Base
  39 import GHC.List
  40 import GHC.IO
  41 import GHC.Show
  42 import GHC.Read
  43 import GHC.Exception
  44 import Data.Maybe
  45 import GHC.IO.Handle.Types
  46 import Foreign.C.Types
  47
  48 import Data.Typeable     ( Typeable )
  49
  50 -- ------------------------------------------------------------------------
  51 -- Exception datatypes and operations
  52
  53 -- |The thread is blocked on an @MVar@, but there are no other references
  54 -- to the @MVar@ so it can't ever continue.
  55 data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
  56     deriving Typeable
  57
  58 instance Exception BlockedIndefinitelyOnMVar
  59
  60 instance Show BlockedIndefinitelyOnMVar where
  61     showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation"
  62
  63 blockedIndefinitelyOnMVar :: SomeException -- for the RTS
  64 blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar
  65
  66 -----
  67
  68 -- |The thread is waiting to retry an STM transaction, but there are no
  69 -- other references to any @TVar@s involved, so it can't ever continue.
  70 data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
  71     deriving Typeable
  72
  73 instance Exception BlockedIndefinitelyOnSTM
  74
  75 instance Show BlockedIndefinitelyOnSTM where
  76     showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction"
  77
  78 blockedIndefinitelyOnSTM :: SomeException -- for the RTS
  79 blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM
  80
  81 -----
  82
  83 -- |There are no runnable threads, so the program is deadlocked.
  84 -- The @Deadlock@ exception is raised in the main thread only.
  85 data Deadlock = Deadlock
  86     deriving Typeable
  87
  88 instance Exception Deadlock
  89
  90 instance Show Deadlock where
  91     showsPrec _ Deadlock = showString "<<deadlock>>"
  92
  93 -----
  94
  95 -- |'assert' was applied to 'False'.
  96 data AssertionFailed = AssertionFailed String
  97     deriving Typeable
  98
  99 instance Exception AssertionFailed
 100
 101 instance Show AssertionFailed where
 102     showsPrec _ (AssertionFailed err) = showString err
 103
 104 -----
 105
 106 -- |Asynchronous exceptions.
 107 data AsyncException
 108   = StackOverflow
 109         -- ^The current thread\'s stack exceeded its limit.
 110         -- Since an exception has been raised, the thread\'s stack
 111         -- will certainly be below its limit again, but the
 112         -- programmer should take remedial action
 113         -- immediately.
 114   | HeapOverflow
 115         -- ^The program\'s heap is reaching its limit, and
 116         -- the program should take action to reduce the amount of
 117         -- live data it has. Notes:
 118         --
 119         --      * It is undefined which thread receives this exception.
 120         --
 121         --      * GHC currently does not throw 'HeapOverflow' exceptions.
 122   | ThreadKilled
 123         -- ^This exception is raised by another thread
 124         -- calling 'Control.Concurrent.killThread', or by the system
 125         -- if it needs to terminate the thread for some
 126         -- reason.
 127   | UserInterrupt
 128         -- ^This exception is raised by default in the main thread of
 129         -- the program when the user requests to terminate the program
 130         -- via the usual mechanism(s) (e.g. Control-C in the console).
 131   deriving (Eq, Ord, Typeable)
 132
 133 instance Exception AsyncException
 134
 135 -- | Exceptions generated by array operations
 136 data ArrayException
 137   = IndexOutOfBounds    String
 138         -- ^An attempt was made to index an array outside
 139         -- its declared bounds.
 140   | UndefinedElement    String
 141         -- ^An attempt was made to evaluate an element of an
 142         -- array that had not been initialized.
 143   deriving (Eq, Ord, Typeable)
 144
 145 instance Exception ArrayException
 146
 147 stackOverflow, heapOverflow :: SomeException -- for the RTS
 148 stackOverflow = toException StackOverflow
 149 heapOverflow  = toException HeapOverflow
 150
 151 instance Show AsyncException where
 152   showsPrec _ StackOverflow   = showString "stack overflow"
 153   showsPrec _ HeapOverflow    = showString "heap overflow"
 154   showsPrec _ ThreadKilled    = showString "thread killed"
 155   showsPrec _ UserInterrupt   = showString "user interrupt"
 156
 157 instance Show ArrayException where
 158   showsPrec _ (IndexOutOfBounds s)
 159         = showString "array index out of range"
 160         . (if not (null s) then showString ": " . showString s
 161                            else id)
 162   showsPrec _ (UndefinedElement s)
 163         = showString "undefined array element"
 164         . (if not (null s) then showString ": " . showString s
 165                            else id)
 166
 167 -- -----------------------------------------------------------------------------
 168 -- The ExitCode type
 169
 170 -- We need it here because it is used in ExitException in the
 171 -- Exception datatype (above).
 172
 173 -- | Defines the exit codes that a program can return.
 174 data ExitCode
 175   = ExitSuccess -- ^ indicates successful termination;
 176   | ExitFailure Int
 177                 -- ^ indicates program failure with an exit code.
 178                 -- The exact interpretation of the code is
 179                 -- operating-system dependent.  In particular, some values
 180                 -- may be prohibited (e.g. 0 on a POSIX-compliant system).
 181   deriving (Eq, Ord, Read, Show, Typeable)
 182
 183 instance Exception ExitCode
 184
 185 ioException     :: IOException -> IO a
 186 ioException err = throwIO err
 187
 188 -- | Raise an 'IOError' in the 'IO' monad.
 189 ioError         :: IOError -> IO a
 190 ioError         =  ioException
 191
 192 -- ---------------------------------------------------------------------------
 193 -- IOError type
 194
 195 -- | The Haskell 98 type for exceptions in the 'IO' monad.
 196 -- Any I\/O operation may raise an 'IOError' instead of returning a result.
 197 -- For a more general type of exception, including also those that arise
 198 -- in pure code, see "Control.Exception.Exception".
 199 --
 200 -- In Haskell 98, this is an opaque type.
 201 type IOError = IOException
 202
 203 -- |Exceptions that occur in the @IO@ monad.
 204 -- An @IOException@ records a more specific error type, a descriptive
 205 -- string and maybe the handle that was used when the error was
 206 -- flagged.
 207 data IOException
 208  = IOError {
 209      ioe_handle   :: Maybe Handle,   -- the handle used by the action flagging
 210                                      -- the error.
 211      ioe_type     :: IOErrorType,    -- what it was.
 212      ioe_location :: String,         -- location.
 213      ioe_description :: String,      -- error type specific information.
 214      ioe_errno    :: Maybe CInt,     -- errno leading to this error, if any.
 215      ioe_filename :: Maybe FilePath  -- filename the error is related to.
 216    }
 217     deriving Typeable
 218
 219 instance Exception IOException
 220
 221 instance Eq IOException where
 222   (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) =
 223     e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2
 224
 225 -- | An abstract type that contains a value for each variant of 'IOError'.
 226 data IOErrorType
 227   -- Haskell 98:
 228   = AlreadyExists
 229   | NoSuchThing
 230   | ResourceBusy
 231   | ResourceExhausted
 232   | EOF
 233   | IllegalOperation
 234   | PermissionDenied
 235   | UserError
 236   -- GHC only:
 237   | UnsatisfiedConstraints
 238   | SystemError
 239   | ProtocolError
 240   | OtherError
 241   | InvalidArgument
 242   | InappropriateType
 243   | HardwareFault
 244   | UnsupportedOperation
 245   | TimeExpired
 246   | ResourceVanished
 247   | Interrupted
 248
 249 instance Eq IOErrorType where
 250    x == y = getTag x ==# getTag y
 251
 252 instance Show IOErrorType where
 253   showsPrec _ e =
 254     showString $
 255     case e of
 256       AlreadyExists     -> "already exists"
 257       NoSuchThing       -> "does not exist"
 258       ResourceBusy      -> "resource busy"
 259       ResourceExhausted -> "resource exhausted"
 260       EOF               -> "end of file"
 261       IllegalOperation  -> "illegal operation"
 262       PermissionDenied  -> "permission denied"
 263       UserError         -> "user error"
 264       HardwareFault     -> "hardware fault"
 265       InappropriateType -> "inappropriate type"
 266       Interrupted       -> "interrupted"
 267       InvalidArgument   -> "invalid argument"
 268       OtherError        -> "failed"
 269       ProtocolError     -> "protocol error"
 270       ResourceVanished  -> "resource vanished"
 271       SystemError       -> "system error"
 272       TimeExpired       -> "timeout"
 273       UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
 274       UnsupportedOperation -> "unsupported operation"
 275
 276 -- | Construct an 'IOError' value with a string describing the error.
 277 -- The 'fail' method of the 'IO' instance of the 'Monad' class raises a
 278 -- 'userError', thus:
 279 --
 280 -- > instance Monad IO where
 281 -- >   ...
 282 -- >   fail s = ioError (userError s)
 283 --
 284 userError       :: String  -> IOError
 285 userError str   =  IOError Nothing UserError "" str Nothing Nothing
 286
 287 -- ---------------------------------------------------------------------------
 288 -- Showing IOErrors
 289
 290 instance Show IOException where
 291     showsPrec p (IOError hdl iot loc s _ fn) =
 292       (case fn of
 293          Nothing -> case hdl of
 294                         Nothing -> id
 295                         Just h  -> showsPrec p h . showString ": "
 296          Just name -> showString name . showString ": ") .
 297       (case loc of
 298          "" -> id
 299          _  -> showString loc . showString ": ") .
 300       showsPrec p iot .
 301       (case s of
 302          "" -> id
 303          _  -> showString " (" . showString s . showString ")")
 304
 305 assertError :: Addr# -> Bool -> a -> a
 306 assertError str predicate v
 307   | predicate = v
 308   | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
 309
 310 unsupportedOperation :: IOError
 311 unsupportedOperation =
 312    (IOError Nothing UnsupportedOperation ""
 313         "Operation is not supported" Nothing Nothing)
 314
 315 {-
 316 (untangle coded message) expects "coded" to be of the form
 317         "location|details"
 318 It prints
 319         location message details
 320 -}
 321 untangle :: Addr# -> String -> String
 322 untangle coded message
 323   =  location
 324   ++ ": "
 325   ++ message
 326   ++ details
 327   ++ "\n"
 328   where
 329     coded_str = unpackCStringUtf8# coded
 330
 331     (location, details)
 332       = case (span not_bar coded_str) of { (loc, rest) ->
 333         case rest of
 334           ('|':det) -> (loc, ' ' : det)
 335           _         -> (loc, "")
 336         }
 337     not_bar c = c /= '|'