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