X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Foreign%2FC%2FError.hs;h=8d149c1dc6bec0d4348d1fbefdc5c0cf26e6de6c;hb=566d4ea2e4434bf0bedfaa518c31bca42959855d;hp=84fd82c9df4fcf8a73cd7965c5fc8b91b60c2458;hpb=55a0a33e44d1f8dcbce0e1ebc88097c69c9e2151;p=ghc-base.git diff --git a/Foreign/C/Error.hs b/Foreign/C/Error.hs index 84fd82c..8d149c1 100644 --- a/Foreign/C/Error.hs +++ b/Foreign/C/Error.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -fno-implicit-prelude -#include "HsBase.h" #-} +{-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-} ----------------------------------------------------------------------------- -- | -- Module : Foreign.C.Error @@ -9,15 +9,21 @@ -- Stability : provisional -- Portability : portable -- --- C-specific Marshalling support: Handling of C "errno" error codes +-- C-specific Marshalling support: Handling of C \"errno\" error codes. -- ----------------------------------------------------------------------------- module Foreign.C.Error ( - -- Haskell representation for "errno" values - -- - Errno(..), -- instance: Eq + -- * Haskell representations of @errno@ values + + Errno(..), -- instance: Eq + + -- ** Common @errno@ symbols + -- | Different operating systems and\/or C libraries often support + -- different values of @errno@. This module defines the common values, + -- but due to the open definition of 'Errno' users may add definitions + -- which are not predefined. eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN, eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED, eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT, @@ -32,8 +38,10 @@ module Foreign.C.Error ( eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN, eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT, eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV, + + -- ** 'Errno' functions -- :: Errno - isValidErrno, -- :: Errno -> Bool + isValidErrno, -- :: Errno -> Bool -- access to the current thread's "errno" value -- @@ -52,85 +60,87 @@ module Foreign.C.Error ( -- throwErrno, -- :: String -> IO a - -- guards for IO operations that may fail - -- + -- ** Guards for IO operations that may fail + throwErrnoIf, -- :: (a -> Bool) -> String -> IO a -> IO a throwErrnoIf_, -- :: (a -> Bool) -> String -> IO a -> IO () throwErrnoIfRetry, -- :: (a -> Bool) -> String -> IO a -> IO a throwErrnoIfRetry_, -- :: (a -> Bool) -> String -> IO a -> IO () throwErrnoIfMinus1, -- :: Num a - -- => String -> IO a -> IO a + -- => String -> IO a -> IO a throwErrnoIfMinus1_, -- :: Num a - -- => String -> IO a -> IO () - throwErrnoIfMinus1Retry, - -- :: Num a - -- => String -> IO a -> IO a + -- => String -> IO a -> IO () + throwErrnoIfMinus1Retry, + -- :: Num a + -- => String -> IO a -> IO a throwErrnoIfMinus1Retry_, - -- :: Num a - -- => String -> IO a -> IO () - throwErrnoIfNull, -- :: String -> IO (Ptr a) -> IO (Ptr a) + -- :: Num a + -- => String -> IO a -> IO () + throwErrnoIfNull, -- :: String -> IO (Ptr a) -> IO (Ptr a) throwErrnoIfNullRetry,-- :: String -> IO (Ptr a) -> IO (Ptr a) throwErrnoIfRetryMayBlock, throwErrnoIfRetryMayBlock_, throwErrnoIfMinus1RetryMayBlock, throwErrnoIfMinus1RetryMayBlock_, - throwErrnoIfNullRetryMayBlock + throwErrnoIfNullRetryMayBlock, + + throwErrnoPath, + throwErrnoPathIf, + throwErrnoPathIf_, + throwErrnoPathIfNull, + throwErrnoPathIfMinus1, + throwErrnoPathIfMinus1_, ) where --- this is were we get the CCONST_XXX definitions from that configure +-- this is were we get the CONST_XXX definitions from that configure -- calculated for us -- -#include "config.h" - --- system dependent imports --- ------------------------ - --- GHC allows us to get at the guts inside IO errors/exceptions --- -#if __GLASGOW_HASKELL__ -import GHC.IOBase (Exception(..), IOException(..), IOErrorType(..)) -#endif /* __GLASGOW_HASKELL__ */ - - --- regular imports --- --------------- +#ifndef __NHC__ +#include "HsBaseConfig.h" +#endif -import Foreign.Storable import Foreign.Ptr import Foreign.C.Types import Foreign.C.String -import Foreign.Marshal.Error ( void ) +import Foreign.Marshal.Error ( void ) import Data.Maybe #if __GLASGOW_HASKELL__ -import GHC.Storable -import GHC.IOBase +import GHC.IO +import GHC.IO.Exception +import GHC.IO.Handle.Types import GHC.Num import GHC.Base +#elif __HUGS__ +import Hugs.Prelude ( Handle, IOError, ioError ) +import System.IO.Unsafe ( unsafePerformIO ) #else -import System.IO ( IOError, Handle, ioError ) -import System.IO.Unsafe ( unsafePerformIO ) +import System.IO ( Handle ) +import System.IO.Error ( IOError, ioError ) +import System.IO.Unsafe ( unsafePerformIO ) +import Foreign.Storable ( Storable(poke,peek) ) +#endif + +#ifdef __HUGS__ +{-# CFILES cbits/PrelIOUtils.c #-} #endif + -- "errno" type -- ------------ --- import of C function that gives address of errno --- This function exists because errno is a variable on some systems, but on --- Windows it is a macro for a function... --- [yes, global variables and thread safety don't really go hand-in-hand. -- sof] -foreign import ccall unsafe "HsBase.h ghcErrno" _errno :: Ptr CInt +-- | Haskell representation for @errno@ values. +-- The implementation is deliberately exposed, to allow users to add +-- their own definitions of 'Errno' values. --- Haskell representation for "errno" values --- newtype Errno = Errno CInt instance Eq Errno where errno1@(Errno no1) == errno2@(Errno no2) | isValidErrno errno1 && isValidErrno errno2 = no1 == no2 - | otherwise = False + | otherwise = False -- common "errno" symbols -- @@ -147,113 +157,118 @@ eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN, ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE, eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN, eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT, - eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV :: Errno + eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV :: Errno -- -- the cCONST_XXX identifiers are cpp symbols whose value is computed by -- configure -- eOK = Errno 0 -e2BIG = Errno (cCONST_E2BIG) -eACCES = Errno (cCONST_EACCES) -eADDRINUSE = Errno (cCONST_EADDRINUSE) -eADDRNOTAVAIL = Errno (cCONST_EADDRNOTAVAIL) -eADV = Errno (cCONST_EADV) -eAFNOSUPPORT = Errno (cCONST_EAFNOSUPPORT) -eAGAIN = Errno (cCONST_EAGAIN) -eALREADY = Errno (cCONST_EALREADY) -eBADF = Errno (cCONST_EBADF) -eBADMSG = Errno (cCONST_EBADMSG) -eBADRPC = Errno (cCONST_EBADRPC) -eBUSY = Errno (cCONST_EBUSY) -eCHILD = Errno (cCONST_ECHILD) -eCOMM = Errno (cCONST_ECOMM) -eCONNABORTED = Errno (cCONST_ECONNABORTED) -eCONNREFUSED = Errno (cCONST_ECONNREFUSED) -eCONNRESET = Errno (cCONST_ECONNRESET) -eDEADLK = Errno (cCONST_EDEADLK) -eDESTADDRREQ = Errno (cCONST_EDESTADDRREQ) -eDIRTY = Errno (cCONST_EDIRTY) -eDOM = Errno (cCONST_EDOM) -eDQUOT = Errno (cCONST_EDQUOT) -eEXIST = Errno (cCONST_EEXIST) -eFAULT = Errno (cCONST_EFAULT) -eFBIG = Errno (cCONST_EFBIG) -eFTYPE = Errno (cCONST_EFTYPE) -eHOSTDOWN = Errno (cCONST_EHOSTDOWN) -eHOSTUNREACH = Errno (cCONST_EHOSTUNREACH) -eIDRM = Errno (cCONST_EIDRM) -eILSEQ = Errno (cCONST_EILSEQ) -eINPROGRESS = Errno (cCONST_EINPROGRESS) -eINTR = Errno (cCONST_EINTR) -eINVAL = Errno (cCONST_EINVAL) -eIO = Errno (cCONST_EIO) -eISCONN = Errno (cCONST_EISCONN) -eISDIR = Errno (cCONST_EISDIR) -eLOOP = Errno (cCONST_ELOOP) -eMFILE = Errno (cCONST_EMFILE) -eMLINK = Errno (cCONST_EMLINK) -eMSGSIZE = Errno (cCONST_EMSGSIZE) -eMULTIHOP = Errno (cCONST_EMULTIHOP) -eNAMETOOLONG = Errno (cCONST_ENAMETOOLONG) -eNETDOWN = Errno (cCONST_ENETDOWN) -eNETRESET = Errno (cCONST_ENETRESET) -eNETUNREACH = Errno (cCONST_ENETUNREACH) -eNFILE = Errno (cCONST_ENFILE) -eNOBUFS = Errno (cCONST_ENOBUFS) -eNODATA = Errno (cCONST_ENODATA) -eNODEV = Errno (cCONST_ENODEV) -eNOENT = Errno (cCONST_ENOENT) -eNOEXEC = Errno (cCONST_ENOEXEC) -eNOLCK = Errno (cCONST_ENOLCK) -eNOLINK = Errno (cCONST_ENOLINK) -eNOMEM = Errno (cCONST_ENOMEM) -eNOMSG = Errno (cCONST_ENOMSG) -eNONET = Errno (cCONST_ENONET) -eNOPROTOOPT = Errno (cCONST_ENOPROTOOPT) -eNOSPC = Errno (cCONST_ENOSPC) -eNOSR = Errno (cCONST_ENOSR) -eNOSTR = Errno (cCONST_ENOSTR) -eNOSYS = Errno (cCONST_ENOSYS) -eNOTBLK = Errno (cCONST_ENOTBLK) -eNOTCONN = Errno (cCONST_ENOTCONN) -eNOTDIR = Errno (cCONST_ENOTDIR) -eNOTEMPTY = Errno (cCONST_ENOTEMPTY) -eNOTSOCK = Errno (cCONST_ENOTSOCK) -eNOTTY = Errno (cCONST_ENOTTY) -eNXIO = Errno (cCONST_ENXIO) -eOPNOTSUPP = Errno (cCONST_EOPNOTSUPP) -ePERM = Errno (cCONST_EPERM) -ePFNOSUPPORT = Errno (cCONST_EPFNOSUPPORT) -ePIPE = Errno (cCONST_EPIPE) -ePROCLIM = Errno (cCONST_EPROCLIM) -ePROCUNAVAIL = Errno (cCONST_EPROCUNAVAIL) -ePROGMISMATCH = Errno (cCONST_EPROGMISMATCH) -ePROGUNAVAIL = Errno (cCONST_EPROGUNAVAIL) -ePROTO = Errno (cCONST_EPROTO) -ePROTONOSUPPORT = Errno (cCONST_EPROTONOSUPPORT) -ePROTOTYPE = Errno (cCONST_EPROTOTYPE) -eRANGE = Errno (cCONST_ERANGE) -eREMCHG = Errno (cCONST_EREMCHG) -eREMOTE = Errno (cCONST_EREMOTE) -eROFS = Errno (cCONST_EROFS) -eRPCMISMATCH = Errno (cCONST_ERPCMISMATCH) -eRREMOTE = Errno (cCONST_ERREMOTE) -eSHUTDOWN = Errno (cCONST_ESHUTDOWN) -eSOCKTNOSUPPORT = Errno (cCONST_ESOCKTNOSUPPORT) -eSPIPE = Errno (cCONST_ESPIPE) -eSRCH = Errno (cCONST_ESRCH) -eSRMNT = Errno (cCONST_ESRMNT) -eSTALE = Errno (cCONST_ESTALE) -eTIME = Errno (cCONST_ETIME) -eTIMEDOUT = Errno (cCONST_ETIMEDOUT) -eTOOMANYREFS = Errno (cCONST_ETOOMANYREFS) -eTXTBSY = Errno (cCONST_ETXTBSY) -eUSERS = Errno (cCONST_EUSERS) -eWOULDBLOCK = Errno (cCONST_EWOULDBLOCK) -eXDEV = Errno (cCONST_EXDEV) - --- checks whether the given errno value is supported on the current --- architecture +#ifdef __NHC__ +#include "Errno.hs" +#else +e2BIG = Errno (CONST_E2BIG) +eACCES = Errno (CONST_EACCES) +eADDRINUSE = Errno (CONST_EADDRINUSE) +eADDRNOTAVAIL = Errno (CONST_EADDRNOTAVAIL) +eADV = Errno (CONST_EADV) +eAFNOSUPPORT = Errno (CONST_EAFNOSUPPORT) +eAGAIN = Errno (CONST_EAGAIN) +eALREADY = Errno (CONST_EALREADY) +eBADF = Errno (CONST_EBADF) +eBADMSG = Errno (CONST_EBADMSG) +eBADRPC = Errno (CONST_EBADRPC) +eBUSY = Errno (CONST_EBUSY) +eCHILD = Errno (CONST_ECHILD) +eCOMM = Errno (CONST_ECOMM) +eCONNABORTED = Errno (CONST_ECONNABORTED) +eCONNREFUSED = Errno (CONST_ECONNREFUSED) +eCONNRESET = Errno (CONST_ECONNRESET) +eDEADLK = Errno (CONST_EDEADLK) +eDESTADDRREQ = Errno (CONST_EDESTADDRREQ) +eDIRTY = Errno (CONST_EDIRTY) +eDOM = Errno (CONST_EDOM) +eDQUOT = Errno (CONST_EDQUOT) +eEXIST = Errno (CONST_EEXIST) +eFAULT = Errno (CONST_EFAULT) +eFBIG = Errno (CONST_EFBIG) +eFTYPE = Errno (CONST_EFTYPE) +eHOSTDOWN = Errno (CONST_EHOSTDOWN) +eHOSTUNREACH = Errno (CONST_EHOSTUNREACH) +eIDRM = Errno (CONST_EIDRM) +eILSEQ = Errno (CONST_EILSEQ) +eINPROGRESS = Errno (CONST_EINPROGRESS) +eINTR = Errno (CONST_EINTR) +eINVAL = Errno (CONST_EINVAL) +eIO = Errno (CONST_EIO) +eISCONN = Errno (CONST_EISCONN) +eISDIR = Errno (CONST_EISDIR) +eLOOP = Errno (CONST_ELOOP) +eMFILE = Errno (CONST_EMFILE) +eMLINK = Errno (CONST_EMLINK) +eMSGSIZE = Errno (CONST_EMSGSIZE) +eMULTIHOP = Errno (CONST_EMULTIHOP) +eNAMETOOLONG = Errno (CONST_ENAMETOOLONG) +eNETDOWN = Errno (CONST_ENETDOWN) +eNETRESET = Errno (CONST_ENETRESET) +eNETUNREACH = Errno (CONST_ENETUNREACH) +eNFILE = Errno (CONST_ENFILE) +eNOBUFS = Errno (CONST_ENOBUFS) +eNODATA = Errno (CONST_ENODATA) +eNODEV = Errno (CONST_ENODEV) +eNOENT = Errno (CONST_ENOENT) +eNOEXEC = Errno (CONST_ENOEXEC) +eNOLCK = Errno (CONST_ENOLCK) +eNOLINK = Errno (CONST_ENOLINK) +eNOMEM = Errno (CONST_ENOMEM) +eNOMSG = Errno (CONST_ENOMSG) +eNONET = Errno (CONST_ENONET) +eNOPROTOOPT = Errno (CONST_ENOPROTOOPT) +eNOSPC = Errno (CONST_ENOSPC) +eNOSR = Errno (CONST_ENOSR) +eNOSTR = Errno (CONST_ENOSTR) +eNOSYS = Errno (CONST_ENOSYS) +eNOTBLK = Errno (CONST_ENOTBLK) +eNOTCONN = Errno (CONST_ENOTCONN) +eNOTDIR = Errno (CONST_ENOTDIR) +eNOTEMPTY = Errno (CONST_ENOTEMPTY) +eNOTSOCK = Errno (CONST_ENOTSOCK) +eNOTTY = Errno (CONST_ENOTTY) +eNXIO = Errno (CONST_ENXIO) +eOPNOTSUPP = Errno (CONST_EOPNOTSUPP) +ePERM = Errno (CONST_EPERM) +ePFNOSUPPORT = Errno (CONST_EPFNOSUPPORT) +ePIPE = Errno (CONST_EPIPE) +ePROCLIM = Errno (CONST_EPROCLIM) +ePROCUNAVAIL = Errno (CONST_EPROCUNAVAIL) +ePROGMISMATCH = Errno (CONST_EPROGMISMATCH) +ePROGUNAVAIL = Errno (CONST_EPROGUNAVAIL) +ePROTO = Errno (CONST_EPROTO) +ePROTONOSUPPORT = Errno (CONST_EPROTONOSUPPORT) +ePROTOTYPE = Errno (CONST_EPROTOTYPE) +eRANGE = Errno (CONST_ERANGE) +eREMCHG = Errno (CONST_EREMCHG) +eREMOTE = Errno (CONST_EREMOTE) +eROFS = Errno (CONST_EROFS) +eRPCMISMATCH = Errno (CONST_ERPCMISMATCH) +eRREMOTE = Errno (CONST_ERREMOTE) +eSHUTDOWN = Errno (CONST_ESHUTDOWN) +eSOCKTNOSUPPORT = Errno (CONST_ESOCKTNOSUPPORT) +eSPIPE = Errno (CONST_ESPIPE) +eSRCH = Errno (CONST_ESRCH) +eSRMNT = Errno (CONST_ESRMNT) +eSTALE = Errno (CONST_ESTALE) +eTIME = Errno (CONST_ETIME) +eTIMEDOUT = Errno (CONST_ETIMEDOUT) +eTOOMANYREFS = Errno (CONST_ETOOMANYREFS) +eTXTBSY = Errno (CONST_ETXTBSY) +eUSERS = Errno (CONST_EUSERS) +eWOULDBLOCK = Errno (CONST_EWOULDBLOCK) +eXDEV = Errno (CONST_EXDEV) +#endif + +-- | Yield 'True' if the given 'Errno' value is valid on the system. +-- This implies that the 'Eq' instance of 'Errno' is also system dependent +-- as it is only defined for valid values of 'Errno'. -- isValidErrno :: Errno -> Bool -- @@ -265,24 +280,40 @@ isValidErrno (Errno errno) = errno /= -1 -- access to the current thread's "errno" value -- -------------------------------------------- --- yield the current thread's "errno" value +-- | Get the current value of @errno@ in the current thread. -- getErrno :: IO Errno -getErrno = do e <- peek _errno; return (Errno e) --- set the current thread's "errno" value to 0 +-- We must call a C function to get the value of errno in general. On +-- threaded systems, errno is hidden behind a C macro so that each OS +-- thread gets its own copy. +#ifdef __NHC__ +getErrno = do e <- peek _errno; return (Errno e) +foreign import ccall unsafe "errno.h &errno" _errno :: Ptr CInt +#else +getErrno = do e <- get_errno; return (Errno e) +foreign import ccall unsafe "HsBase.h __hscore_get_errno" get_errno :: IO CInt +#endif + +-- | Reset the current thread\'s @errno@ value to 'eOK'. -- resetErrno :: IO () -resetErrno = poke _errno 0 +-- Again, setting errno has to be done via a C function. +#ifdef __NHC__ +resetErrno = poke _errno 0 +#else +resetErrno = set_errno 0 +foreign import ccall unsafe "HsBase.h __hscore_set_errno" set_errno :: CInt -> IO () +#endif -- throw current "errno" value -- --------------------------- --- the common case: throw an IO error based on a textual description --- of the error location and the current thread's "errno" value +-- | Throw an 'IOError' corresponding to the current value of 'getErrno'. -- -throwErrno :: String -> IO a +throwErrno :: String -- ^ textual description of the error location + -> IO a throwErrno loc = do errno <- getErrno @@ -292,22 +323,28 @@ throwErrno loc = -- guards for IO operations that may fail -- -------------------------------------- --- guard an IO operation and throw an "errno" based exception of the result --- value of the IO operation meets the given predicate +-- | Throw an 'IOError' corresponding to the current value of 'getErrno' +-- if the result value of the 'IO' action meets the given predicate. -- -throwErrnoIf :: (a -> Bool) -> String -> IO a -> IO a +throwErrnoIf :: (a -> Bool) -- ^ predicate to apply to the result value + -- of the 'IO' operation + -> String -- ^ textual description of the location + -> IO a -- ^ the 'IO' operation to be executed + -> IO a throwErrnoIf pred loc f = do res <- f if pred res then throwErrno loc else return res --- as `throwErrnoIf', but discards the result +-- | as 'throwErrnoIf', but discards the result of the 'IO' action after +-- error handling. -- -throwErrnoIf_ :: (a -> Bool) -> String -> IO a -> IO () +throwErrnoIf_ :: (a -> Bool) -> String -> IO a -> IO () throwErrnoIf_ pred loc f = void $ throwErrnoIf pred loc f --- as `throwErrnoIf', but retries interrupted IO operations (ie, those whose --- flag `EINTR') +-- | as 'throwErrnoIf', but retry the 'IO' action when it yields the +-- error code 'eINTR' - this amounts to the standard retry loop for +-- interrupted POSIX system calls. -- throwErrnoIfRetry :: (a -> Bool) -> String -> IO a -> IO a throwErrnoIfRetry pred loc f = @@ -315,99 +352,159 @@ throwErrnoIfRetry pred loc f = res <- f if pred res then do - err <- getErrno - if err == eINTR - then throwErrnoIfRetry pred loc f - else throwErrno loc + err <- getErrno + if err == eINTR + then throwErrnoIfRetry pred loc f + else throwErrno loc else return res --- as `throwErrnoIfRetry', but checks for operations that would block and --- executes an alternative action in that case. - -throwErrnoIfRetryMayBlock :: (a -> Bool) -> String -> IO a -> IO b -> IO a +-- | as 'throwErrnoIfRetry', but additionally if the operation +-- yields the error code 'eAGAIN' or 'eWOULDBLOCK', an alternative +-- action is executed before retrying. +-- +throwErrnoIfRetryMayBlock + :: (a -> Bool) -- ^ predicate to apply to the result value + -- of the 'IO' operation + -> String -- ^ textual description of the location + -> IO a -- ^ the 'IO' operation to be executed + -> IO b -- ^ action to execute before retrying if + -- an immediate retry would block + -> IO a throwErrnoIfRetryMayBlock pred loc f on_block = do res <- f if pred res then do - err <- getErrno - if err == eINTR - then throwErrnoIfRetryMayBlock pred loc f on_block + err <- getErrno + if err == eINTR + then throwErrnoIfRetryMayBlock pred loc f on_block else if err == eWOULDBLOCK || err == eAGAIN - then do on_block; throwErrnoIfRetryMayBlock pred loc f on_block + then do _ <- on_block + throwErrnoIfRetryMayBlock pred loc f on_block else throwErrno loc else return res --- as `throwErrnoIfRetry', but discards the result +-- | as 'throwErrnoIfRetry', but discards the result. -- throwErrnoIfRetry_ :: (a -> Bool) -> String -> IO a -> IO () throwErrnoIfRetry_ pred loc f = void $ throwErrnoIfRetry pred loc f --- as `throwErrnoIfRetryMayBlock', but discards the result +-- | as 'throwErrnoIfRetryMayBlock', but discards the result. -- throwErrnoIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO () throwErrnoIfRetryMayBlock_ pred loc f on_block = void $ throwErrnoIfRetryMayBlock pred loc f on_block --- throws "errno" if a result of "-1" is returned +-- | Throw an 'IOError' corresponding to the current value of 'getErrno' +-- if the 'IO' action returns a result of @-1@. -- throwErrnoIfMinus1 :: Num a => String -> IO a -> IO a throwErrnoIfMinus1 = throwErrnoIf (== -1) --- as `throwErrnoIfMinus1', but discards the result +-- | as 'throwErrnoIfMinus1', but discards the result. -- throwErrnoIfMinus1_ :: Num a => String -> IO a -> IO () throwErrnoIfMinus1_ = throwErrnoIf_ (== -1) --- throws "errno" if a result of "-1" is returned, but retries in case of an --- interrupted operation +-- | Throw an 'IOError' corresponding to the current value of 'getErrno' +-- if the 'IO' action returns a result of @-1@, but retries in case of +-- an interrupted operation. -- throwErrnoIfMinus1Retry :: Num a => String -> IO a -> IO a throwErrnoIfMinus1Retry = throwErrnoIfRetry (== -1) --- as `throwErrnoIfMinus1', but discards the result +-- | as 'throwErrnoIfMinus1', but discards the result. -- throwErrnoIfMinus1Retry_ :: Num a => String -> IO a -> IO () throwErrnoIfMinus1Retry_ = throwErrnoIfRetry_ (== -1) --- as throwErrnoIfMinus1Retry, but checks for operations that would block +-- | as 'throwErrnoIfMinus1Retry', but checks for operations that would block. -- throwErrnoIfMinus1RetryMayBlock :: Num a => String -> IO a -> IO b -> IO a throwErrnoIfMinus1RetryMayBlock = throwErrnoIfRetryMayBlock (== -1) --- as `throwErrnoIfMinus1RetryMayBlock', but discards the result +-- | as 'throwErrnoIfMinus1RetryMayBlock', but discards the result. -- throwErrnoIfMinus1RetryMayBlock_ :: Num a => String -> IO a -> IO b -> IO () throwErrnoIfMinus1RetryMayBlock_ = throwErrnoIfRetryMayBlock_ (== -1) --- throws "errno" if a result of a NULL pointer is returned +-- | Throw an 'IOError' corresponding to the current value of 'getErrno' +-- if the 'IO' action returns 'nullPtr'. -- throwErrnoIfNull :: String -> IO (Ptr a) -> IO (Ptr a) throwErrnoIfNull = throwErrnoIf (== nullPtr) --- throws "errno" if a result of a NULL pointer is returned, but retries in --- case of an interrupted operation +-- | Throw an 'IOError' corresponding to the current value of 'getErrno' +-- if the 'IO' action returns 'nullPtr', +-- but retry in case of an interrupted operation. -- throwErrnoIfNullRetry :: String -> IO (Ptr a) -> IO (Ptr a) throwErrnoIfNullRetry = throwErrnoIfRetry (== nullPtr) --- as throwErrnoIfNullRetry, but checks for operations that would block +-- | as 'throwErrnoIfNullRetry', but checks for operations that would block. -- throwErrnoIfNullRetryMayBlock :: String -> IO (Ptr a) -> IO b -> IO (Ptr a) throwErrnoIfNullRetryMayBlock = throwErrnoIfRetryMayBlock (== nullPtr) +-- | as 'throwErrno', but exceptions include the given path when appropriate. +-- +throwErrnoPath :: String -> FilePath -> IO a +throwErrnoPath loc path = + do + errno <- getErrno + ioError (errnoToIOError loc errno Nothing (Just path)) + +-- | as 'throwErrnoIf', but exceptions include the given path when +-- appropriate. +-- +throwErrnoPathIf :: (a -> Bool) -> String -> FilePath -> IO a -> IO a +throwErrnoPathIf pred loc path f = + do + res <- f + if pred res then throwErrnoPath loc path else return res + +-- | as 'throwErrnoIf_', but exceptions include the given path when +-- appropriate. +-- +throwErrnoPathIf_ :: (a -> Bool) -> String -> FilePath -> IO a -> IO () +throwErrnoPathIf_ pred loc path f = void $ throwErrnoPathIf pred loc path f + +-- | as 'throwErrnoIfNull', but exceptions include the given path when +-- appropriate. +-- +throwErrnoPathIfNull :: String -> FilePath -> IO (Ptr a) -> IO (Ptr a) +throwErrnoPathIfNull = throwErrnoPathIf (== nullPtr) + +-- | as 'throwErrnoIfMinus1', but exceptions include the given path when +-- appropriate. +-- +throwErrnoPathIfMinus1 :: Num a => String -> FilePath -> IO a -> IO a +throwErrnoPathIfMinus1 = throwErrnoPathIf (== -1) + +-- | as 'throwErrnoIfMinus1_', but exceptions include the given path when +-- appropriate. +-- +throwErrnoPathIfMinus1_ :: Num a => String -> FilePath -> IO a -> IO () +throwErrnoPathIfMinus1_ = throwErrnoPathIf_ (== -1) + -- conversion of an "errno" value into IO error -- -------------------------------------------- --- convert a location string, an "errno" value, an optional handle, --- and an optional filename into a matching IO error +-- | Construct an 'IOError' based on the given 'Errno' value. +-- The optional information can be used to improve the accuracy of +-- error messages. -- -errnoToIOError :: String -> Errno -> Maybe Handle -> Maybe String -> IOError +errnoToIOError :: String -- ^ the location where the error occurred + -> Errno -- ^ the error number + -> Maybe Handle -- ^ optional handle associated with the error + -> Maybe String -- ^ optional filename associated with the error + -> IOError errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do str <- strerror errno >>= peekCString #if __GLASGOW_HASKELL__ - return (IOException (IOError maybeHdl errType loc str maybeName)) + return (IOError maybeHdl errType loc str (Just errno') maybeName) where + Errno errno' = errno errType | errno == eOK = OtherError | errno == e2BIG = ResourceExhausted @@ -418,7 +515,7 @@ errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do | errno == eAFNOSUPPORT = UnsupportedOperation | errno == eAGAIN = ResourceExhausted | errno == eALREADY = AlreadyExists - | errno == eBADF = OtherError + | errno == eBADF = InvalidArgument | errno == eBADMSG = InappropriateType | errno == eBADRPC = OtherError | errno == eBUSY = ResourceBusy @@ -514,106 +611,3 @@ errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do #endif foreign import ccall unsafe "string.h" strerror :: Errno -> IO (Ptr CChar) - - --- Dreadfully tedious callouts to wrappers which define the --- actual values for the error codes. -foreign import ccall unsafe "prel_error_E2BIG" cCONST_E2BIG :: CInt -foreign import ccall unsafe "prel_error_EACCES" cCONST_EACCES :: CInt -foreign import ccall unsafe "prel_error_EADDRINUSE" cCONST_EADDRINUSE :: CInt -foreign import ccall unsafe "prel_error_EADDRNOTAVAIL" cCONST_EADDRNOTAVAIL :: CInt -foreign import ccall unsafe "prel_error_EADV" cCONST_EADV :: CInt -foreign import ccall unsafe "prel_error_EAFNOSUPPORT" cCONST_EAFNOSUPPORT :: CInt -foreign import ccall unsafe "prel_error_EAGAIN" cCONST_EAGAIN :: CInt -foreign import ccall unsafe "prel_error_EALREADY" cCONST_EALREADY :: CInt -foreign import ccall unsafe "prel_error_EBADF" cCONST_EBADF :: CInt -foreign import ccall unsafe "prel_error_EBADMSG" cCONST_EBADMSG :: CInt -foreign import ccall unsafe "prel_error_EBADRPC" cCONST_EBADRPC :: CInt -foreign import ccall unsafe "prel_error_EBUSY" cCONST_EBUSY :: CInt -foreign import ccall unsafe "prel_error_ECHILD" cCONST_ECHILD :: CInt -foreign import ccall unsafe "prel_error_ECOMM" cCONST_ECOMM :: CInt -foreign import ccall unsafe "prel_error_ECONNABORTED" cCONST_ECONNABORTED :: CInt -foreign import ccall unsafe "prel_error_ECONNREFUSED" cCONST_ECONNREFUSED :: CInt -foreign import ccall unsafe "prel_error_ECONNRESET" cCONST_ECONNRESET :: CInt -foreign import ccall unsafe "prel_error_EDEADLK" cCONST_EDEADLK :: CInt -foreign import ccall unsafe "prel_error_EDESTADDRREQ" cCONST_EDESTADDRREQ :: CInt -foreign import ccall unsafe "prel_error_EDIRTY" cCONST_EDIRTY :: CInt -foreign import ccall unsafe "prel_error_EDOM" cCONST_EDOM :: CInt -foreign import ccall unsafe "prel_error_EDQUOT" cCONST_EDQUOT :: CInt -foreign import ccall unsafe "prel_error_EEXIST" cCONST_EEXIST :: CInt -foreign import ccall unsafe "prel_error_EFAULT" cCONST_EFAULT :: CInt -foreign import ccall unsafe "prel_error_EFBIG" cCONST_EFBIG :: CInt -foreign import ccall unsafe "prel_error_EFTYPE" cCONST_EFTYPE :: CInt -foreign import ccall unsafe "prel_error_EHOSTDOWN" cCONST_EHOSTDOWN :: CInt -foreign import ccall unsafe "prel_error_EHOSTUNREACH" cCONST_EHOSTUNREACH :: CInt -foreign import ccall unsafe "prel_error_EIDRM" cCONST_EIDRM :: CInt -foreign import ccall unsafe "prel_error_EILSEQ" cCONST_EILSEQ :: CInt -foreign import ccall unsafe "prel_error_EINPROGRESS" cCONST_EINPROGRESS :: CInt -foreign import ccall unsafe "prel_error_EINTR" cCONST_EINTR :: CInt -foreign import ccall unsafe "prel_error_EINVAL" cCONST_EINVAL :: CInt -foreign import ccall unsafe "prel_error_EIO" cCONST_EIO :: CInt -foreign import ccall unsafe "prel_error_EISCONN" cCONST_EISCONN :: CInt -foreign import ccall unsafe "prel_error_EISDIR" cCONST_EISDIR :: CInt -foreign import ccall unsafe "prel_error_ELOOP" cCONST_ELOOP :: CInt -foreign import ccall unsafe "prel_error_EMFILE" cCONST_EMFILE :: CInt -foreign import ccall unsafe "prel_error_EMLINK" cCONST_EMLINK :: CInt -foreign import ccall unsafe "prel_error_EMSGSIZE" cCONST_EMSGSIZE :: CInt -foreign import ccall unsafe "prel_error_EMULTIHOP" cCONST_EMULTIHOP :: CInt -foreign import ccall unsafe "prel_error_ENAMETOOLONG" cCONST_ENAMETOOLONG :: CInt -foreign import ccall unsafe "prel_error_ENETDOWN" cCONST_ENETDOWN :: CInt -foreign import ccall unsafe "prel_error_ENETRESET" cCONST_ENETRESET :: CInt -foreign import ccall unsafe "prel_error_ENETUNREACH" cCONST_ENETUNREACH :: CInt -foreign import ccall unsafe "prel_error_ENFILE" cCONST_ENFILE :: CInt -foreign import ccall unsafe "prel_error_ENOBUFS" cCONST_ENOBUFS :: CInt -foreign import ccall unsafe "prel_error_ENODATA" cCONST_ENODATA :: CInt -foreign import ccall unsafe "prel_error_ENODEV" cCONST_ENODEV :: CInt -foreign import ccall unsafe "prel_error_ENOENT" cCONST_ENOENT :: CInt -foreign import ccall unsafe "prel_error_ENOEXEC" cCONST_ENOEXEC :: CInt -foreign import ccall unsafe "prel_error_ENOLCK" cCONST_ENOLCK :: CInt -foreign import ccall unsafe "prel_error_ENOLINK" cCONST_ENOLINK :: CInt -foreign import ccall unsafe "prel_error_ENOMEM" cCONST_ENOMEM :: CInt -foreign import ccall unsafe "prel_error_ENOMSG" cCONST_ENOMSG :: CInt -foreign import ccall unsafe "prel_error_ENONET" cCONST_ENONET :: CInt -foreign import ccall unsafe "prel_error_ENOPROTOOPT" cCONST_ENOPROTOOPT :: CInt -foreign import ccall unsafe "prel_error_ENOSPC" cCONST_ENOSPC :: CInt -foreign import ccall unsafe "prel_error_ENOSR" cCONST_ENOSR :: CInt -foreign import ccall unsafe "prel_error_ENOSTR" cCONST_ENOSTR :: CInt -foreign import ccall unsafe "prel_error_ENOSYS" cCONST_ENOSYS :: CInt -foreign import ccall unsafe "prel_error_ENOTBLK" cCONST_ENOTBLK :: CInt -foreign import ccall unsafe "prel_error_ENOTCONN" cCONST_ENOTCONN :: CInt -foreign import ccall unsafe "prel_error_ENOTDIR" cCONST_ENOTDIR :: CInt -foreign import ccall unsafe "prel_error_ENOTEMPTY" cCONST_ENOTEMPTY :: CInt -foreign import ccall unsafe "prel_error_ENOTSOCK" cCONST_ENOTSOCK :: CInt -foreign import ccall unsafe "prel_error_ENOTTY" cCONST_ENOTTY :: CInt -foreign import ccall unsafe "prel_error_ENXIO" cCONST_ENXIO :: CInt -foreign import ccall unsafe "prel_error_EOPNOTSUPP" cCONST_EOPNOTSUPP :: CInt -foreign import ccall unsafe "prel_error_EPERM" cCONST_EPERM :: CInt -foreign import ccall unsafe "prel_error_EPFNOSUPPORT" cCONST_EPFNOSUPPORT :: CInt -foreign import ccall unsafe "prel_error_EPIPE" cCONST_EPIPE :: CInt -foreign import ccall unsafe "prel_error_EPROCLIM" cCONST_EPROCLIM :: CInt -foreign import ccall unsafe "prel_error_EPROCUNAVAIL" cCONST_EPROCUNAVAIL :: CInt -foreign import ccall unsafe "prel_error_EPROGMISMATCH" cCONST_EPROGMISMATCH :: CInt -foreign import ccall unsafe "prel_error_EPROGUNAVAIL" cCONST_EPROGUNAVAIL :: CInt -foreign import ccall unsafe "prel_error_EPROTO" cCONST_EPROTO :: CInt -foreign import ccall unsafe "prel_error_EPROTONOSUPPORT" cCONST_EPROTONOSUPPORT :: CInt -foreign import ccall unsafe "prel_error_EPROTOTYPE" cCONST_EPROTOTYPE :: CInt -foreign import ccall unsafe "prel_error_ERANGE" cCONST_ERANGE :: CInt -foreign import ccall unsafe "prel_error_EREMCHG" cCONST_EREMCHG :: CInt -foreign import ccall unsafe "prel_error_EREMOTE" cCONST_EREMOTE :: CInt -foreign import ccall unsafe "prel_error_EROFS" cCONST_EROFS :: CInt -foreign import ccall unsafe "prel_error_ERPCMISMATCH" cCONST_ERPCMISMATCH :: CInt -foreign import ccall unsafe "prel_error_ERREMOTE" cCONST_ERREMOTE :: CInt -foreign import ccall unsafe "prel_error_ESHUTDOWN" cCONST_ESHUTDOWN :: CInt -foreign import ccall unsafe "prel_error_ESOCKTNOSUPPORT" cCONST_ESOCKTNOSUPPORT :: CInt -foreign import ccall unsafe "prel_error_ESPIPE" cCONST_ESPIPE :: CInt -foreign import ccall unsafe "prel_error_ESRCH" cCONST_ESRCH :: CInt -foreign import ccall unsafe "prel_error_ESRMNT" cCONST_ESRMNT :: CInt -foreign import ccall unsafe "prel_error_ESTALE" cCONST_ESTALE :: CInt -foreign import ccall unsafe "prel_error_ETIME" cCONST_ETIME :: CInt -foreign import ccall unsafe "prel_error_ETIMEDOUT" cCONST_ETIMEDOUT :: CInt -foreign import ccall unsafe "prel_error_ETOOMANYREFS" cCONST_ETOOMANYREFS :: CInt -foreign import ccall unsafe "prel_error_ETXTBSY" cCONST_ETXTBSY :: CInt -foreign import ccall unsafe "prel_error_EUSERS" cCONST_EUSERS :: CInt -foreign import ccall unsafe "prel_error_EWOULDBLOCK" cCONST_EWOULDBLOCK :: CInt -foreign import ccall unsafe "prel_error_EXDEV" cCONST_EXDEV :: CInt -