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 data ExitCode
 173   = ExitSuccess -- ^ indicates successful termination;
 174   | ExitFailure Int
 175                 -- ^ indicates program failure with an exit code.
 176                 -- The exact interpretation of the code is
 177                 -- operating-system dependent.  In particular, some values
 178                 -- may be prohibited (e.g. 0 on a POSIX-compliant system).
 179   deriving (Eq, Ord, Read, Show, Typeable)
 180
 181 instance Exception ExitCode
 182
 183 ioException     :: IOException -> IO a
 184 ioException err = throwIO err
 185
 186 -- | Raise an 'IOError' in the 'IO' monad.
 187 ioError         :: IOError -> IO a
 188 ioError         =  ioException
 189
 190 -- ---------------------------------------------------------------------------
 191 -- IOError type
 192
 193 -- | The Haskell 98 type for exceptions in the 'IO' monad.
 194 -- Any I\/O operation may raise an 'IOError' instead of returning a result.
 195 -- For a more general type of exception, including also those that arise
 196 -- in pure code, see "Control.Exception.Exception".
 197 --
 198 -- In Haskell 98, this is an opaque type.
 199 type IOError = IOException
 200
 201 -- |Exceptions that occur in the @IO@ monad.
 202 -- An @IOException@ records a more specific error type, a descriptive
 203 -- string and maybe the handle that was used when the error was
 204 -- flagged.
 205 data IOException
 206  = IOError {
 207      ioe_handle   :: Maybe Handle,   -- the handle used by the action flagging
 208                                      -- the error.
 209      ioe_type     :: IOErrorType,    -- what it was.
 210      ioe_location :: String,         -- location.
 211      ioe_description :: String,      -- error type specific information.
 212      ioe_errno    :: Maybe CInt,     -- errno leading to this error, if any.
 213      ioe_filename :: Maybe FilePath  -- filename the error is related to.
 214    }
 215     deriving Typeable
 216
 217 instance Exception IOException
 218
 219 instance Eq IOException where
 220   (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) =
 221     e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2
 222
 223 -- | An abstract type that contains a value for each variant of 'IOError'.
 224 data IOErrorType
 225   -- Haskell 98:
 226   = AlreadyExists
 227   | NoSuchThing
 228   | ResourceBusy
 229   | ResourceExhausted
 230   | EOF
 231   | IllegalOperation
 232   | PermissionDenied
 233   | UserError
 234   -- GHC only:
 235   | UnsatisfiedConstraints
 236   | SystemError
 237   | ProtocolError
 238   | OtherError
 239   | InvalidArgument
 240   | InappropriateType
 241   | HardwareFault
 242   | UnsupportedOperation
 243   | TimeExpired
 244   | ResourceVanished
 245   | Interrupted
 246
 247 instance Eq IOErrorType where
 248    x == y = getTag x ==# getTag y
 249
 250 instance Show IOErrorType where
 251   showsPrec _ e =
 252     showString $
 253     case e of
 254       AlreadyExists     -> "already exists"
 255       NoSuchThing       -> "does not exist"
 256       ResourceBusy      -> "resource busy"
 257       ResourceExhausted -> "resource exhausted"
 258       EOF               -> "end of file"
 259       IllegalOperation  -> "illegal operation"
 260       PermissionDenied  -> "permission denied"
 261       UserError         -> "user error"
 262       HardwareFault     -> "hardware fault"
 263       InappropriateType -> "inappropriate type"
 264       Interrupted       -> "interrupted"
 265       InvalidArgument   -> "invalid argument"
 266       OtherError        -> "failed"
 267       ProtocolError     -> "protocol error"
 268       ResourceVanished  -> "resource vanished"
 269       SystemError       -> "system error"
 270       TimeExpired       -> "timeout"
 271       UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
 272       UnsupportedOperation -> "unsupported operation"
 273
 274 -- | Construct an 'IOError' value with a string describing the error.
 275 -- The 'fail' method of the 'IO' instance of the 'Monad' class raises a
 276 -- 'userError', thus:
 277 --
 278 -- > instance Monad IO where
 279 -- >   ...
 280 -- >   fail s = ioError (userError s)
 281 --
 282 userError       :: String  -> IOError
 283 userError str   =  IOError Nothing UserError "" str Nothing Nothing
 284
 285 -- ---------------------------------------------------------------------------
 286 -- Showing IOErrors
 287
 288 instance Show IOException where
 289     showsPrec p (IOError hdl iot loc s _ fn) =
 290       (case fn of
 291          Nothing -> case hdl of
 292                         Nothing -> id
 293                         Just h  -> showsPrec p h . showString ": "
 294          Just name -> showString name . showString ": ") .
 295       (case loc of
 296          "" -> id
 297          _  -> showString loc . showString ": ") .
 298       showsPrec p iot .
 299       (case s of
 300          "" -> id
 301          _  -> showString " (" . showString s . showString ")")
 302
 303 assertError :: Addr# -> Bool -> a -> a
 304 assertError str predicate v
 305   | predicate = v
 306   | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
 307
 308 unsupportedOperation :: IOError
 309 unsupportedOperation =
 310    (IOError Nothing UnsupportedOperation ""
 311         "Operation is not supported" Nothing Nothing)
 312
 313 {-
 314 (untangle coded message) expects "coded" to be of the form
 315         "location|details"
 316 It prints
 317         location message details
 318 -}
 319 untangle :: Addr# -> String -> String
 320 untangle coded message
 321   =  location
 322   ++ ": "
 323   ++ message
 324   ++ details
 325   ++ "\n"
 326   where
 327     coded_str = unpackCStringUtf8# coded
 328
 329     (location, details)
 330       = case (span not_bar coded_str) of { (loc, rest) ->
 331         case rest of
 332           ('|':det) -> (loc, ' ' : det)
 333           _         -> (loc, "")
 334         }
 335     not_bar c = c /= '|'