Foreign/C/Error.hs

   1 {-# OPTIONS_GHC -fno-implicit-prelude -#include "HsBase.h" #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  Foreign.C.Error
   5 -- Copyright   :  (c) The FFI task force 2001
   6 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   7 --
   8 -- Maintainer  :  ffi@haskell.org
   9 -- Stability   :  provisional
  10 -- Portability :  portable
  11 --
  12 -- C-specific Marshalling support: Handling of C \"errno\" error codes.
  13 --
  14 -----------------------------------------------------------------------------
  15
  16 module Foreign.C.Error (
  17
  18   -- * Haskell representations of @errno@ values
  19
  20   Errno(..),            -- instance: Eq
  21
  22   -- ** Common @errno@ symbols
  23   -- | Different operating systems and\/or C libraries often support
  24   -- different values of @errno@.  This module defines the common values,
  25   -- but due to the open definition of 'Errno' users may add definitions
  26   -- which are not predefined.
  27   eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,
  28   eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED,
  29   eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT,
  30   eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ,
  31   eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK,
  32   eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH,
  33   eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK,
  34   eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS,
  35   eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTTY, eNXIO,
  36   eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL,
  37   ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE,
  38   eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN,
  39   eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT,
  40   eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV,
  41
  42   -- ** 'Errno' functions
  43                         -- :: Errno
  44   isValidErrno,         -- :: Errno -> Bool
  45
  46   -- access to the current thread's "errno" value
  47   --
  48   getErrno,             -- :: IO Errno
  49   resetErrno,           -- :: IO ()
  50
  51   -- conversion of an "errno" value into IO error
  52   --
  53   errnoToIOError,       -- :: String       -- location
  54                         -- -> Errno        -- errno
  55                         -- -> Maybe Handle -- handle
  56                         -- -> Maybe String -- filename
  57                         -- -> IOError
  58
  59   -- throw current "errno" value
  60   --
  61   throwErrno,           -- ::                String               -> IO a
  62
  63   -- ** Guards for IO operations that may fail
  64
  65   throwErrnoIf,         -- :: (a -> Bool) -> String -> IO a       -> IO a
  66   throwErrnoIf_,        -- :: (a -> Bool) -> String -> IO a       -> IO ()
  67   throwErrnoIfRetry,    -- :: (a -> Bool) -> String -> IO a       -> IO a
  68   throwErrnoIfRetry_,   -- :: (a -> Bool) -> String -> IO a       -> IO ()
  69   throwErrnoIfMinus1,   -- :: Num a
  70                         -- =>                String -> IO a       -> IO a
  71   throwErrnoIfMinus1_,  -- :: Num a
  72                         -- =>                String -> IO a       -> IO ()
  73   throwErrnoIfMinus1Retry,
  74                         -- :: Num a
  75                         -- =>                String -> IO a       -> IO a
  76   throwErrnoIfMinus1Retry_,
  77                         -- :: Num a
  78                         -- =>                String -> IO a       -> IO ()
  79   throwErrnoIfNull,     -- ::                String -> IO (Ptr a) -> IO (Ptr a)
  80   throwErrnoIfNullRetry,-- ::                String -> IO (Ptr a) -> IO (Ptr a)
  81
  82   throwErrnoIfRetryMayBlock,
  83   throwErrnoIfRetryMayBlock_,
  84   throwErrnoIfMinus1RetryMayBlock,
  85   throwErrnoIfMinus1RetryMayBlock_,
  86   throwErrnoIfNullRetryMayBlock
  87 ) where
  88
  89
  90 -- this is were we get the CONST_XXX definitions from that configure
  91 -- calculated for us
  92 --
  93 #ifndef __NHC__
  94 #include "HsBaseConfig.h"
  95 #endif
  96
  97 -- system dependent imports
  98 -- ------------------------
  99
 100 -- GHC allows us to get at the guts inside IO errors/exceptions
 101 --
 102 #if __GLASGOW_HASKELL__
 103 import GHC.IOBase (IOException(..), IOErrorType(..))
 104 #endif /* __GLASGOW_HASKELL__ */
 105
 106
 107 -- regular imports
 108 -- ---------------
 109
 110 import Foreign.Storable
 111 import Foreign.Ptr
 112 import Foreign.C.Types
 113 import Foreign.C.String
 114 import Foreign.Marshal.Error    ( void )
 115 import Data.Maybe
 116
 117 #if __GLASGOW_HASKELL__
 118 import GHC.IOBase
 119 import GHC.Num
 120 import GHC.Base
 121 #elif __HUGS__
 122 import Hugs.Prelude             ( Handle, IOError, ioError )
 123 import System.IO.Unsafe         ( unsafePerformIO )
 124 #else
 125 import System.IO                ( Handle )
 126 import System.IO.Error          ( IOError, ioError )
 127 import System.IO.Unsafe         ( unsafePerformIO )
 128 #endif
 129
 130 #ifdef __HUGS__
 131 {-# CFILES cbits/PrelIOUtils.c #-}
 132 #endif
 133
 134
 135 -- "errno" type
 136 -- ------------
 137
 138 -- | Haskell representation for @errno@ values.
 139 -- The implementation is deliberately exposed, to allow users to add
 140 -- their own definitions of 'Errno' values.
 141
 142 newtype Errno = Errno CInt
 143
 144 instance Eq Errno where
 145   errno1@(Errno no1) == errno2@(Errno no2)
 146     | isValidErrno errno1 && isValidErrno errno2 = no1 == no2
 147     | otherwise                                  = False
 148
 149 -- common "errno" symbols
 150 --
 151 eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,
 152   eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED,
 153   eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT,
 154   eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ,
 155   eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK,
 156   eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH,
 157   eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK,
 158   eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS,
 159   eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTTY, eNXIO,
 160   eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL,
 161   ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE,
 162   eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN,
 163   eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT,
 164   eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV                    :: Errno
 165 --
 166 -- the cCONST_XXX identifiers are cpp symbols whose value is computed by
 167 -- configure
 168 --
 169 eOK             = Errno 0
 170 #ifdef __NHC__
 171 #include "Errno.hs"
 172 #else
 173 e2BIG           = Errno (CONST_E2BIG)
 174 eACCES          = Errno (CONST_EACCES)
 175 eADDRINUSE      = Errno (CONST_EADDRINUSE)
 176 eADDRNOTAVAIL   = Errno (CONST_EADDRNOTAVAIL)
 177 eADV            = Errno (CONST_EADV)
 178 eAFNOSUPPORT    = Errno (CONST_EAFNOSUPPORT)
 179 eAGAIN          = Errno (CONST_EAGAIN)
 180 eALREADY        = Errno (CONST_EALREADY)
 181 eBADF           = Errno (CONST_EBADF)
 182 eBADMSG         = Errno (CONST_EBADMSG)
 183 eBADRPC         = Errno (CONST_EBADRPC)
 184 eBUSY           = Errno (CONST_EBUSY)
 185 eCHILD          = Errno (CONST_ECHILD)
 186 eCOMM           = Errno (CONST_ECOMM)
 187 eCONNABORTED    = Errno (CONST_ECONNABORTED)
 188 eCONNREFUSED    = Errno (CONST_ECONNREFUSED)
 189 eCONNRESET      = Errno (CONST_ECONNRESET)
 190 eDEADLK         = Errno (CONST_EDEADLK)
 191 eDESTADDRREQ    = Errno (CONST_EDESTADDRREQ)
 192 eDIRTY          = Errno (CONST_EDIRTY)
 193 eDOM            = Errno (CONST_EDOM)
 194 eDQUOT          = Errno (CONST_EDQUOT)
 195 eEXIST          = Errno (CONST_EEXIST)
 196 eFAULT          = Errno (CONST_EFAULT)
 197 eFBIG           = Errno (CONST_EFBIG)
 198 eFTYPE          = Errno (CONST_EFTYPE)
 199 eHOSTDOWN       = Errno (CONST_EHOSTDOWN)
 200 eHOSTUNREACH    = Errno (CONST_EHOSTUNREACH)
 201 eIDRM           = Errno (CONST_EIDRM)
 202 eILSEQ          = Errno (CONST_EILSEQ)
 203 eINPROGRESS     = Errno (CONST_EINPROGRESS)
 204 eINTR           = Errno (CONST_EINTR)
 205 eINVAL          = Errno (CONST_EINVAL)
 206 eIO             = Errno (CONST_EIO)
 207 eISCONN         = Errno (CONST_EISCONN)
 208 eISDIR          = Errno (CONST_EISDIR)
 209 eLOOP           = Errno (CONST_ELOOP)
 210 eMFILE          = Errno (CONST_EMFILE)
 211 eMLINK          = Errno (CONST_EMLINK)
 212 eMSGSIZE        = Errno (CONST_EMSGSIZE)
 213 eMULTIHOP       = Errno (CONST_EMULTIHOP)
 214 eNAMETOOLONG    = Errno (CONST_ENAMETOOLONG)
 215 eNETDOWN        = Errno (CONST_ENETDOWN)
 216 eNETRESET       = Errno (CONST_ENETRESET)
 217 eNETUNREACH     = Errno (CONST_ENETUNREACH)
 218 eNFILE          = Errno (CONST_ENFILE)
 219 eNOBUFS         = Errno (CONST_ENOBUFS)
 220 eNODATA         = Errno (CONST_ENODATA)
 221 eNODEV          = Errno (CONST_ENODEV)
 222 eNOENT          = Errno (CONST_ENOENT)
 223 eNOEXEC         = Errno (CONST_ENOEXEC)
 224 eNOLCK          = Errno (CONST_ENOLCK)
 225 eNOLINK         = Errno (CONST_ENOLINK)
 226 eNOMEM          = Errno (CONST_ENOMEM)
 227 eNOMSG          = Errno (CONST_ENOMSG)
 228 eNONET          = Errno (CONST_ENONET)
 229 eNOPROTOOPT     = Errno (CONST_ENOPROTOOPT)
 230 eNOSPC          = Errno (CONST_ENOSPC)
 231 eNOSR           = Errno (CONST_ENOSR)
 232 eNOSTR          = Errno (CONST_ENOSTR)
 233 eNOSYS          = Errno (CONST_ENOSYS)
 234 eNOTBLK         = Errno (CONST_ENOTBLK)
 235 eNOTCONN        = Errno (CONST_ENOTCONN)
 236 eNOTDIR         = Errno (CONST_ENOTDIR)
 237 eNOTEMPTY       = Errno (CONST_ENOTEMPTY)
 238 eNOTSOCK        = Errno (CONST_ENOTSOCK)
 239 eNOTTY          = Errno (CONST_ENOTTY)
 240 eNXIO           = Errno (CONST_ENXIO)
 241 eOPNOTSUPP      = Errno (CONST_EOPNOTSUPP)
 242 ePERM           = Errno (CONST_EPERM)
 243 ePFNOSUPPORT    = Errno (CONST_EPFNOSUPPORT)
 244 ePIPE           = Errno (CONST_EPIPE)
 245 ePROCLIM        = Errno (CONST_EPROCLIM)
 246 ePROCUNAVAIL    = Errno (CONST_EPROCUNAVAIL)
 247 ePROGMISMATCH   = Errno (CONST_EPROGMISMATCH)
 248 ePROGUNAVAIL    = Errno (CONST_EPROGUNAVAIL)
 249 ePROTO          = Errno (CONST_EPROTO)
 250 ePROTONOSUPPORT = Errno (CONST_EPROTONOSUPPORT)
 251 ePROTOTYPE      = Errno (CONST_EPROTOTYPE)
 252 eRANGE          = Errno (CONST_ERANGE)
 253 eREMCHG         = Errno (CONST_EREMCHG)
 254 eREMOTE         = Errno (CONST_EREMOTE)
 255 eROFS           = Errno (CONST_EROFS)
 256 eRPCMISMATCH    = Errno (CONST_ERPCMISMATCH)
 257 eRREMOTE        = Errno (CONST_ERREMOTE)
 258 eSHUTDOWN       = Errno (CONST_ESHUTDOWN)
 259 eSOCKTNOSUPPORT = Errno (CONST_ESOCKTNOSUPPORT)
 260 eSPIPE          = Errno (CONST_ESPIPE)
 261 eSRCH           = Errno (CONST_ESRCH)
 262 eSRMNT          = Errno (CONST_ESRMNT)
 263 eSTALE          = Errno (CONST_ESTALE)
 264 eTIME           = Errno (CONST_ETIME)
 265 eTIMEDOUT       = Errno (CONST_ETIMEDOUT)
 266 eTOOMANYREFS    = Errno (CONST_ETOOMANYREFS)
 267 eTXTBSY         = Errno (CONST_ETXTBSY)
 268 eUSERS          = Errno (CONST_EUSERS)
 269 eWOULDBLOCK     = Errno (CONST_EWOULDBLOCK)
 270 eXDEV           = Errno (CONST_EXDEV)
 271 #endif
 272
 273 -- | Yield 'True' if the given 'Errno' value is valid on the system.
 274 -- This implies that the 'Eq' instance of 'Errno' is also system dependent
 275 -- as it is only defined for valid values of 'Errno'.
 276 --
 277 isValidErrno               :: Errno -> Bool
 278 --
 279 -- the configure script sets all invalid "errno"s to -1
 280 --
 281 isValidErrno (Errno errno)  = errno /= -1
 282
 283
 284 -- access to the current thread's "errno" value
 285 -- --------------------------------------------
 286
 287 -- | Get the current value of @errno@ in the current thread.
 288 --
 289 getErrno :: IO Errno
 290
 291 -- We must call a C function to get the value of errno in general.  On
 292 -- threaded systems, errno is hidden behind a C macro so that each OS
 293 -- thread gets its own copy.
 294 #ifdef __NHC__
 295 getErrno = do e <- peek _errno; return (Errno e)
 296 foreign import ccall unsafe "errno.h &errno" _errno :: Ptr CInt
 297 #else
 298 getErrno = do e <- get_errno; return (Errno e)
 299 foreign import ccall unsafe "HsBase.h __hscore_get_errno" get_errno :: IO CInt
 300 #endif
 301
 302 -- | Reset the current thread\'s @errno@ value to 'eOK'.
 303 --
 304 resetErrno :: IO ()
 305
 306 -- Again, setting errno has to be done via a C function.
 307 #ifdef __NHC__
 308 resetErrno = poke _errno 0
 309 #else
 310 resetErrno = set_errno 0
 311 foreign import ccall unsafe "HsBase.h __hscore_set_errno" set_errno :: CInt -> IO ()
 312 #endif
 313
 314 -- throw current "errno" value
 315 -- ---------------------------
 316
 317 -- | Throw an 'IOError' corresponding to the current value of 'getErrno'.
 318 --
 319 throwErrno     :: String        -- ^ textual description of the error location
 320                -> IO a
 321 throwErrno loc  =
 322   do
 323     errno <- getErrno
 324     ioError (errnoToIOError loc errno Nothing Nothing)
 325
 326
 327 -- guards for IO operations that may fail
 328 -- --------------------------------------
 329
 330 -- | Throw an 'IOError' corresponding to the current value of 'getErrno'
 331 -- if the result value of the 'IO' action meets the given predicate.
 332 --
 333 throwErrnoIf    :: (a -> Bool)  -- ^ predicate to apply to the result value
 334                                 -- of the 'IO' operation
 335                 -> String       -- ^ textual description of the location
 336                 -> IO a         -- ^ the 'IO' operation to be executed
 337                 -> IO a
 338 throwErrnoIf pred loc f  =
 339   do
 340     res <- f
 341     if pred res then throwErrno loc else return res
 342
 343 -- | as 'throwErrnoIf', but discards the result of the 'IO' action after
 344 -- error handling.
 345 --
 346 throwErrnoIf_   :: (a -> Bool) -> String -> IO a -> IO ()
 347 throwErrnoIf_ pred loc f  = void $ throwErrnoIf pred loc f
 348
 349 -- | as 'throwErrnoIf', but retry the 'IO' action when it yields the
 350 -- error code 'eINTR' - this amounts to the standard retry loop for
 351 -- interrupted POSIX system calls.
 352 --
 353 throwErrnoIfRetry            :: (a -> Bool) -> String -> IO a -> IO a
 354 throwErrnoIfRetry pred loc f  =
 355   do
 356     res <- f
 357     if pred res
 358       then do
 359         err <- getErrno
 360         if err == eINTR
 361           then throwErrnoIfRetry pred loc f
 362           else throwErrno loc
 363       else return res
 364
 365 -- | as 'throwErrnoIfRetry', but checks for operations that would block and
 366 -- executes an alternative action before retrying in that case.
 367 --
 368 throwErrnoIfRetryMayBlock
 369                 :: (a -> Bool)  -- ^ predicate to apply to the result value
 370                                 -- of the 'IO' operation
 371                 -> String       -- ^ textual description of the location
 372                 -> IO a         -- ^ the 'IO' operation to be executed
 373                 -> IO b         -- ^ action to execute before retrying if
 374                                 -- an immediate retry would block
 375                 -> IO a
 376 throwErrnoIfRetryMayBlock pred loc f on_block  =
 377   do
 378     res <- f
 379     if pred res
 380       then do
 381         err <- getErrno
 382         if err == eINTR
 383           then throwErrnoIfRetryMayBlock pred loc f on_block
 384           else if err == eWOULDBLOCK || err == eAGAIN
 385                  then do on_block; throwErrnoIfRetryMayBlock pred loc f on_block
 386                  else throwErrno loc
 387       else return res
 388
 389 -- | as 'throwErrnoIfRetry', but discards the result.
 390 --
 391 throwErrnoIfRetry_            :: (a -> Bool) -> String -> IO a -> IO ()
 392 throwErrnoIfRetry_ pred loc f  = void $ throwErrnoIfRetry pred loc f
 393
 394 -- | as 'throwErrnoIfRetryMayBlock', but discards the result.
 395 --
 396 throwErrnoIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO ()
 397 throwErrnoIfRetryMayBlock_ pred loc f on_block
 398   = void $ throwErrnoIfRetryMayBlock pred loc f on_block
 399
 400 -- | Throw an 'IOError' corresponding to the current value of 'getErrno'
 401 -- if the 'IO' action returns a result of @-1@.
 402 --
 403 throwErrnoIfMinus1 :: Num a => String -> IO a -> IO a
 404 throwErrnoIfMinus1  = throwErrnoIf (== -1)
 405
 406 -- | as 'throwErrnoIfMinus1', but discards the result.
 407 --
 408 throwErrnoIfMinus1_ :: Num a => String -> IO a -> IO ()
 409 throwErrnoIfMinus1_  = throwErrnoIf_ (== -1)
 410
 411 -- | Throw an 'IOError' corresponding to the current value of 'getErrno'
 412 -- if the 'IO' action returns a result of @-1@, but retries in case of
 413 -- an interrupted operation.
 414 --
 415 throwErrnoIfMinus1Retry :: Num a => String -> IO a -> IO a
 416 throwErrnoIfMinus1Retry  = throwErrnoIfRetry (== -1)
 417
 418 -- | as 'throwErrnoIfMinus1', but discards the result.
 419 --
 420 throwErrnoIfMinus1Retry_ :: Num a => String -> IO a -> IO ()
 421 throwErrnoIfMinus1Retry_  = throwErrnoIfRetry_ (== -1)
 422
 423 -- | as 'throwErrnoIfMinus1Retry', but checks for operations that would block.
 424 --
 425 throwErrnoIfMinus1RetryMayBlock :: Num a => String -> IO a -> IO b -> IO a
 426 throwErrnoIfMinus1RetryMayBlock  = throwErrnoIfRetryMayBlock (== -1)
 427
 428 -- | as 'throwErrnoIfMinus1RetryMayBlock', but discards the result.
 429 --
 430 throwErrnoIfMinus1RetryMayBlock_ :: Num a => String -> IO a -> IO b -> IO ()
 431 throwErrnoIfMinus1RetryMayBlock_  = throwErrnoIfRetryMayBlock_ (== -1)
 432
 433 -- | Throw an 'IOError' corresponding to the current value of 'getErrno'
 434 -- if the 'IO' action returns 'nullPtr'.
 435 --
 436 throwErrnoIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
 437 throwErrnoIfNull  = throwErrnoIf (== nullPtr)
 438
 439 -- | Throw an 'IOError' corresponding to the current value of 'getErrno'
 440 -- if the 'IO' action returns 'nullPtr',
 441 -- but retry in case of an interrupted operation.
 442 --
 443 throwErrnoIfNullRetry :: String -> IO (Ptr a) -> IO (Ptr a)
 444 throwErrnoIfNullRetry  = throwErrnoIfRetry (== nullPtr)
 445
 446 -- | as 'throwErrnoIfNullRetry', but checks for operations that would block.
 447 --
 448 throwErrnoIfNullRetryMayBlock :: String -> IO (Ptr a) -> IO b -> IO (Ptr a)
 449 throwErrnoIfNullRetryMayBlock  = throwErrnoIfRetryMayBlock (== nullPtr)
 450
 451 throwErrnoPath :: String -> FilePath -> IO a
 452 throwErrnoPath loc path =
 453   do
 454     errno <- getErrno
 455     ioError (errnoToIOError loc errno Nothing (Just path))
 456
 457 throwErrnoPathIf :: (a -> Bool) -> String -> FilePath -> IO a -> IO a
 458 throwErrnoPathIf pred loc path f =
 459   do
 460     res <- f
 461     if pred res then throwErrnoPath loc path else return res
 462
 463 throwErrnoPathIf_ :: (a -> Bool) -> String -> FilePath -> IO a -> IO ()
 464 throwErrnoPathIf_ pred loc path f  = void $ throwErrnoPathIf pred loc path f
 465
 466 throwErrnoPathIfNull :: String -> FilePath -> IO (Ptr a) -> IO (Ptr a)
 467 throwErrnoPathIfNull  = throwErrnoPathIf (== nullPtr)
 468
 469 throwErrnoPathIfMinus1 :: Num a => String -> FilePath -> IO a -> IO a
 470 throwErrnoPathIfMinus1 = throwErrnoPathIf (== -1)
 471
 472 throwErrnoPathIfMinus1_ :: Num a => String -> FilePath -> IO a -> IO ()
 473 throwErrnoPathIfMinus1_  = throwErrnoPathIf_ (== -1)
 474
 475 -- conversion of an "errno" value into IO error
 476 -- --------------------------------------------
 477
 478 -- | Construct a Haskell 98 I\/O error based on the given 'Errno' value.
 479 -- The optional information can be used to improve the accuracy of
 480 -- error messages.
 481 --
 482 errnoToIOError  :: String       -- ^ the location where the error occurred
 483                 -> Errno        -- ^ the error number
 484                 -> Maybe Handle -- ^ optional handle associated with the error
 485                 -> Maybe String -- ^ optional filename associated with the error
 486                 -> IOError
 487 errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
 488     str <- strerror errno >>= peekCString
 489 #if __GLASGOW_HASKELL__
 490     return (IOError maybeHdl errType loc str maybeName)
 491     where
 492     errType
 493         | errno == eOK             = OtherError
 494         | errno == e2BIG           = ResourceExhausted
 495         | errno == eACCES          = PermissionDenied
 496         | errno == eADDRINUSE      = ResourceBusy
 497         | errno == eADDRNOTAVAIL   = UnsupportedOperation
 498         | errno == eADV            = OtherError
 499         | errno == eAFNOSUPPORT    = UnsupportedOperation
 500         | errno == eAGAIN          = ResourceExhausted
 501         | errno == eALREADY        = AlreadyExists
 502         | errno == eBADF           = InvalidArgument
 503         | errno == eBADMSG         = InappropriateType
 504         | errno == eBADRPC         = OtherError
 505         | errno == eBUSY           = ResourceBusy
 506         | errno == eCHILD          = NoSuchThing
 507         | errno == eCOMM           = ResourceVanished
 508         | errno == eCONNABORTED    = OtherError
 509         | errno == eCONNREFUSED    = NoSuchThing
 510         | errno == eCONNRESET      = ResourceVanished
 511         | errno == eDEADLK         = ResourceBusy
 512         | errno == eDESTADDRREQ    = InvalidArgument
 513         | errno == eDIRTY          = UnsatisfiedConstraints
 514         | errno == eDOM            = InvalidArgument
 515         | errno == eDQUOT          = PermissionDenied
 516         | errno == eEXIST          = AlreadyExists
 517         | errno == eFAULT          = OtherError
 518         | errno == eFBIG           = PermissionDenied
 519         | errno == eFTYPE          = InappropriateType
 520         | errno == eHOSTDOWN       = NoSuchThing
 521         | errno == eHOSTUNREACH    = NoSuchThing
 522         | errno == eIDRM           = ResourceVanished
 523         | errno == eILSEQ          = InvalidArgument
 524         | errno == eINPROGRESS     = AlreadyExists
 525         | errno == eINTR           = Interrupted
 526         | errno == eINVAL          = InvalidArgument
 527         | errno == eIO             = HardwareFault
 528         | errno == eISCONN         = AlreadyExists
 529         | errno == eISDIR          = InappropriateType
 530         | errno == eLOOP           = InvalidArgument
 531         | errno == eMFILE          = ResourceExhausted
 532         | errno == eMLINK          = ResourceExhausted
 533         | errno == eMSGSIZE        = ResourceExhausted
 534         | errno == eMULTIHOP       = UnsupportedOperation
 535         | errno == eNAMETOOLONG    = InvalidArgument
 536         | errno == eNETDOWN        = ResourceVanished
 537         | errno == eNETRESET       = ResourceVanished
 538         | errno == eNETUNREACH     = NoSuchThing
 539         | errno == eNFILE          = ResourceExhausted
 540         | errno == eNOBUFS         = ResourceExhausted
 541         | errno == eNODATA         = NoSuchThing
 542         | errno == eNODEV          = UnsupportedOperation
 543         | errno == eNOENT          = NoSuchThing
 544         | errno == eNOEXEC         = InvalidArgument
 545         | errno == eNOLCK          = ResourceExhausted
 546         | errno == eNOLINK         = ResourceVanished
 547         | errno == eNOMEM          = ResourceExhausted
 548         | errno == eNOMSG          = NoSuchThing
 549         | errno == eNONET          = NoSuchThing
 550         | errno == eNOPROTOOPT     = UnsupportedOperation
 551         | errno == eNOSPC          = ResourceExhausted
 552         | errno == eNOSR           = ResourceExhausted
 553         | errno == eNOSTR          = InvalidArgument
 554         | errno == eNOSYS          = UnsupportedOperation
 555         | errno == eNOTBLK         = InvalidArgument
 556         | errno == eNOTCONN        = InvalidArgument
 557         | errno == eNOTDIR         = InappropriateType
 558         | errno == eNOTEMPTY       = UnsatisfiedConstraints
 559         | errno == eNOTSOCK        = InvalidArgument
 560         | errno == eNOTTY          = IllegalOperation
 561         | errno == eNXIO           = NoSuchThing
 562         | errno == eOPNOTSUPP      = UnsupportedOperation
 563         | errno == ePERM           = PermissionDenied
 564         | errno == ePFNOSUPPORT    = UnsupportedOperation
 565         | errno == ePIPE           = ResourceVanished
 566         | errno == ePROCLIM        = PermissionDenied
 567         | errno == ePROCUNAVAIL    = UnsupportedOperation
 568         | errno == ePROGMISMATCH   = ProtocolError
 569         | errno == ePROGUNAVAIL    = UnsupportedOperation
 570         | errno == ePROTO          = ProtocolError
 571         | errno == ePROTONOSUPPORT = ProtocolError
 572         | errno == ePROTOTYPE      = ProtocolError
 573         | errno == eRANGE          = UnsupportedOperation
 574         | errno == eREMCHG         = ResourceVanished
 575         | errno == eREMOTE         = IllegalOperation
 576         | errno == eROFS           = PermissionDenied
 577         | errno == eRPCMISMATCH    = ProtocolError
 578         | errno == eRREMOTE        = IllegalOperation
 579         | errno == eSHUTDOWN       = IllegalOperation
 580         | errno == eSOCKTNOSUPPORT = UnsupportedOperation
 581         | errno == eSPIPE          = UnsupportedOperation
 582         | errno == eSRCH           = NoSuchThing
 583         | errno == eSRMNT          = UnsatisfiedConstraints
 584         | errno == eSTALE          = ResourceVanished
 585         | errno == eTIME           = TimeExpired
 586         | errno == eTIMEDOUT       = TimeExpired
 587         | errno == eTOOMANYREFS    = ResourceExhausted
 588         | errno == eTXTBSY         = ResourceBusy
 589         | errno == eUSERS          = ResourceExhausted
 590         | errno == eWOULDBLOCK     = OtherError
 591         | errno == eXDEV           = UnsupportedOperation
 592         | otherwise                = OtherError
 593 #else
 594     return (userError (loc ++ ": " ++ str ++ maybe "" (": "++) maybeName))
 595 #endif
 596
 597 foreign import ccall unsafe "string.h" strerror :: Errno -> IO (Ptr CChar)