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