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
 382                          throwErrnoIfRetryMayBlock pred loc f on_block
 383                  else throwErrno loc
 384       else return res
 385
 386 -- | as 'throwErrnoIfRetry', but discards the result.
 387 --
 388 throwErrnoIfRetry_            :: (a -> Bool) -> String -> IO a -> IO ()
 389 throwErrnoIfRetry_ pred loc f  = void $ throwErrnoIfRetry pred loc f
 390
 391 -- | as 'throwErrnoIfRetryMayBlock', but discards the result.
 392 --
 393 throwErrnoIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO ()
 394 throwErrnoIfRetryMayBlock_ pred loc f on_block
 395   = void $ throwErrnoIfRetryMayBlock pred loc f on_block
 396
 397 -- | Throw an 'IOError' corresponding to the current value of 'getErrno'
 398 -- if the 'IO' action returns a result of @-1@.
 399 --
 400 throwErrnoIfMinus1 :: Num a => String -> IO a -> IO a
 401 throwErrnoIfMinus1  = throwErrnoIf (== -1)
 402
 403 -- | as 'throwErrnoIfMinus1', but discards the result.
 404 --
 405 throwErrnoIfMinus1_ :: Num a => String -> IO a -> IO ()
 406 throwErrnoIfMinus1_  = throwErrnoIf_ (== -1)
 407
 408 -- | Throw an 'IOError' corresponding to the current value of 'getErrno'
 409 -- if the 'IO' action returns a result of @-1@, but retries in case of
 410 -- an interrupted operation.
 411 --
 412 throwErrnoIfMinus1Retry :: Num a => String -> IO a -> IO a
 413 throwErrnoIfMinus1Retry  = throwErrnoIfRetry (== -1)
 414
 415 -- | as 'throwErrnoIfMinus1', but discards the result.
 416 --
 417 throwErrnoIfMinus1Retry_ :: Num a => String -> IO a -> IO ()
 418 throwErrnoIfMinus1Retry_  = throwErrnoIfRetry_ (== -1)
 419
 420 -- | as 'throwErrnoIfMinus1Retry', but checks for operations that would block.
 421 --
 422 throwErrnoIfMinus1RetryMayBlock :: Num a => String -> IO a -> IO b -> IO a
 423 throwErrnoIfMinus1RetryMayBlock  = throwErrnoIfRetryMayBlock (== -1)
 424
 425 -- | as 'throwErrnoIfMinus1RetryMayBlock', but discards the result.
 426 --
 427 throwErrnoIfMinus1RetryMayBlock_ :: Num a => String -> IO a -> IO b -> IO ()
 428 throwErrnoIfMinus1RetryMayBlock_  = throwErrnoIfRetryMayBlock_ (== -1)
 429
 430 -- | Throw an 'IOError' corresponding to the current value of 'getErrno'
 431 -- if the 'IO' action returns 'nullPtr'.
 432 --
 433 throwErrnoIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
 434 throwErrnoIfNull  = throwErrnoIf (== nullPtr)
 435
 436 -- | Throw an 'IOError' corresponding to the current value of 'getErrno'
 437 -- if the 'IO' action returns 'nullPtr',
 438 -- but retry in case of an interrupted operation.
 439 --
 440 throwErrnoIfNullRetry :: String -> IO (Ptr a) -> IO (Ptr a)
 441 throwErrnoIfNullRetry  = throwErrnoIfRetry (== nullPtr)
 442
 443 -- | as 'throwErrnoIfNullRetry', but checks for operations that would block.
 444 --
 445 throwErrnoIfNullRetryMayBlock :: String -> IO (Ptr a) -> IO b -> IO (Ptr a)
 446 throwErrnoIfNullRetryMayBlock  = throwErrnoIfRetryMayBlock (== nullPtr)
 447
 448 -- | as 'throwErrno', but exceptions include the given path when appropriate.
 449 --
 450 throwErrnoPath :: String -> FilePath -> IO a
 451 throwErrnoPath loc path =
 452   do
 453     errno <- getErrno
 454     ioError (errnoToIOError loc errno Nothing (Just path))
 455
 456 -- | as 'throwErrnoIf', but exceptions include the given path when
 457 --   appropriate.
 458 --
 459 throwErrnoPathIf :: (a -> Bool) -> String -> FilePath -> IO a -> IO a
 460 throwErrnoPathIf pred loc path f =
 461   do
 462     res <- f
 463     if pred res then throwErrnoPath loc path else return res
 464
 465 -- | as 'throwErrnoIf_', but exceptions include the given path when
 466 --   appropriate.
 467 --
 468 throwErrnoPathIf_ :: (a -> Bool) -> String -> FilePath -> IO a -> IO ()
 469 throwErrnoPathIf_ pred loc path f  = void $ throwErrnoPathIf pred loc path f
 470
 471 -- | as 'throwErrnoIfNull', but exceptions include the given path when
 472 --   appropriate.
 473 --
 474 throwErrnoPathIfNull :: String -> FilePath -> IO (Ptr a) -> IO (Ptr a)
 475 throwErrnoPathIfNull  = throwErrnoPathIf (== nullPtr)
 476
 477 -- | as 'throwErrnoIfMinus1', but exceptions include the given path when
 478 --   appropriate.
 479 --
 480 throwErrnoPathIfMinus1 :: Num a => String -> FilePath -> IO a -> IO a
 481 throwErrnoPathIfMinus1 = throwErrnoPathIf (== -1)
 482
 483 -- | as 'throwErrnoIfMinus1_', but exceptions include the given path when
 484 --   appropriate.
 485 --
 486 throwErrnoPathIfMinus1_ :: Num a => String -> FilePath -> IO a -> IO ()
 487 throwErrnoPathIfMinus1_  = throwErrnoPathIf_ (== -1)
 488
 489 -- conversion of an "errno" value into IO error
 490 -- --------------------------------------------
 491
 492 -- | Construct a Haskell 98 I\/O error based on the given 'Errno' value.
 493 -- The optional information can be used to improve the accuracy of
 494 -- error messages.
 495 --
 496 errnoToIOError  :: String       -- ^ the location where the error occurred
 497                 -> Errno        -- ^ the error number
 498                 -> Maybe Handle -- ^ optional handle associated with the error
 499                 -> Maybe String -- ^ optional filename associated with the error
 500                 -> IOError
 501 errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
 502     str <- strerror errno >>= peekCString
 503 #if __GLASGOW_HASKELL__
 504     return (IOError maybeHdl errType loc str (Just errno') maybeName)
 505     where
 506     Errno errno' = errno
 507     errType
 508         | errno == eOK             = OtherError
 509         | errno == e2BIG           = ResourceExhausted
 510         | errno == eACCES          = PermissionDenied
 511         | errno == eADDRINUSE      = ResourceBusy
 512         | errno == eADDRNOTAVAIL   = UnsupportedOperation
 513         | errno == eADV            = OtherError
 514         | errno == eAFNOSUPPORT    = UnsupportedOperation
 515         | errno == eAGAIN          = ResourceExhausted
 516         | errno == eALREADY        = AlreadyExists
 517         | errno == eBADF           = InvalidArgument
 518         | errno == eBADMSG         = InappropriateType
 519         | errno == eBADRPC         = OtherError
 520         | errno == eBUSY           = ResourceBusy
 521         | errno == eCHILD          = NoSuchThing
 522         | errno == eCOMM           = ResourceVanished
 523         | errno == eCONNABORTED    = OtherError
 524         | errno == eCONNREFUSED    = NoSuchThing
 525         | errno == eCONNRESET      = ResourceVanished
 526         | errno == eDEADLK         = ResourceBusy
 527         | errno == eDESTADDRREQ    = InvalidArgument
 528         | errno == eDIRTY          = UnsatisfiedConstraints
 529         | errno == eDOM            = InvalidArgument
 530         | errno == eDQUOT          = PermissionDenied
 531         | errno == eEXIST          = AlreadyExists
 532         | errno == eFAULT          = OtherError
 533         | errno == eFBIG           = PermissionDenied
 534         | errno == eFTYPE          = InappropriateType
 535         | errno == eHOSTDOWN       = NoSuchThing
 536         | errno == eHOSTUNREACH    = NoSuchThing
 537         | errno == eIDRM           = ResourceVanished
 538         | errno == eILSEQ          = InvalidArgument
 539         | errno == eINPROGRESS     = AlreadyExists
 540         | errno == eINTR           = Interrupted
 541         | errno == eINVAL          = InvalidArgument
 542         | errno == eIO             = HardwareFault
 543         | errno == eISCONN         = AlreadyExists
 544         | errno == eISDIR          = InappropriateType
 545         | errno == eLOOP           = InvalidArgument
 546         | errno == eMFILE          = ResourceExhausted
 547         | errno == eMLINK          = ResourceExhausted
 548         | errno == eMSGSIZE        = ResourceExhausted
 549         | errno == eMULTIHOP       = UnsupportedOperation
 550         | errno == eNAMETOOLONG    = InvalidArgument
 551         | errno == eNETDOWN        = ResourceVanished
 552         | errno == eNETRESET       = ResourceVanished
 553         | errno == eNETUNREACH     = NoSuchThing
 554         | errno == eNFILE          = ResourceExhausted
 555         | errno == eNOBUFS         = ResourceExhausted
 556         | errno == eNODATA         = NoSuchThing
 557         | errno == eNODEV          = UnsupportedOperation
 558         | errno == eNOENT          = NoSuchThing
 559         | errno == eNOEXEC         = InvalidArgument
 560         | errno == eNOLCK          = ResourceExhausted
 561         | errno == eNOLINK         = ResourceVanished
 562         | errno == eNOMEM          = ResourceExhausted
 563         | errno == eNOMSG          = NoSuchThing
 564         | errno == eNONET          = NoSuchThing
 565         | errno == eNOPROTOOPT     = UnsupportedOperation
 566         | errno == eNOSPC          = ResourceExhausted
 567         | errno == eNOSR           = ResourceExhausted
 568         | errno == eNOSTR          = InvalidArgument
 569         | errno == eNOSYS          = UnsupportedOperation
 570         | errno == eNOTBLK         = InvalidArgument
 571         | errno == eNOTCONN        = InvalidArgument
 572         | errno == eNOTDIR         = InappropriateType
 573         | errno == eNOTEMPTY       = UnsatisfiedConstraints
 574         | errno == eNOTSOCK        = InvalidArgument
 575         | errno == eNOTTY          = IllegalOperation
 576         | errno == eNXIO           = NoSuchThing
 577         | errno == eOPNOTSUPP      = UnsupportedOperation
 578         | errno == ePERM           = PermissionDenied
 579         | errno == ePFNOSUPPORT    = UnsupportedOperation
 580         | errno == ePIPE           = ResourceVanished
 581         | errno == ePROCLIM        = PermissionDenied
 582         | errno == ePROCUNAVAIL    = UnsupportedOperation
 583         | errno == ePROGMISMATCH   = ProtocolError
 584         | errno == ePROGUNAVAIL    = UnsupportedOperation
 585         | errno == ePROTO          = ProtocolError
 586         | errno == ePROTONOSUPPORT = ProtocolError
 587         | errno == ePROTOTYPE      = ProtocolError
 588         | errno == eRANGE          = UnsupportedOperation
 589         | errno == eREMCHG         = ResourceVanished
 590         | errno == eREMOTE         = IllegalOperation
 591         | errno == eROFS           = PermissionDenied
 592         | errno == eRPCMISMATCH    = ProtocolError
 593         | errno == eRREMOTE        = IllegalOperation
 594         | errno == eSHUTDOWN       = IllegalOperation
 595         | errno == eSOCKTNOSUPPORT = UnsupportedOperation
 596         | errno == eSPIPE          = UnsupportedOperation
 597         | errno == eSRCH           = NoSuchThing
 598         | errno == eSRMNT          = UnsatisfiedConstraints
 599         | errno == eSTALE          = ResourceVanished
 600         | errno == eTIME           = TimeExpired
 601         | errno == eTIMEDOUT       = TimeExpired
 602         | errno == eTOOMANYREFS    = ResourceExhausted
 603         | errno == eTXTBSY         = ResourceBusy
 604         | errno == eUSERS          = ResourceExhausted
 605         | errno == eWOULDBLOCK     = OtherError
 606         | errno == eXDEV           = UnsupportedOperation
 607         | otherwise                = OtherError
 608 #else
 609     return (userError (loc ++ ": " ++ str ++ maybe "" (": "++) maybeName))
 610 #endif
 611
 612 foreign import ccall unsafe "string.h" strerror :: Errno -> IO (Ptr CChar)