Foreign/C/Error.hs

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