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