ghc/lib/std/PrelCError.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: PrelCError.lhs,v 1.1 2001/01/11 17:25:57 simonmar Exp $
   3 %
   4 % (c) The FFI task force, 2000
   5 %
   6
   7 C-specific Marshalling support: Handling of C "errno" error codes
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 -- this is were we get the CCONST_XXX definitions from that configure
  13 -- calculated for us
  14 --
  15 #include "config.h"
  16
  17 module PrelCError (
  18
  19   -- Haskell representation for "errno" values
  20   --
  21   Errno(..),            -- instance: Eq
  22   e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,
  23   eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED,
  24   eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT,
  25   eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ,
  26   eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK,
  27   eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH,
  28   eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK,
  29   eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS,
  30   eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTTY, eNXIO,
  31   eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL,
  32   ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE,
  33   eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN,
  34   eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT,
  35   eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV,
  36                         -- :: Errno
  37   isValidErrno,         -- :: Errno -> Bool
  38
  39   -- access to the current thread's "errno" value
  40   --
  41   getErrno,             -- :: IO Errno
  42
  43   -- conversion of an "errno" value into IO error
  44   --
  45   errnoToIOError,       -- :: String       -- location
  46                         -- -> Errno        -- errno
  47                         -- -> Maybe Handle -- handle
  48                         -- -> Maybe String -- filename
  49                         -- -> IOError
  50
  51   -- throw current "errno" value
  52   --
  53   throwErrno,           -- ::                String               -> IO a
  54
  55   -- guards for IO operations that may fail
  56   --
  57   throwErrnoIf,         -- :: (a -> Bool) -> String -> IO a       -> IO a
  58   throwErrnoIf_,        -- :: (a -> Bool) -> String -> IO a       -> IO ()
  59   throwErrnoIfRetry,    -- :: (a -> Bool) -> String -> IO a       -> IO a
  60   throwErrnoIfRetry_,   -- :: (a -> Bool) -> String -> IO a       -> IO ()
  61   throwErrnoIfMinus1,   -- :: Num a
  62                         -- =>                String -> IO a       -> IO a
  63   throwErrnoIfMinus1_,  -- :: Num a
  64                         -- =>                String -> IO a       -> IO ()
  65   throwErrnoIfMinus1Retry,
  66                         -- :: Num a
  67                         -- =>                String -> IO a       -> IO a
  68   throwErrnoIfMinus1Retry_,
  69                         -- :: Num a
  70                         -- =>                String -> IO a       -> IO ()
  71   throwErrnoIfNull,     -- ::                String -> IO (Ptr a) -> IO (Ptr a)
  72   throwErrnoIfNullRetry -- ::                String -> IO (Ptr a) -> IO (Ptr a)
  73 ) where
  74
  75
  76 -- system dependent imports
  77 -- ------------------------
  78
  79 -- GHC allows us to get at the guts inside IO errors/exceptions
  80 --
  81 #if __GLASGOW_HASKELL__
  82 #if __GLASGOW_HASKELL__ < 409
  83 import PrelIOBase (IOError(..), IOErrorType(..))
  84 #else
  85 import PrelIOBase (Exception(..), IOException(..), IOErrorType(..))
  86 #endif
  87 #endif /* __GLASGOW_HASKELL__ */
  88
  89
  90 -- regular imports
  91 -- ---------------
  92
  93 import Monad        (liftM)
  94
  95 #if __GLASGOW_HASKELL__
  96 import PrelStorable
  97 import PrelMarshalError
  98 import PrelCTypes
  99 import PrelIOBase
 100 import PrelPtr
 101 import PrelNum
 102 import PrelShow
 103 import PrelMaybe
 104 import PrelBase
 105 #else
 106 import Ptr          (Ptr, nullPtr)
 107 import CTypes       (CInt)
 108 import MarshalError (void)
 109
 110 import IO           (IOError, Handle, ioError)
 111 #endif
 112
 113 -- system dependent re-definitions
 114 -- -------------------------------
 115
 116 -- we bring GHC's `IOErrorType' in scope in other compilers to simplify the
 117 -- routine `errnoToIOError' below
 118 --
 119 #if !__GLASGOW_HASKELL__
 120 data IOErrorType
 121   = AlreadyExists        | HardwareFault
 122   | IllegalOperation     | InappropriateType
 123   | Interrupted          | InvalidArgument
 124   | NoSuchThing          | OtherError
 125   | PermissionDenied     | ProtocolError
 126   | ResourceBusy         | ResourceExhausted
 127   | ResourceVanished     | SystemError
 128   | TimeExpired          | UnsatisfiedConstraints
 129   | UnsupportedOperation
 130   | EOF
 131 #endif
 132
 133
 134 -- "errno" type
 135 -- ------------
 136
 137 -- Haskell representation for "errno" values
 138 --
 139 newtype Errno = Errno CInt
 140
 141 instance Eq Errno where
 142   errno1@(Errno no1) == errno2@(Errno no2)
 143     | isValidErrno errno1 && isValidErrno errno2 = no1 == no2
 144     | otherwise                                  = False
 145
 146 -- common "errno" symbols
 147 --
 148 e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,
 149   eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED,
 150   eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT,
 151   eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ,
 152   eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK,
 153   eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH,
 154   eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK,
 155   eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS,
 156   eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTTY, eNXIO,
 157   eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL,
 158   ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE,
 159   eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN,
 160   eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT,
 161   eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV                    :: Errno
 162 --
 163 -- the CCONST_XXX identifiers are cpp symbols whose value is computed by
 164 -- configure
 165 --
 166 e2BIG           = Errno CCONST_E2BIG
 167 eACCES          = Errno CCONST_EACCES
 168 eADDRINUSE      = Errno CCONST_EADDRINUSE
 169 eADDRNOTAVAIL   = Errno CCONST_EADDRNOTAVAIL
 170 eADV            = Errno CCONST_EADV
 171 eAFNOSUPPORT    = Errno CCONST_EAFNOSUPPORT
 172 eAGAIN          = Errno CCONST_EAGAIN
 173 eALREADY        = Errno CCONST_EALREADY
 174 eBADF           = Errno CCONST_EBADF
 175 eBADMSG         = Errno CCONST_EBADMSG
 176 eBADRPC         = Errno CCONST_EBADRPC
 177 eBUSY           = Errno CCONST_EBUSY
 178 eCHILD          = Errno CCONST_ECHILD
 179 eCOMM           = Errno CCONST_ECOMM
 180 eCONNABORTED    = Errno CCONST_ECONNABORTED
 181 eCONNREFUSED    = Errno CCONST_ECONNREFUSED
 182 eCONNRESET      = Errno CCONST_ECONNRESET
 183 eDEADLK         = Errno CCONST_EDEADLK
 184 eDESTADDRREQ    = Errno CCONST_EDESTADDRREQ
 185 eDIRTY          = Errno CCONST_EDIRTY
 186 eDOM            = Errno CCONST_EDOM
 187 eDQUOT          = Errno CCONST_EDQUOT
 188 eEXIST          = Errno CCONST_EEXIST
 189 eFAULT          = Errno CCONST_EFAULT
 190 eFBIG           = Errno CCONST_EFBIG
 191 eFTYPE          = Errno CCONST_EFTYPE
 192 eHOSTDOWN       = Errno CCONST_EHOSTDOWN
 193 eHOSTUNREACH    = Errno CCONST_EHOSTUNREACH
 194 eIDRM           = Errno CCONST_EIDRM
 195 eILSEQ          = Errno CCONST_EILSEQ
 196 eINPROGRESS     = Errno CCONST_EINPROGRESS
 197 eINTR           = Errno CCONST_EINTR
 198 eINVAL          = Errno CCONST_EINVAL
 199 eIO             = Errno CCONST_EIO
 200 eISCONN         = Errno CCONST_EISCONN
 201 eISDIR          = Errno CCONST_EISDIR
 202 eLOOP           = Errno CCONST_ELOOP
 203 eMFILE          = Errno CCONST_EMFILE
 204 eMLINK          = Errno CCONST_EMLINK
 205 eMSGSIZE        = Errno CCONST_EMSGSIZE
 206 eMULTIHOP       = Errno CCONST_EMULTIHOP
 207 eNAMETOOLONG    = Errno CCONST_ENAMETOOLONG
 208 eNETDOWN        = Errno CCONST_ENETDOWN
 209 eNETRESET       = Errno CCONST_ENETRESET
 210 eNETUNREACH     = Errno CCONST_ENETUNREACH
 211 eNFILE          = Errno CCONST_ENFILE
 212 eNOBUFS         = Errno CCONST_ENOBUFS
 213 eNODATA         = Errno CCONST_ENODATA
 214 eNODEV          = Errno CCONST_ENODEV
 215 eNOENT          = Errno CCONST_ENOENT
 216 eNOEXEC         = Errno CCONST_ENOEXEC
 217 eNOLCK          = Errno CCONST_ENOLCK
 218 eNOLINK         = Errno CCONST_ENOLINK
 219 eNOMEM          = Errno CCONST_ENOMEM
 220 eNOMSG          = Errno CCONST_ENOMSG
 221 eNONET          = Errno CCONST_ENONET
 222 eNOPROTOOPT     = Errno CCONST_ENOPROTOOPT
 223 eNOSPC          = Errno CCONST_ENOSPC
 224 eNOSR           = Errno CCONST_ENOSR
 225 eNOSTR          = Errno CCONST_ENOSTR
 226 eNOSYS          = Errno CCONST_ENOSYS
 227 eNOTBLK         = Errno CCONST_ENOTBLK
 228 eNOTCONN        = Errno CCONST_ENOTCONN
 229 eNOTDIR         = Errno CCONST_ENOTDIR
 230 eNOTEMPTY       = Errno CCONST_ENOTEMPTY
 231 eNOTSOCK        = Errno CCONST_ENOTSOCK
 232 eNOTTY          = Errno CCONST_ENOTTY
 233 eNXIO           = Errno CCONST_ENXIO
 234 eOPNOTSUPP      = Errno CCONST_EOPNOTSUPP
 235 ePERM           = Errno CCONST_EPERM
 236 ePFNOSUPPORT    = Errno CCONST_EPFNOSUPPORT
 237 ePIPE           = Errno CCONST_EPIPE
 238 ePROCLIM        = Errno CCONST_EPROCLIM
 239 ePROCUNAVAIL    = Errno CCONST_EPROCUNAVAIL
 240 ePROGMISMATCH   = Errno CCONST_EPROGMISMATCH
 241 ePROGUNAVAIL    = Errno CCONST_EPROGUNAVAIL
 242 ePROTO          = Errno CCONST_EPROTO
 243 ePROTONOSUPPORT = Errno CCONST_EPROTONOSUPPORT
 244 ePROTOTYPE      = Errno CCONST_EPROTOTYPE
 245 eRANGE          = Errno CCONST_ERANGE
 246 eREMCHG         = Errno CCONST_EREMCHG
 247 eREMOTE         = Errno CCONST_EREMOTE
 248 eROFS           = Errno CCONST_EROFS
 249 eRPCMISMATCH    = Errno CCONST_ERPCMISMATCH
 250 eRREMOTE        = Errno CCONST_ERREMOTE
 251 eSHUTDOWN       = Errno CCONST_ESHUTDOWN
 252 eSOCKTNOSUPPORT = Errno CCONST_ESOCKTNOSUPPORT
 253 eSPIPE          = Errno CCONST_ESPIPE
 254 eSRCH           = Errno CCONST_ESRCH
 255 eSRMNT          = Errno CCONST_ESRMNT
 256 eSTALE          = Errno CCONST_ESTALE
 257 eTIME           = Errno CCONST_ETIME
 258 eTIMEDOUT       = Errno CCONST_ETIMEDOUT
 259 eTOOMANYREFS    = Errno CCONST_ETOOMANYREFS
 260 eTXTBSY         = Errno CCONST_ETXTBSY
 261 eUSERS          = Errno CCONST_EUSERS
 262 eWOULDBLOCK     = Errno CCONST_EWOULDBLOCK
 263 eXDEV           = Errno CCONST_EXDEV
 264
 265 -- checks whether the given errno value is supported on the current
 266 -- architecture
 267 --
 268 isValidErrno               :: Errno -> Bool
 269 --
 270 -- the configure script sets all invalid "errno"s to 0
 271 --
 272 isValidErrno (Errno errno)  = errno /= 0
 273
 274
 275 -- access to the current thread's "errno" value
 276 -- --------------------------------------------
 277
 278 -- yield the current thread's "errno" value
 279 --
 280 getErrno :: IO Errno
 281 getErrno  = liftM Errno (peek _errno)
 282
 283
 284 -- throw current "errno" value
 285 -- ---------------------------
 286
 287 -- the common case: throw an IO error based on a textual description
 288 -- of the error location and the current thread's "errno" value
 289 --
 290 throwErrno     :: String -> IO a
 291 throwErrno loc  =
 292   do
 293     errno <- getErrno
 294     ioError (errnoToIOError loc errno Nothing Nothing)
 295
 296
 297 -- guards for IO operations that may fail
 298 -- --------------------------------------
 299
 300 -- guard an IO operation and throw an "errno" based exception of the result
 301 -- value of the IO operation meets the given predicate
 302 --
 303 throwErrnoIf            :: (a -> Bool) -> String -> IO a -> IO a
 304 throwErrnoIf pred loc f  =
 305   do
 306     res <- f
 307     if pred res then throwErrno loc else return res
 308
 309 -- as `throwErrnoIf', but discards the result
 310 --
 311 throwErrnoIf_            :: (a -> Bool) -> String -> IO a -> IO ()
 312 throwErrnoIf_ pred loc f  = void $ throwErrnoIf pred loc f
 313
 314 -- as `throwErrnoIf', but retries interrupted IO operations (ie, those whose
 315 -- flag `EINTR')
 316 --
 317 throwErrnoIfRetry            :: (a -> Bool) -> String -> IO a -> IO a
 318 throwErrnoIfRetry pred loc f  =
 319   do
 320     res <- f
 321     if pred res
 322       then do
 323         err <- getErrno
 324         if err == eINTR
 325           then throwErrnoIfRetry pred loc f
 326           else throwErrno loc
 327       else return res
 328
 329 -- as `throwErrnoIfRetry', but discards the result
 330 --
 331 throwErrnoIfRetry_            :: (a -> Bool) -> String -> IO a -> IO ()
 332 throwErrnoIfRetry_ pred loc f  = void $ throwErrnoIfRetry pred loc f
 333
 334 -- throws "errno" if a result of "-1" is returned
 335 --
 336 throwErrnoIfMinus1 :: Num a => String -> IO a -> IO a
 337 throwErrnoIfMinus1  = throwErrnoIf (== -1)
 338
 339 -- as `throwErrnoIfMinus1', but discards the result
 340 --
 341 throwErrnoIfMinus1_ :: Num a => String -> IO a -> IO ()
 342 throwErrnoIfMinus1_  = throwErrnoIf_ (== -1)
 343
 344 -- throws "errno" if a result of "-1" is returned, but retries in case of an
 345 -- interrupted operation
 346 --
 347 throwErrnoIfMinus1Retry :: Num a => String -> IO a -> IO a
 348 throwErrnoIfMinus1Retry  = throwErrnoIfRetry (== -1)
 349
 350 -- as `throwErrnoIfMinus1', but discards the result
 351 --
 352 throwErrnoIfMinus1Retry_ :: Num a => String -> IO a -> IO ()
 353 throwErrnoIfMinus1Retry_  = throwErrnoIfRetry_ (== -1)
 354
 355 -- throws "errno" if a result of a NULL pointer is returned
 356 --
 357 throwErrnoIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
 358 throwErrnoIfNull  = throwErrnoIf (== nullPtr)
 359
 360 -- throws "errno" if a result of a NULL pointer is returned, but retries in
 361 -- case of an interrupted operation
 362 --
 363 throwErrnoIfNullRetry :: String -> IO (Ptr a) -> IO (Ptr a)
 364 throwErrnoIfNullRetry  = throwErrnoIfRetry (== nullPtr)
 365
 366
 367 -- conversion of an "errno" value into IO error
 368 -- --------------------------------------------
 369
 370 -- convert a location string, an "errno" value, an optional handle,
 371 -- and an optional filename into a matching IO error
 372 --
 373 errnoToIOError :: String -> Errno -> Maybe Handle -> Maybe String -> IOError
 374 errnoToIOError loc errno@(Errno no) maybeHdl maybeName =
 375 #if __GLASGOW_HASKELL__
 376   IOException (IOError maybeHdl errType loc str maybeName)
 377 #else
 378   userError (loc ++ ": " ++ str ++ maybe "" (": "++) maybeName)
 379 #endif
 380   where
 381     (errType, str)
 382       | no == 0                   = (OtherError,
 383                                      "no error")
 384       | errno == e2BIG            = (ResourceExhausted,
 385                                      "argument list too long")
 386       | errno == eACCES           = (PermissionDenied,
 387                                      "inadequate access permission")
 388       | errno == eADDRINUSE       = (ResourceBusy,
 389                                      "address already in use")
 390       | errno == eADDRNOTAVAIL    = (UnsupportedOperation,
 391                                      "address not available")
 392       | errno == eADV             = (OtherError,
 393                                      "RFS advertise error")
 394       | errno == eAFNOSUPPORT     = (UnsupportedOperation,
 395                                      "address family not supported by " ++
 396                                      "protocol family")
 397                                      -- no multiline strings with cpp
 398       | errno == eAGAIN           = (ResourceExhausted,
 399                                      "insufficient resources")
 400       | errno == eALREADY         = (AlreadyExists,
 401                                      "operation already in progress")
 402       | errno == eBADF            = (OtherError,
 403                                      "internal error (EBADF)")
 404       | errno == eBADMSG          = (InappropriateType,
 405                                      "next message has wrong type")
 406       | errno == eBADRPC          = (OtherError,
 407                                      "invalid RPC request or response")
 408       | errno == eBUSY            = (ResourceBusy,
 409                                      "device busy")
 410       | errno == eCHILD           = (NoSuchThing,
 411                                      "no child processes")
 412       | errno == eCOMM            = (ResourceVanished,
 413                                      "no virtual circuit could be found")
 414       | errno == eCONNABORTED     = (OtherError,
 415                                      "aborted connection")
 416       | errno == eCONNREFUSED     = (NoSuchThing,
 417                                      "no listener on remote host")
 418       | errno == eCONNRESET       = (ResourceVanished,
 419                                      "connection reset by peer")
 420       | errno == eDEADLK          = (ResourceBusy,
 421                                      "resource deadlock avoided")
 422       | errno == eDESTADDRREQ     = (InvalidArgument,
 423                                      "destination address required")
 424       | errno == eDIRTY           = (UnsatisfiedConstraints,
 425                                      "file system dirty")
 426       | errno == eDOM             = (InvalidArgument,
 427                                      "argument too large")
 428       | errno == eDQUOT           = (PermissionDenied,
 429                                      "quota exceeded")
 430       | errno == eEXIST           = (AlreadyExists,
 431                                      "file already exists")
 432       | errno == eFAULT           = (OtherError,
 433                                      "internal error (EFAULT)")
 434       | errno == eFBIG            = (PermissionDenied,
 435                                      "file too large")
 436       | errno == eFTYPE           = (InappropriateType,
 437                                      "inappropriate NFS file type or format")
 438       | errno == eHOSTDOWN        = (NoSuchThing,
 439                                      "destination host down")
 440       | errno == eHOSTUNREACH     = (NoSuchThing,
 441                                      "remote host is unreachable")
 442       | errno == eIDRM            = (ResourceVanished,
 443                                      "IPC identifier removed")
 444       | errno == eILSEQ           = (InvalidArgument,
 445                                      "invalid wide character")
 446       | errno == eINPROGRESS      = (AlreadyExists,
 447                                      "operation now in progress")
 448       | errno == eINTR            = (Interrupted,
 449                                      "interrupted system call")
 450       | errno == eINVAL           = (InvalidArgument,
 451                                      "invalid argument")
 452       | errno == eIO              = (HardwareFault,
 453                                      "unknown I/O fault")
 454       | errno == eISCONN          = (AlreadyExists,
 455                                      "socket is already connected")
 456       | errno == eISDIR           = (InappropriateType,
 457                                      "file is a directory")
 458       | errno == eLOOP            = (InvalidArgument,
 459                                      "too many symbolic links")
 460       | errno == eMFILE           = (ResourceExhausted,
 461                                      "process file table full")
 462       | errno == eMLINK           = (ResourceExhausted,
 463                                      "too many links")
 464       | errno == eMSGSIZE         = (ResourceExhausted,
 465                                      "message too long")
 466       | errno == eMULTIHOP        = (UnsupportedOperation,
 467                                      "multi-hop RFS request")
 468       | errno == eNAMETOOLONG     = (InvalidArgument,
 469                                      "filename too long")
 470       | errno == eNETDOWN         = (ResourceVanished,
 471                                      "network is down")
 472       | errno == eNETRESET        = (ResourceVanished,
 473                                      "remote host rebooted; connection lost")
 474       | errno == eNETUNREACH      = (NoSuchThing,
 475                                      "remote network is unreachable")
 476       | errno == eNFILE           = (ResourceExhausted,
 477                                      "system file table full")
 478       | errno == eNOBUFS          = (ResourceExhausted,
 479                                      "no buffer space available")
 480       | errno == eNODATA          = (NoSuchThing,
 481                                      "no message on the stream head read " ++
 482                                      "queue")
 483                                      -- no multiline strings with cpp
 484       | errno == eNODEV           = (NoSuchThing,
 485                                      "no such device")
 486       | errno == eNOENT           = (NoSuchThing,
 487                                      "no such file or directory")
 488       | errno == eNOEXEC          = (InvalidArgument,
 489                                      "not an executable file")
 490       | errno == eNOLCK           = (ResourceExhausted,
 491                                      "no file locks available")
 492       | errno == eNOLINK          = (ResourceVanished,
 493                                      "RFS link has been severed")
 494       | errno == eNOMEM           = (ResourceExhausted,
 495                                      "not enough virtual memory")
 496       | errno == eNOMSG           = (NoSuchThing,
 497                                      "no message of desired type")
 498       | errno == eNONET           = (NoSuchThing,
 499                                      "host is not on a network")
 500       | errno == eNOPROTOOPT      = (UnsupportedOperation,
 501                                      "operation not supported by protocol")
 502       | errno == eNOSPC           = (ResourceExhausted,
 503                                      "no space left on device")
 504       | errno == eNOSR            = (ResourceExhausted,
 505                                      "out of stream resources")
 506       | errno == eNOSTR           = (InvalidArgument,
 507                                      "not a stream device")
 508       | errno == eNOSYS           = (UnsupportedOperation,
 509                                      "function not implemented")
 510       | errno == eNOTBLK          = (InvalidArgument,
 511                                      "not a block device")
 512       | errno == eNOTCONN         = (InvalidArgument,
 513                                      "socket is not connected")
 514       | errno == eNOTDIR          = (InappropriateType,
 515                                      "not a directory")
 516       | errno == eNOTEMPTY        = (UnsatisfiedConstraints,
 517                                      "directory not empty")
 518       | errno == eNOTSOCK         = (InvalidArgument,
 519                                      "not a socket")
 520       | errno == eNOTTY           = (IllegalOperation,
 521                                      "inappropriate ioctl for device")
 522       | errno == eNXIO            = (NoSuchThing,
 523                                      "no such device or address")
 524       | errno == eOPNOTSUPP       = (UnsupportedOperation,
 525                                      "operation not supported on socket")
 526       | errno == ePERM            = (PermissionDenied,
 527                                      "privileged operation")
 528       | errno == ePFNOSUPPORT     = (UnsupportedOperation,
 529                                      "protocol family not supported")
 530       | errno == ePIPE            = (ResourceVanished,
 531                                      "broken pipe")
 532       | errno == ePROCLIM         = (PermissionDenied,
 533                                      "too many processes")
 534       | errno == ePROCUNAVAIL     = (UnsupportedOperation,
 535                                      "unimplemented RPC procedure")
 536       | errno == ePROGMISMATCH    = (ProtocolError,
 537                                      "unsupported RPC program version")
 538       | errno == ePROGUNAVAIL     = (UnsupportedOperation,
 539                                      "RPC program unavailable")
 540       | errno == ePROTO           = (ProtocolError,
 541                                      "error in streams protocol")
 542       | errno == ePROTONOSUPPORT  = (ProtocolError,
 543                                      "protocol not supported")
 544       | errno == ePROTOTYPE       = (ProtocolError,
 545                                      "wrong protocol for socket")
 546       | errno == eRANGE           = (UnsupportedOperation,
 547                                      "result too large")
 548       | errno == eREMCHG          = (ResourceVanished,
 549                                      "remote address changed")
 550       | errno == eREMOTE          = (IllegalOperation,
 551                                      "too many levels of remote in path")
 552       | errno == eROFS            = (PermissionDenied,
 553                                      "read-only file system")
 554       | errno == eRPCMISMATCH     = (ProtocolError,
 555                                      "RPC version is wrong")
 556       | errno == eRREMOTE         = (IllegalOperation,
 557                                      "object is remote")
 558       | errno == eSHUTDOWN        = (IllegalOperation,
 559                                      "can't send after socket shutdown")
 560       | errno == eSOCKTNOSUPPORT  = (UnsupportedOperation,
 561                                      "socket type not supported")
 562       | errno == eSPIPE           = (UnsupportedOperation,
 563                                      "can't seek on a pipe")
 564       | errno == eSRCH            = (NoSuchThing,
 565                                      "no such process")
 566       | errno == eSRMNT           = (UnsatisfiedConstraints,
 567                                      "RFS resources still mounted by " ++
 568                                      "remote host(s)")
 569                                      -- no multiline strings with cpp
 570       | errno == eSTALE           = (ResourceVanished,
 571                                      "stale NFS file handle")
 572       | errno == eTIME            = (TimeExpired,
 573                                      "timer expired")
 574       | errno == eTIMEDOUT        = (TimeExpired,
 575                                      "connection timed out")
 576       | errno == eTOOMANYREFS     = (ResourceExhausted,
 577                                      "too many references; can't splice")
 578       | errno == eTXTBSY          = (ResourceBusy,
 579                                      "text file in-use")
 580       | errno == eUSERS           = (ResourceExhausted,
 581                                      "quota table full")
 582       | errno == eWOULDBLOCK      = (OtherError,
 583                                      "operation would block")
 584       | errno == eXDEV            = (UnsupportedOperation,
 585                                      "can't make a cross-device link")
 586       | otherwise                 = (OtherError,
 587                                      "unexpected error (error code: "
 588                                      ++ show no ++")")
 589
 590 foreign label "errno" _errno :: Ptr CInt
 591   -- FIXME: this routine should eventually be provided by the Haskell runtime
 592   --        and guarantee that the "errno" of the last operation performed by
 593   --        the current thread is returned
 594 \end{code}