1 % -----------------------------------------------------------------------------
2 % $Id: PrelCError.lhs,v 1.9 2001/05/18 21:45:43 qrczak Exp $
4 % (c) The FFI task force, 2000
7 C-specific Marshalling support: Handling of C "errno" error codes
10 {-# OPTIONS -fno-implicit-prelude -#include "HsStd.h" #-}
12 -- this is were we get the CCONST_XXX definitions from that configure
19 -- Haskell representation for "errno" values
21 Errno(..), -- instance: Eq
22 eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,
23 eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED,
24 eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT,
25 eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ,
26 eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK,
27 eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH,
28 eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK,
29 eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS,
30 eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTTY, eNXIO,
31 eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL,
32 ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE,
33 eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN,
34 eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT,
35 eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV,
37 isValidErrno, -- :: Errno -> Bool
39 -- access to the current thread's "errno" value
41 getErrno, -- :: IO Errno
42 resetErrno, -- :: IO ()
44 -- conversion of an "errno" value into IO error
46 errnoToIOError, -- :: String -- location
48 -- -> Maybe Handle -- handle
49 -- -> Maybe String -- filename
52 -- throw current "errno" value
54 throwErrno, -- :: String -> IO a
56 -- guards for IO operations that may fail
58 throwErrnoIf, -- :: (a -> Bool) -> String -> IO a -> IO a
59 throwErrnoIf_, -- :: (a -> Bool) -> String -> IO a -> IO ()
60 throwErrnoIfRetry, -- :: (a -> Bool) -> String -> IO a -> IO a
61 throwErrnoIfRetry_, -- :: (a -> Bool) -> String -> IO a -> IO ()
62 throwErrnoIfMinus1, -- :: Num a
63 -- => String -> IO a -> IO a
64 throwErrnoIfMinus1_, -- :: Num a
65 -- => String -> IO a -> IO ()
66 throwErrnoIfMinus1Retry,
68 -- => String -> IO a -> IO a
69 throwErrnoIfMinus1Retry_,
71 -- => String -> IO a -> IO ()
72 throwErrnoIfNull, -- :: String -> IO (Ptr a) -> IO (Ptr a)
73 throwErrnoIfNullRetry,-- :: String -> IO (Ptr a) -> IO (Ptr a)
75 throwErrnoIfRetryMayBlock,
76 throwErrnoIfRetryMayBlock_,
77 throwErrnoIfMinus1RetryMayBlock,
78 throwErrnoIfMinus1RetryMayBlock_,
79 throwErrnoIfNullRetryMayBlock
83 -- system dependent imports
84 -- ------------------------
86 -- GHC allows us to get at the guts inside IO errors/exceptions
88 #if __GLASGOW_HASKELL__
89 import PrelIOBase (Exception(..), IOException(..), IOErrorType(..))
90 #endif /* __GLASGOW_HASKELL__ */
96 #if __GLASGOW_HASKELL__
98 import PrelMarshalError
108 import Ptr (Ptr, nullPtr)
110 import CString (peekCString)
111 import MarshalError (void)
113 import IO (IOError, Handle, ioError)
119 -- import of C function that gives address of errno
121 foreign import "ghcErrno" unsafe _errno :: Ptr CInt
123 -- Haskell representation for "errno" values
125 newtype Errno = Errno CInt
127 instance Eq Errno where
128 errno1@(Errno no1) == errno2@(Errno no2)
129 | isValidErrno errno1 && isValidErrno errno2 = no1 == no2
132 -- common "errno" symbols
134 eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,
135 eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED,
136 eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT,
137 eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ,
138 eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK,
139 eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH,
140 eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK,
141 eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS,
142 eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTTY, eNXIO,
143 eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL,
144 ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE,
145 eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN,
146 eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT,
147 eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV :: Errno
149 -- the CCONST_XXX identifiers are cpp symbols whose value is computed by
153 e2BIG = Errno (CCONST_E2BIG)
154 eACCES = Errno (CCONST_EACCES)
155 eADDRINUSE = Errno (CCONST_EADDRINUSE)
156 eADDRNOTAVAIL = Errno (CCONST_EADDRNOTAVAIL)
157 eADV = Errno (CCONST_EADV)
158 eAFNOSUPPORT = Errno (CCONST_EAFNOSUPPORT)
159 eAGAIN = Errno (CCONST_EAGAIN)
160 eALREADY = Errno (CCONST_EALREADY)
161 eBADF = Errno (CCONST_EBADF)
162 eBADMSG = Errno (CCONST_EBADMSG)
163 eBADRPC = Errno (CCONST_EBADRPC)
164 eBUSY = Errno (CCONST_EBUSY)
165 eCHILD = Errno (CCONST_ECHILD)
166 eCOMM = Errno (CCONST_ECOMM)
167 eCONNABORTED = Errno (CCONST_ECONNABORTED)
168 eCONNREFUSED = Errno (CCONST_ECONNREFUSED)
169 eCONNRESET = Errno (CCONST_ECONNRESET)
170 eDEADLK = Errno (CCONST_EDEADLK)
171 eDESTADDRREQ = Errno (CCONST_EDESTADDRREQ)
172 eDIRTY = Errno (CCONST_EDIRTY)
173 eDOM = Errno (CCONST_EDOM)
174 eDQUOT = Errno (CCONST_EDQUOT)
175 eEXIST = Errno (CCONST_EEXIST)
176 eFAULT = Errno (CCONST_EFAULT)
177 eFBIG = Errno (CCONST_EFBIG)
178 eFTYPE = Errno (CCONST_EFTYPE)
179 eHOSTDOWN = Errno (CCONST_EHOSTDOWN)
180 eHOSTUNREACH = Errno (CCONST_EHOSTUNREACH)
181 eIDRM = Errno (CCONST_EIDRM)
182 eILSEQ = Errno (CCONST_EILSEQ)
183 eINPROGRESS = Errno (CCONST_EINPROGRESS)
184 eINTR = Errno (CCONST_EINTR)
185 eINVAL = Errno (CCONST_EINVAL)
186 eIO = Errno (CCONST_EIO)
187 eISCONN = Errno (CCONST_EISCONN)
188 eISDIR = Errno (CCONST_EISDIR)
189 eLOOP = Errno (CCONST_ELOOP)
190 eMFILE = Errno (CCONST_EMFILE)
191 eMLINK = Errno (CCONST_EMLINK)
192 eMSGSIZE = Errno (CCONST_EMSGSIZE)
193 eMULTIHOP = Errno (CCONST_EMULTIHOP)
194 eNAMETOOLONG = Errno (CCONST_ENAMETOOLONG)
195 eNETDOWN = Errno (CCONST_ENETDOWN)
196 eNETRESET = Errno (CCONST_ENETRESET)
197 eNETUNREACH = Errno (CCONST_ENETUNREACH)
198 eNFILE = Errno (CCONST_ENFILE)
199 eNOBUFS = Errno (CCONST_ENOBUFS)
200 eNODATA = Errno (CCONST_ENODATA)
201 eNODEV = Errno (CCONST_ENODEV)
202 eNOENT = Errno (CCONST_ENOENT)
203 eNOEXEC = Errno (CCONST_ENOEXEC)
204 eNOLCK = Errno (CCONST_ENOLCK)
205 eNOLINK = Errno (CCONST_ENOLINK)
206 eNOMEM = Errno (CCONST_ENOMEM)
207 eNOMSG = Errno (CCONST_ENOMSG)
208 eNONET = Errno (CCONST_ENONET)
209 eNOPROTOOPT = Errno (CCONST_ENOPROTOOPT)
210 eNOSPC = Errno (CCONST_ENOSPC)
211 eNOSR = Errno (CCONST_ENOSR)
212 eNOSTR = Errno (CCONST_ENOSTR)
213 eNOSYS = Errno (CCONST_ENOSYS)
214 eNOTBLK = Errno (CCONST_ENOTBLK)
215 eNOTCONN = Errno (CCONST_ENOTCONN)
216 eNOTDIR = Errno (CCONST_ENOTDIR)
217 eNOTEMPTY = Errno (CCONST_ENOTEMPTY)
218 eNOTSOCK = Errno (CCONST_ENOTSOCK)
219 eNOTTY = Errno (CCONST_ENOTTY)
220 eNXIO = Errno (CCONST_ENXIO)
221 eOPNOTSUPP = Errno (CCONST_EOPNOTSUPP)
222 ePERM = Errno (CCONST_EPERM)
223 ePFNOSUPPORT = Errno (CCONST_EPFNOSUPPORT)
224 ePIPE = Errno (CCONST_EPIPE)
225 ePROCLIM = Errno (CCONST_EPROCLIM)
226 ePROCUNAVAIL = Errno (CCONST_EPROCUNAVAIL)
227 ePROGMISMATCH = Errno (CCONST_EPROGMISMATCH)
228 ePROGUNAVAIL = Errno (CCONST_EPROGUNAVAIL)
229 ePROTO = Errno (CCONST_EPROTO)
230 ePROTONOSUPPORT = Errno (CCONST_EPROTONOSUPPORT)
231 ePROTOTYPE = Errno (CCONST_EPROTOTYPE)
232 eRANGE = Errno (CCONST_ERANGE)
233 eREMCHG = Errno (CCONST_EREMCHG)
234 eREMOTE = Errno (CCONST_EREMOTE)
235 eROFS = Errno (CCONST_EROFS)
236 eRPCMISMATCH = Errno (CCONST_ERPCMISMATCH)
237 eRREMOTE = Errno (CCONST_ERREMOTE)
238 eSHUTDOWN = Errno (CCONST_ESHUTDOWN)
239 eSOCKTNOSUPPORT = Errno (CCONST_ESOCKTNOSUPPORT)
240 eSPIPE = Errno (CCONST_ESPIPE)
241 eSRCH = Errno (CCONST_ESRCH)
242 eSRMNT = Errno (CCONST_ESRMNT)
243 eSTALE = Errno (CCONST_ESTALE)
244 eTIME = Errno (CCONST_ETIME)
245 eTIMEDOUT = Errno (CCONST_ETIMEDOUT)
246 eTOOMANYREFS = Errno (CCONST_ETOOMANYREFS)
247 eTXTBSY = Errno (CCONST_ETXTBSY)
248 eUSERS = Errno (CCONST_EUSERS)
249 eWOULDBLOCK = Errno (CCONST_EWOULDBLOCK)
250 eXDEV = Errno (CCONST_EXDEV)
252 -- checks whether the given errno value is supported on the current
255 isValidErrno :: Errno -> Bool
257 -- the configure script sets all invalid "errno"s to -1
259 isValidErrno (Errno errno) = errno /= -1
262 -- access to the current thread's "errno" value
263 -- --------------------------------------------
265 -- yield the current thread's "errno" value
268 getErrno = do e <- peek _errno; return (Errno e)
270 -- set the current thread's "errno" value to 0
273 resetErrno = poke _errno 0
276 -- throw current "errno" value
277 -- ---------------------------
279 -- the common case: throw an IO error based on a textual description
280 -- of the error location and the current thread's "errno" value
282 throwErrno :: String -> IO a
286 ioError (errnoToIOError loc errno Nothing Nothing)
289 -- guards for IO operations that may fail
290 -- --------------------------------------
292 -- guard an IO operation and throw an "errno" based exception of the result
293 -- value of the IO operation meets the given predicate
295 throwErrnoIf :: (a -> Bool) -> String -> IO a -> IO a
296 throwErrnoIf pred loc f =
299 if pred res then throwErrno loc else return res
301 -- as `throwErrnoIf', but discards the result
303 throwErrnoIf_ :: (a -> Bool) -> String -> IO a -> IO ()
304 throwErrnoIf_ pred loc f = void $ throwErrnoIf pred loc f
306 -- as `throwErrnoIf', but retries interrupted IO operations (ie, those whose
309 throwErrnoIfRetry :: (a -> Bool) -> String -> IO a -> IO a
310 throwErrnoIfRetry pred loc f =
317 then throwErrnoIfRetry pred loc f
321 -- as `throwErrnoIfRetry', but checks for operations that would block and
322 -- executes an alternative action in that case.
324 throwErrnoIfRetryMayBlock :: (a -> Bool) -> String -> IO a -> IO b -> IO a
325 throwErrnoIfRetryMayBlock pred loc f on_block =
332 then throwErrnoIfRetryMayBlock pred loc f on_block
333 else if err == eWOULDBLOCK || err == eAGAIN
334 then do on_block; throwErrnoIfRetryMayBlock pred loc f on_block
338 -- as `throwErrnoIfRetry', but discards the result
340 throwErrnoIfRetry_ :: (a -> Bool) -> String -> IO a -> IO ()
341 throwErrnoIfRetry_ pred loc f = void $ throwErrnoIfRetry pred loc f
343 -- as `throwErrnoIfRetryMayBlock', but discards the result
345 throwErrnoIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO ()
346 throwErrnoIfRetryMayBlock_ pred loc f on_block
347 = void $ throwErrnoIfRetryMayBlock pred loc f on_block
349 -- throws "errno" if a result of "-1" is returned
351 throwErrnoIfMinus1 :: Num a => String -> IO a -> IO a
352 throwErrnoIfMinus1 = throwErrnoIf (== -1)
354 -- as `throwErrnoIfMinus1', but discards the result
356 throwErrnoIfMinus1_ :: Num a => String -> IO a -> IO ()
357 throwErrnoIfMinus1_ = throwErrnoIf_ (== -1)
359 -- throws "errno" if a result of "-1" is returned, but retries in case of an
360 -- interrupted operation
362 throwErrnoIfMinus1Retry :: Num a => String -> IO a -> IO a
363 throwErrnoIfMinus1Retry = throwErrnoIfRetry (== -1)
365 -- as `throwErrnoIfMinus1', but discards the result
367 throwErrnoIfMinus1Retry_ :: Num a => String -> IO a -> IO ()
368 throwErrnoIfMinus1Retry_ = throwErrnoIfRetry_ (== -1)
370 -- as throwErrnoIfMinus1Retry, but checks for operations that would block
372 throwErrnoIfMinus1RetryMayBlock :: Num a => String -> IO a -> IO b -> IO a
373 throwErrnoIfMinus1RetryMayBlock = throwErrnoIfRetryMayBlock (== -1)
375 -- as `throwErrnoIfMinus1RetryMayBlock', but discards the result
377 throwErrnoIfMinus1RetryMayBlock_ :: Num a => String -> IO a -> IO b -> IO ()
378 throwErrnoIfMinus1RetryMayBlock_ = throwErrnoIfRetryMayBlock_ (== -1)
380 -- throws "errno" if a result of a NULL pointer is returned
382 throwErrnoIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
383 throwErrnoIfNull = throwErrnoIf (== nullPtr)
385 -- throws "errno" if a result of a NULL pointer is returned, but retries in
386 -- case of an interrupted operation
388 throwErrnoIfNullRetry :: String -> IO (Ptr a) -> IO (Ptr a)
389 throwErrnoIfNullRetry = throwErrnoIfRetry (== nullPtr)
391 -- as throwErrnoIfNullRetry, but checks for operations that would block
393 throwErrnoIfNullRetryMayBlock :: String -> IO (Ptr a) -> IO b -> IO (Ptr a)
394 throwErrnoIfNullRetryMayBlock = throwErrnoIfRetryMayBlock (== nullPtr)
396 -- conversion of an "errno" value into IO error
397 -- --------------------------------------------
399 -- convert a location string, an "errno" value, an optional handle,
400 -- and an optional filename into a matching IO error
402 errnoToIOError :: String -> Errno -> Maybe Handle -> Maybe String -> IOError
403 errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
404 str <- strerror errno >>= peekCString
405 #if __GLASGOW_HASKELL__
406 return (IOException (IOError maybeHdl errType loc str maybeName))
409 | errno == eOK = OtherError
410 | errno == e2BIG = ResourceExhausted
411 | errno == eACCES = PermissionDenied
412 | errno == eADDRINUSE = ResourceBusy
413 | errno == eADDRNOTAVAIL = UnsupportedOperation
414 | errno == eADV = OtherError
415 | errno == eAFNOSUPPORT = UnsupportedOperation
416 | errno == eAGAIN = ResourceExhausted
417 | errno == eALREADY = AlreadyExists
418 | errno == eBADF = OtherError
419 | errno == eBADMSG = InappropriateType
420 | errno == eBADRPC = OtherError
421 | errno == eBUSY = ResourceBusy
422 | errno == eCHILD = NoSuchThing
423 | errno == eCOMM = ResourceVanished
424 | errno == eCONNABORTED = OtherError
425 | errno == eCONNREFUSED = NoSuchThing
426 | errno == eCONNRESET = ResourceVanished
427 | errno == eDEADLK = ResourceBusy
428 | errno == eDESTADDRREQ = InvalidArgument
429 | errno == eDIRTY = UnsatisfiedConstraints
430 | errno == eDOM = InvalidArgument
431 | errno == eDQUOT = PermissionDenied
432 | errno == eEXIST = AlreadyExists
433 | errno == eFAULT = OtherError
434 | errno == eFBIG = PermissionDenied
435 | errno == eFTYPE = InappropriateType
436 | errno == eHOSTDOWN = NoSuchThing
437 | errno == eHOSTUNREACH = NoSuchThing
438 | errno == eIDRM = ResourceVanished
439 | errno == eILSEQ = InvalidArgument
440 | errno == eINPROGRESS = AlreadyExists
441 | errno == eINTR = Interrupted
442 | errno == eINVAL = InvalidArgument
443 | errno == eIO = HardwareFault
444 | errno == eISCONN = AlreadyExists
445 | errno == eISDIR = InappropriateType
446 | errno == eLOOP = InvalidArgument
447 | errno == eMFILE = ResourceExhausted
448 | errno == eMLINK = ResourceExhausted
449 | errno == eMSGSIZE = ResourceExhausted
450 | errno == eMULTIHOP = UnsupportedOperation
451 | errno == eNAMETOOLONG = InvalidArgument
452 | errno == eNETDOWN = ResourceVanished
453 | errno == eNETRESET = ResourceVanished
454 | errno == eNETUNREACH = NoSuchThing
455 | errno == eNFILE = ResourceExhausted
456 | errno == eNOBUFS = ResourceExhausted
457 | errno == eNODATA = NoSuchThing
458 | errno == eNODEV = NoSuchThing
459 | errno == eNOENT = NoSuchThing
460 | errno == eNOEXEC = InvalidArgument
461 | errno == eNOLCK = ResourceExhausted
462 | errno == eNOLINK = ResourceVanished
463 | errno == eNOMEM = ResourceExhausted
464 | errno == eNOMSG = NoSuchThing
465 | errno == eNONET = NoSuchThing
466 | errno == eNOPROTOOPT = UnsupportedOperation
467 | errno == eNOSPC = ResourceExhausted
468 | errno == eNOSR = ResourceExhausted
469 | errno == eNOSTR = InvalidArgument
470 | errno == eNOSYS = UnsupportedOperation
471 | errno == eNOTBLK = InvalidArgument
472 | errno == eNOTCONN = InvalidArgument
473 | errno == eNOTDIR = InappropriateType
474 | errno == eNOTEMPTY = UnsatisfiedConstraints
475 | errno == eNOTSOCK = InvalidArgument
476 | errno == eNOTTY = IllegalOperation
477 | errno == eNXIO = NoSuchThing
478 | errno == eOPNOTSUPP = UnsupportedOperation
479 | errno == ePERM = PermissionDenied
480 | errno == ePFNOSUPPORT = UnsupportedOperation
481 | errno == ePIPE = ResourceVanished
482 | errno == ePROCLIM = PermissionDenied
483 | errno == ePROCUNAVAIL = UnsupportedOperation
484 | errno == ePROGMISMATCH = ProtocolError
485 | errno == ePROGUNAVAIL = UnsupportedOperation
486 | errno == ePROTO = ProtocolError
487 | errno == ePROTONOSUPPORT = ProtocolError
488 | errno == ePROTOTYPE = ProtocolError
489 | errno == eRANGE = UnsupportedOperation
490 | errno == eREMCHG = ResourceVanished
491 | errno == eREMOTE = IllegalOperation
492 | errno == eROFS = PermissionDenied
493 | errno == eRPCMISMATCH = ProtocolError
494 | errno == eRREMOTE = IllegalOperation
495 | errno == eSHUTDOWN = IllegalOperation
496 | errno == eSOCKTNOSUPPORT = UnsupportedOperation
497 | errno == eSPIPE = UnsupportedOperation
498 | errno == eSRCH = NoSuchThing
499 | errno == eSRMNT = UnsatisfiedConstraints
500 | errno == eSTALE = ResourceVanished
501 | errno == eTIME = TimeExpired
502 | errno == eTIMEDOUT = TimeExpired
503 | errno == eTOOMANYREFS = ResourceExhausted
504 | errno == eTXTBSY = ResourceBusy
505 | errno == eUSERS = ResourceExhausted
506 | errno == eWOULDBLOCK = OtherError
507 | errno == eXDEV = UnsupportedOperation
508 | otherwise = OtherError
510 return (userError (loc ++ ": " ++ str ++ maybe "" (": "++) maybeName))
513 foreign import unsafe strerror :: Errno -> IO (Ptr CChar)