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 (Just errno') maybeName)
 502     where
 503     Errno errno' = errno
 504     errType
 505         | errno == eOK             = OtherError
 506         | errno == e2BIG           = ResourceExhausted
 507         | errno == eACCES          = PermissionDenied
 508         | errno == eADDRINUSE      = ResourceBusy
 509         | errno == eADDRNOTAVAIL   = UnsupportedOperation
 510         | errno == eADV            = OtherError
 511         | errno == eAFNOSUPPORT    = UnsupportedOperation
 512         | errno == eAGAIN          = ResourceExhausted
 513         | errno == eALREADY        = AlreadyExists
 514         | errno == eBADF           = InvalidArgument
 515         | errno == eBADMSG         = InappropriateType
 516         | errno == eBADRPC         = OtherError
 517         | errno == eBUSY           = ResourceBusy
 518         | errno == eCHILD          = NoSuchThing
 519         | errno == eCOMM           = ResourceVanished
 520         | errno == eCONNABORTED    = OtherError
 521         | errno == eCONNREFUSED    = NoSuchThing
 522         | errno == eCONNRESET      = ResourceVanished
 523         | errno == eDEADLK         = ResourceBusy
 524         | errno == eDESTADDRREQ    = InvalidArgument
 525         | errno == eDIRTY          = UnsatisfiedConstraints
 526         | errno == eDOM            = InvalidArgument
 527         | errno == eDQUOT          = PermissionDenied
 528         | errno == eEXIST          = AlreadyExists
 529         | errno == eFAULT          = OtherError
 530         | errno == eFBIG           = PermissionDenied
 531         | errno == eFTYPE          = InappropriateType
 532         | errno == eHOSTDOWN       = NoSuchThing
 533         | errno == eHOSTUNREACH    = NoSuchThing
 534         | errno == eIDRM           = ResourceVanished
 535         | errno == eILSEQ          = InvalidArgument
 536         | errno == eINPROGRESS     = AlreadyExists
 537         | errno == eINTR           = Interrupted
 538         | errno == eINVAL          = InvalidArgument
 539         | errno == eIO             = HardwareFault
 540         | errno == eISCONN         = AlreadyExists
 541         | errno == eISDIR          = InappropriateType
 542         | errno == eLOOP           = InvalidArgument
 543         | errno == eMFILE          = ResourceExhausted
 544         | errno == eMLINK          = ResourceExhausted
 545         | errno == eMSGSIZE        = ResourceExhausted
 546         | errno == eMULTIHOP       = UnsupportedOperation
 547         | errno == eNAMETOOLONG    = InvalidArgument
 548         | errno == eNETDOWN        = ResourceVanished
 549         | errno == eNETRESET       = ResourceVanished
 550         | errno == eNETUNREACH     = NoSuchThing
 551         | errno == eNFILE          = ResourceExhausted
 552         | errno == eNOBUFS         = ResourceExhausted
 553         | errno == eNODATA         = NoSuchThing
 554         | errno == eNODEV          = UnsupportedOperation
 555         | errno == eNOENT          = NoSuchThing
 556         | errno == eNOEXEC         = InvalidArgument
 557         | errno == eNOLCK          = ResourceExhausted
 558         | errno == eNOLINK         = ResourceVanished
 559         | errno == eNOMEM          = ResourceExhausted
 560         | errno == eNOMSG          = NoSuchThing
 561         | errno == eNONET          = NoSuchThing
 562         | errno == eNOPROTOOPT     = UnsupportedOperation
 563         | errno == eNOSPC          = ResourceExhausted
 564         | errno == eNOSR           = ResourceExhausted
 565         | errno == eNOSTR          = InvalidArgument
 566         | errno == eNOSYS          = UnsupportedOperation
 567         | errno == eNOTBLK         = InvalidArgument
 568         | errno == eNOTCONN        = InvalidArgument
 569         | errno == eNOTDIR         = InappropriateType
 570         | errno == eNOTEMPTY       = UnsatisfiedConstraints
 571         | errno == eNOTSOCK        = InvalidArgument
 572         | errno == eNOTTY          = IllegalOperation
 573         | errno == eNXIO           = NoSuchThing
 574         | errno == eOPNOTSUPP      = UnsupportedOperation
 575         | errno == ePERM           = PermissionDenied
 576         | errno == ePFNOSUPPORT    = UnsupportedOperation
 577         | errno == ePIPE           = ResourceVanished
 578         | errno == ePROCLIM        = PermissionDenied
 579         | errno == ePROCUNAVAIL    = UnsupportedOperation
 580         | errno == ePROGMISMATCH   = ProtocolError
 581         | errno == ePROGUNAVAIL    = UnsupportedOperation
 582         | errno == ePROTO          = ProtocolError
 583         | errno == ePROTONOSUPPORT = ProtocolError
 584         | errno == ePROTOTYPE      = ProtocolError
 585         | errno == eRANGE          = UnsupportedOperation
 586         | errno == eREMCHG         = ResourceVanished
 587         | errno == eREMOTE         = IllegalOperation
 588         | errno == eROFS           = PermissionDenied
 589         | errno == eRPCMISMATCH    = ProtocolError
 590         | errno == eRREMOTE        = IllegalOperation
 591         | errno == eSHUTDOWN       = IllegalOperation
 592         | errno == eSOCKTNOSUPPORT = UnsupportedOperation
 593         | errno == eSPIPE          = UnsupportedOperation
 594         | errno == eSRCH           = NoSuchThing
 595         | errno == eSRMNT          = UnsatisfiedConstraints
 596         | errno == eSTALE          = ResourceVanished
 597         | errno == eTIME           = TimeExpired
 598         | errno == eTIMEDOUT       = TimeExpired
 599         | errno == eTOOMANYREFS    = ResourceExhausted
 600         | errno == eTXTBSY         = ResourceBusy
 601         | errno == eUSERS          = ResourceExhausted
 602         | errno == eWOULDBLOCK     = OtherError
 603         | errno == eXDEV           = UnsupportedOperation
 604         | otherwise                = OtherError
 605 #else
 606     return (userError (loc ++ ": " ++ str ++ maybe "" (": "++) maybeName))
 607 #endif
 608
 609 foreign import ccall unsafe "string.h" strerror :: Errno -> IO (Ptr CChar)