GHC/IO/Exception.hs

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