1{-# LANGUAGE Trustworthy #-}
2{-# LANGUAGE CPP, NoImplicitPrelude #-}
3
4-----------------------------------------------------------------------------
5-- |
6-- Module      :  Foreign.C.Error
7-- Copyright   :  (c) The FFI task force 2001
8-- License     :  BSD-style (see the file libraries/base/LICENSE)
9--
10-- Maintainer  :  ffi@haskell.org
11-- Stability   :  provisional
12-- Portability :  portable
13--
14-- C-specific Marshalling support: Handling of C \"errno\" error codes.
15--
16-----------------------------------------------------------------------------
17
18module Foreign.C.Error (
19
20  -- * Haskell representations of @errno@ values
21
22  Errno(..),
23
24  -- ** Common @errno@ symbols
25  -- | Different operating systems and\/or C libraries often support
26  -- different values of @errno@.  This module defines the common values,
27  -- but due to the open definition of 'Errno' users may add definitions
28  -- which are not predefined.
29  eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,
30  eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED,
31  eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT,
32  eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ,
33  eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK,
34  eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH,
35  eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK,
36  eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS,
37  eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTSUP, eNOTTY, eNXIO,
38  eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL,
39  ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE,
40  eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN,
41  eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT,
42  eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV,
43
44  -- ** 'Errno' functions
45  isValidErrno,
46
47  -- access to the current thread's "errno" value
48  --
49  getErrno,
50  resetErrno,
51
52  -- conversion of an "errno" value into IO error
53  --
54  errnoToIOError,
55
56  -- throw current "errno" value
57  --
58  throwErrno,
59
60  -- ** Guards for IO operations that may fail
61
62  throwErrnoIf,
63  throwErrnoIf_,
64  throwErrnoIfRetry,
65  throwErrnoIfRetry_,
66  throwErrnoIfMinus1,
67  throwErrnoIfMinus1_,
68  throwErrnoIfMinus1Retry,
69  throwErrnoIfMinus1Retry_,
70  throwErrnoIfNull,
71  throwErrnoIfNullRetry,
72
73  throwErrnoIfRetryMayBlock,
74  throwErrnoIfRetryMayBlock_,
75  throwErrnoIfMinus1RetryMayBlock,
76  throwErrnoIfMinus1RetryMayBlock_,
77  throwErrnoIfNullRetryMayBlock,
78
79  throwErrnoPath,
80  throwErrnoPathIf,
81  throwErrnoPathIf_,
82  throwErrnoPathIfNull,
83  throwErrnoPathIfMinus1,
84  throwErrnoPathIfMinus1_,
85) where
86
87
88-- this is were we get the CONST_XXX definitions from that configure
89-- calculated for us
90--
91#include "HsBaseConfig.h"
92
93import Foreign.Ptr
94import Foreign.C.Types
95import Foreign.C.String
96import Data.Functor            ( void )
97import Data.Maybe
98
99import GHC.IO
100import GHC.IO.Exception
101import GHC.IO.Handle.Types
102import GHC.Num
103import GHC.Base
104
105-- "errno" type
106-- ------------
107
108-- | Haskell representation for @errno@ values.
109-- The implementation is deliberately exposed, to allow users to add
110-- their own definitions of 'Errno' values.
111
112newtype Errno = Errno CInt
113
114-- | @since 2.01
115instance Eq Errno where
116  errno1@(Errno no1) == errno2@(Errno no2)
117    | isValidErrno errno1 && isValidErrno errno2 = no1 == no2
118    | otherwise                                  = False
119
120-- common "errno" symbols
121--
122eOK, e2BIG, eACCES, eADDRINUSE, eADDRNOTAVAIL, eADV, eAFNOSUPPORT, eAGAIN,
123  eALREADY, eBADF, eBADMSG, eBADRPC, eBUSY, eCHILD, eCOMM, eCONNABORTED,
124  eCONNREFUSED, eCONNRESET, eDEADLK, eDESTADDRREQ, eDIRTY, eDOM, eDQUOT,
125  eEXIST, eFAULT, eFBIG, eFTYPE, eHOSTDOWN, eHOSTUNREACH, eIDRM, eILSEQ,
126  eINPROGRESS, eINTR, eINVAL, eIO, eISCONN, eISDIR, eLOOP, eMFILE, eMLINK,
127  eMSGSIZE, eMULTIHOP, eNAMETOOLONG, eNETDOWN, eNETRESET, eNETUNREACH,
128  eNFILE, eNOBUFS, eNODATA, eNODEV, eNOENT, eNOEXEC, eNOLCK, eNOLINK,
129  eNOMEM, eNOMSG, eNONET, eNOPROTOOPT, eNOSPC, eNOSR, eNOSTR, eNOSYS,
130  eNOTBLK, eNOTCONN, eNOTDIR, eNOTEMPTY, eNOTSOCK, eNOTSUP, eNOTTY, eNXIO,
131  eOPNOTSUPP, ePERM, ePFNOSUPPORT, ePIPE, ePROCLIM, ePROCUNAVAIL,
132  ePROGMISMATCH, ePROGUNAVAIL, ePROTO, ePROTONOSUPPORT, ePROTOTYPE,
133  eRANGE, eREMCHG, eREMOTE, eROFS, eRPCMISMATCH, eRREMOTE, eSHUTDOWN,
134  eSOCKTNOSUPPORT, eSPIPE, eSRCH, eSRMNT, eSTALE, eTIME, eTIMEDOUT,
135  eTOOMANYREFS, eTXTBSY, eUSERS, eWOULDBLOCK, eXDEV                    :: Errno
136--
137-- the cCONST_XXX identifiers are cpp symbols whose value is computed by
138-- configure
139--
140eOK             = Errno 0
141e2BIG           = Errno (CONST_E2BIG)
142eACCES          = Errno (CONST_EACCES)
143eADDRINUSE      = Errno (CONST_EADDRINUSE)
144eADDRNOTAVAIL   = Errno (CONST_EADDRNOTAVAIL)
145eADV            = Errno (CONST_EADV)
146eAFNOSUPPORT    = Errno (CONST_EAFNOSUPPORT)
147eAGAIN          = Errno (CONST_EAGAIN)
148eALREADY        = Errno (CONST_EALREADY)
149eBADF           = Errno (CONST_EBADF)
150eBADMSG         = Errno (CONST_EBADMSG)
151eBADRPC         = Errno (CONST_EBADRPC)
152eBUSY           = Errno (CONST_EBUSY)
153eCHILD          = Errno (CONST_ECHILD)
154eCOMM           = Errno (CONST_ECOMM)
155eCONNABORTED    = Errno (CONST_ECONNABORTED)
156eCONNREFUSED    = Errno (CONST_ECONNREFUSED)
157eCONNRESET      = Errno (CONST_ECONNRESET)
158eDEADLK         = Errno (CONST_EDEADLK)
159eDESTADDRREQ    = Errno (CONST_EDESTADDRREQ)
160eDIRTY          = Errno (CONST_EDIRTY)
161eDOM            = Errno (CONST_EDOM)
162eDQUOT          = Errno (CONST_EDQUOT)
163eEXIST          = Errno (CONST_EEXIST)
164eFAULT          = Errno (CONST_EFAULT)
165eFBIG           = Errno (CONST_EFBIG)
166eFTYPE          = Errno (CONST_EFTYPE)
167eHOSTDOWN       = Errno (CONST_EHOSTDOWN)
168eHOSTUNREACH    = Errno (CONST_EHOSTUNREACH)
169eIDRM           = Errno (CONST_EIDRM)
170eILSEQ          = Errno (CONST_EILSEQ)
171eINPROGRESS     = Errno (CONST_EINPROGRESS)
172eINTR           = Errno (CONST_EINTR)
173eINVAL          = Errno (CONST_EINVAL)
174eIO             = Errno (CONST_EIO)
175eISCONN         = Errno (CONST_EISCONN)
176eISDIR          = Errno (CONST_EISDIR)
177eLOOP           = Errno (CONST_ELOOP)
178eMFILE          = Errno (CONST_EMFILE)
179eMLINK          = Errno (CONST_EMLINK)
180eMSGSIZE        = Errno (CONST_EMSGSIZE)
181eMULTIHOP       = Errno (CONST_EMULTIHOP)
182eNAMETOOLONG    = Errno (CONST_ENAMETOOLONG)
183eNETDOWN        = Errno (CONST_ENETDOWN)
184eNETRESET       = Errno (CONST_ENETRESET)
185eNETUNREACH     = Errno (CONST_ENETUNREACH)
186eNFILE          = Errno (CONST_ENFILE)
187eNOBUFS         = Errno (CONST_ENOBUFS)
188eNODATA         = Errno (CONST_ENODATA)
189eNODEV          = Errno (CONST_ENODEV)
190eNOENT          = Errno (CONST_ENOENT)
191eNOEXEC         = Errno (CONST_ENOEXEC)
192eNOLCK          = Errno (CONST_ENOLCK)
193eNOLINK         = Errno (CONST_ENOLINK)
194eNOMEM          = Errno (CONST_ENOMEM)
195eNOMSG          = Errno (CONST_ENOMSG)
196eNONET          = Errno (CONST_ENONET)
197eNOPROTOOPT     = Errno (CONST_ENOPROTOOPT)
198eNOSPC          = Errno (CONST_ENOSPC)
199eNOSR           = Errno (CONST_ENOSR)
200eNOSTR          = Errno (CONST_ENOSTR)
201eNOSYS          = Errno (CONST_ENOSYS)
202eNOTBLK         = Errno (CONST_ENOTBLK)
203eNOTCONN        = Errno (CONST_ENOTCONN)
204eNOTDIR         = Errno (CONST_ENOTDIR)
205eNOTEMPTY       = Errno (CONST_ENOTEMPTY)
206eNOTSOCK        = Errno (CONST_ENOTSOCK)
207eNOTSUP         = Errno (CONST_ENOTSUP)
208-- ^ @since 4.7.0.0
209eNOTTY          = Errno (CONST_ENOTTY)
210eNXIO           = Errno (CONST_ENXIO)
211eOPNOTSUPP      = Errno (CONST_EOPNOTSUPP)
212ePERM           = Errno (CONST_EPERM)
213ePFNOSUPPORT    = Errno (CONST_EPFNOSUPPORT)
214ePIPE           = Errno (CONST_EPIPE)
215ePROCLIM        = Errno (CONST_EPROCLIM)
216ePROCUNAVAIL    = Errno (CONST_EPROCUNAVAIL)
217ePROGMISMATCH   = Errno (CONST_EPROGMISMATCH)
218ePROGUNAVAIL    = Errno (CONST_EPROGUNAVAIL)
219ePROTO          = Errno (CONST_EPROTO)
220ePROTONOSUPPORT = Errno (CONST_EPROTONOSUPPORT)
221ePROTOTYPE      = Errno (CONST_EPROTOTYPE)
222eRANGE          = Errno (CONST_ERANGE)
223eREMCHG         = Errno (CONST_EREMCHG)
224eREMOTE         = Errno (CONST_EREMOTE)
225eROFS           = Errno (CONST_EROFS)
226eRPCMISMATCH    = Errno (CONST_ERPCMISMATCH)
227eRREMOTE        = Errno (CONST_ERREMOTE)
228eSHUTDOWN       = Errno (CONST_ESHUTDOWN)
229eSOCKTNOSUPPORT = Errno (CONST_ESOCKTNOSUPPORT)
230eSPIPE          = Errno (CONST_ESPIPE)
231eSRCH           = Errno (CONST_ESRCH)
232eSRMNT          = Errno (CONST_ESRMNT)
233eSTALE          = Errno (CONST_ESTALE)
234eTIME           = Errno (CONST_ETIME)
235eTIMEDOUT       = Errno (CONST_ETIMEDOUT)
236eTOOMANYREFS    = Errno (CONST_ETOOMANYREFS)
237eTXTBSY         = Errno (CONST_ETXTBSY)
238eUSERS          = Errno (CONST_EUSERS)
239eWOULDBLOCK     = Errno (CONST_EWOULDBLOCK)
240eXDEV           = Errno (CONST_EXDEV)
241
242-- | Yield 'True' if the given 'Errno' value is valid on the system.
243-- This implies that the 'Eq' instance of 'Errno' is also system dependent
244-- as it is only defined for valid values of 'Errno'.
245--
246isValidErrno               :: Errno -> Bool
247--
248-- the configure script sets all invalid "errno"s to -1
249--
250isValidErrno (Errno errno)  = errno /= -1
251
252
253-- access to the current thread's "errno" value
254-- --------------------------------------------
255
256-- | Get the current value of @errno@ in the current thread.
257--
258-- On GHC, the runtime will ensure that any Haskell thread will only see "its own"
259-- @errno@, by saving and restoring the value when Haskell threads are scheduled
260-- across OS threads.
261getErrno :: IO Errno
262
263-- We must call a C function to get the value of errno in general.  On
264-- threaded systems, errno is hidden behind a C macro so that each OS
265-- thread gets its own copy (`saved_errno`, which `rts/Schedule.c` restores
266-- back into the thread-local `errno` when a Haskell thread is rescheduled).
267getErrno = do e <- get_errno; return (Errno e)
268foreign import ccall unsafe "HsBase.h __hscore_get_errno" get_errno :: IO CInt
269
270-- | Reset the current thread\'s @errno@ value to 'eOK'.
271--
272resetErrno :: IO ()
273
274-- Again, setting errno has to be done via a C function.
275resetErrno = set_errno 0
276foreign import ccall unsafe "HsBase.h __hscore_set_errno" set_errno :: CInt -> IO ()
277
278-- throw current "errno" value
279-- ---------------------------
280
281-- | Throw an 'IOError' corresponding to the current value of 'getErrno'.
282--
283throwErrno     :: String        -- ^ textual description of the error location
284               -> IO a
285throwErrno loc  =
286  do
287    errno <- getErrno
288    ioError (errnoToIOError loc errno Nothing Nothing)
289
290
291-- guards for IO operations that may fail
292-- --------------------------------------
293
294-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
295-- if the result value of the 'IO' action meets the given predicate.
296--
297throwErrnoIf    :: (a -> Bool)  -- ^ predicate to apply to the result value
298                                -- of the 'IO' operation
299                -> String       -- ^ textual description of the location
300                -> IO a         -- ^ the 'IO' operation to be executed
301                -> IO a
302throwErrnoIf pred loc f  =
303  do
304    res <- f
305    if pred res then throwErrno loc else return res
306
307-- | as 'throwErrnoIf', but discards the result of the 'IO' action after
308-- error handling.
309--
310throwErrnoIf_   :: (a -> Bool) -> String -> IO a -> IO ()
311throwErrnoIf_ pred loc f  = void $ throwErrnoIf pred loc f
312
313-- | as 'throwErrnoIf', but retry the 'IO' action when it yields the
314-- error code 'eINTR' - this amounts to the standard retry loop for
315-- interrupted POSIX system calls.
316--
317throwErrnoIfRetry            :: (a -> Bool) -> String -> IO a -> IO a
318throwErrnoIfRetry pred loc f  =
319  do
320    res <- f
321    if pred res
322      then do
323        err <- getErrno
324        if err == eINTR
325          then throwErrnoIfRetry pred loc f
326          else throwErrno loc
327      else return res
328
329-- | as 'throwErrnoIfRetry', but additionally if the operation
330-- yields the error code 'eAGAIN' or 'eWOULDBLOCK', an alternative
331-- action is executed before retrying.
332--
333throwErrnoIfRetryMayBlock
334                :: (a -> Bool)  -- ^ predicate to apply to the result value
335                                -- of the 'IO' operation
336                -> String       -- ^ textual description of the location
337                -> IO a         -- ^ the 'IO' operation to be executed
338                -> IO b         -- ^ action to execute before retrying if
339                                -- an immediate retry would block
340                -> IO a
341throwErrnoIfRetryMayBlock pred loc f on_block  =
342  do
343    res <- f
344    if pred res
345      then do
346        err <- getErrno
347        if err == eINTR
348          then throwErrnoIfRetryMayBlock pred loc f on_block
349          else if err == eWOULDBLOCK || err == eAGAIN
350                 then do _ <- on_block
351                         throwErrnoIfRetryMayBlock pred loc f on_block
352                 else throwErrno loc
353      else return res
354
355-- | as 'throwErrnoIfRetry', but discards the result.
356--
357throwErrnoIfRetry_            :: (a -> Bool) -> String -> IO a -> IO ()
358throwErrnoIfRetry_ pred loc f  = void $ throwErrnoIfRetry pred loc f
359
360-- | as 'throwErrnoIfRetryMayBlock', but discards the result.
361--
362throwErrnoIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO ()
363throwErrnoIfRetryMayBlock_ pred loc f on_block
364  = void $ throwErrnoIfRetryMayBlock pred loc f on_block
365
366-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
367-- if the 'IO' action returns a result of @-1@.
368--
369throwErrnoIfMinus1 :: (Eq a, Num a) => String -> IO a -> IO a
370throwErrnoIfMinus1  = throwErrnoIf (== -1)
371
372-- | as 'throwErrnoIfMinus1', but discards the result.
373--
374throwErrnoIfMinus1_ :: (Eq a, Num a) => String -> IO a -> IO ()
375throwErrnoIfMinus1_  = throwErrnoIf_ (== -1)
376
377-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
378-- if the 'IO' action returns a result of @-1@, but retries in case of
379-- an interrupted operation.
380--
381throwErrnoIfMinus1Retry :: (Eq a, Num a) => String -> IO a -> IO a
382throwErrnoIfMinus1Retry  = throwErrnoIfRetry (== -1)
383
384-- | as 'throwErrnoIfMinus1', but discards the result.
385--
386throwErrnoIfMinus1Retry_ :: (Eq a, Num a) => String -> IO a -> IO ()
387throwErrnoIfMinus1Retry_  = throwErrnoIfRetry_ (== -1)
388
389-- | as 'throwErrnoIfMinus1Retry', but checks for operations that would block.
390--
391throwErrnoIfMinus1RetryMayBlock :: (Eq a, Num a)
392                                => String -> IO a -> IO b -> IO a
393throwErrnoIfMinus1RetryMayBlock  = throwErrnoIfRetryMayBlock (== -1)
394
395-- | as 'throwErrnoIfMinus1RetryMayBlock', but discards the result.
396--
397throwErrnoIfMinus1RetryMayBlock_ :: (Eq a, Num a)
398                                 => String -> IO a -> IO b -> IO ()
399throwErrnoIfMinus1RetryMayBlock_  = throwErrnoIfRetryMayBlock_ (== -1)
400
401-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
402-- if the 'IO' action returns 'nullPtr'.
403--
404throwErrnoIfNull :: String -> IO (Ptr a) -> IO (Ptr a)
405throwErrnoIfNull  = throwErrnoIf (== nullPtr)
406
407-- | Throw an 'IOError' corresponding to the current value of 'getErrno'
408-- if the 'IO' action returns 'nullPtr',
409-- but retry in case of an interrupted operation.
410--
411throwErrnoIfNullRetry :: String -> IO (Ptr a) -> IO (Ptr a)
412throwErrnoIfNullRetry  = throwErrnoIfRetry (== nullPtr)
413
414-- | as 'throwErrnoIfNullRetry', but checks for operations that would block.
415--
416throwErrnoIfNullRetryMayBlock :: String -> IO (Ptr a) -> IO b -> IO (Ptr a)
417throwErrnoIfNullRetryMayBlock  = throwErrnoIfRetryMayBlock (== nullPtr)
418
419-- | as 'throwErrno', but exceptions include the given path when appropriate.
420--
421throwErrnoPath :: String -> FilePath -> IO a
422throwErrnoPath loc path =
423  do
424    errno <- getErrno
425    ioError (errnoToIOError loc errno Nothing (Just path))
426
427-- | as 'throwErrnoIf', but exceptions include the given path when
428--   appropriate.
429--
430throwErrnoPathIf :: (a -> Bool) -> String -> FilePath -> IO a -> IO a
431throwErrnoPathIf pred loc path f =
432  do
433    res <- f
434    if pred res then throwErrnoPath loc path else return res
435
436-- | as 'throwErrnoIf_', but exceptions include the given path when
437--   appropriate.
438--
439throwErrnoPathIf_ :: (a -> Bool) -> String -> FilePath -> IO a -> IO ()
440throwErrnoPathIf_ pred loc path f  = void $ throwErrnoPathIf pred loc path f
441
442-- | as 'throwErrnoIfNull', but exceptions include the given path when
443--   appropriate.
444--
445throwErrnoPathIfNull :: String -> FilePath -> IO (Ptr a) -> IO (Ptr a)
446throwErrnoPathIfNull  = throwErrnoPathIf (== nullPtr)
447
448-- | as 'throwErrnoIfMinus1', but exceptions include the given path when
449--   appropriate.
450--
451throwErrnoPathIfMinus1 :: (Eq a, Num a) => String -> FilePath -> IO a -> IO a
452throwErrnoPathIfMinus1 = throwErrnoPathIf (== -1)
453
454-- | as 'throwErrnoIfMinus1_', but exceptions include the given path when
455--   appropriate.
456--
457throwErrnoPathIfMinus1_ :: (Eq a, Num a) => String -> FilePath -> IO a -> IO ()
458throwErrnoPathIfMinus1_  = throwErrnoPathIf_ (== -1)
459
460-- conversion of an "errno" value into IO error
461-- --------------------------------------------
462
463-- | Construct an 'IOError' based on the given 'Errno' value.
464-- The optional information can be used to improve the accuracy of
465-- error messages.
466--
467errnoToIOError  :: String       -- ^ the location where the error occurred
468                -> Errno        -- ^ the error number
469                -> Maybe Handle -- ^ optional handle associated with the error
470                -> Maybe String -- ^ optional filename associated with the error
471                -> IOError
472errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
473    str <- strerror errno >>= peekCString
474    return (IOError maybeHdl errType loc str (Just errno') maybeName)
475    where
476    Errno errno' = errno
477    errType
478        | errno == eOK             = OtherError
479        | errno == e2BIG           = ResourceExhausted
480        | errno == eACCES          = PermissionDenied
481        | errno == eADDRINUSE      = ResourceBusy
482        | errno == eADDRNOTAVAIL   = UnsupportedOperation
483        | errno == eADV            = OtherError
484        | errno == eAFNOSUPPORT    = UnsupportedOperation
485        | errno == eAGAIN          = ResourceExhausted
486        | errno == eALREADY        = AlreadyExists
487        | errno == eBADF           = InvalidArgument
488        | errno == eBADMSG         = InappropriateType
489        | errno == eBADRPC         = OtherError
490        | errno == eBUSY           = ResourceBusy
491        | errno == eCHILD          = NoSuchThing
492        | errno == eCOMM           = ResourceVanished
493        | errno == eCONNABORTED    = OtherError
494        | errno == eCONNREFUSED    = NoSuchThing
495        | errno == eCONNRESET      = ResourceVanished
496        | errno == eDEADLK         = ResourceBusy
497        | errno == eDESTADDRREQ    = InvalidArgument
498        | errno == eDIRTY          = UnsatisfiedConstraints
499        | errno == eDOM            = InvalidArgument
500        | errno == eDQUOT          = PermissionDenied
501        | errno == eEXIST          = AlreadyExists
502        | errno == eFAULT          = OtherError
503        | errno == eFBIG           = PermissionDenied
504        | errno == eFTYPE          = InappropriateType
505        | errno == eHOSTDOWN       = NoSuchThing
506        | errno == eHOSTUNREACH    = NoSuchThing
507        | errno == eIDRM           = ResourceVanished
508        | errno == eILSEQ          = InvalidArgument
509        | errno == eINPROGRESS     = AlreadyExists
510        | errno == eINTR           = Interrupted
511        | errno == eINVAL          = InvalidArgument
512        | errno == eIO             = HardwareFault
513        | errno == eISCONN         = AlreadyExists
514        | errno == eISDIR          = InappropriateType
515        | errno == eLOOP           = InvalidArgument
516        | errno == eMFILE          = ResourceExhausted
517        | errno == eMLINK          = ResourceExhausted
518        | errno == eMSGSIZE        = ResourceExhausted
519        | errno == eMULTIHOP       = UnsupportedOperation
520        | errno == eNAMETOOLONG    = InvalidArgument
521        | errno == eNETDOWN        = ResourceVanished
522        | errno == eNETRESET       = ResourceVanished
523        | errno == eNETUNREACH     = NoSuchThing
524        | errno == eNFILE          = ResourceExhausted
525        | errno == eNOBUFS         = ResourceExhausted
526        | errno == eNODATA         = NoSuchThing
527        | errno == eNODEV          = UnsupportedOperation
528        | errno == eNOENT          = NoSuchThing
529        | errno == eNOEXEC         = InvalidArgument
530        | errno == eNOLCK          = ResourceExhausted
531        | errno == eNOLINK         = ResourceVanished
532        | errno == eNOMEM          = ResourceExhausted
533        | errno == eNOMSG          = NoSuchThing
534        | errno == eNONET          = NoSuchThing
535        | errno == eNOPROTOOPT     = UnsupportedOperation
536        | errno == eNOSPC          = ResourceExhausted
537        | errno == eNOSR           = ResourceExhausted
538        | errno == eNOSTR          = InvalidArgument
539        | errno == eNOSYS          = UnsupportedOperation
540        | errno == eNOTBLK         = InvalidArgument
541        | errno == eNOTCONN        = InvalidArgument
542        | errno == eNOTDIR         = InappropriateType
543        | errno == eNOTEMPTY       = UnsatisfiedConstraints
544        | errno == eNOTSOCK        = InvalidArgument
545        | errno == eNOTTY          = IllegalOperation
546        | errno == eNXIO           = NoSuchThing
547        | errno == eOPNOTSUPP      = UnsupportedOperation
548        | errno == ePERM           = PermissionDenied
549        | errno == ePFNOSUPPORT    = UnsupportedOperation
550        | errno == ePIPE           = ResourceVanished
551        | errno == ePROCLIM        = PermissionDenied
552        | errno == ePROCUNAVAIL    = UnsupportedOperation
553        | errno == ePROGMISMATCH   = ProtocolError
554        | errno == ePROGUNAVAIL    = UnsupportedOperation
555        | errno == ePROTO          = ProtocolError
556        | errno == ePROTONOSUPPORT = ProtocolError
557        | errno == ePROTOTYPE      = ProtocolError
558        | errno == eRANGE          = UnsupportedOperation
559        | errno == eREMCHG         = ResourceVanished
560        | errno == eREMOTE         = IllegalOperation
561        | errno == eROFS           = PermissionDenied
562        | errno == eRPCMISMATCH    = ProtocolError
563        | errno == eRREMOTE        = IllegalOperation
564        | errno == eSHUTDOWN       = IllegalOperation
565        | errno == eSOCKTNOSUPPORT = UnsupportedOperation
566        | errno == eSPIPE          = UnsupportedOperation
567        | errno == eSRCH           = NoSuchThing
568        | errno == eSRMNT          = UnsatisfiedConstraints
569        | errno == eSTALE          = ResourceVanished
570        | errno == eTIME           = TimeExpired
571        | errno == eTIMEDOUT       = TimeExpired
572        | errno == eTOOMANYREFS    = ResourceExhausted
573        | errno == eTXTBSY         = ResourceBusy
574        | errno == eUSERS          = ResourceExhausted
575        | errno == eWOULDBLOCK     = OtherError
576        | errno == eXDEV           = UnsupportedOperation
577        | otherwise                = OtherError
578
579foreign import ccall unsafe "string.h" strerror :: Errno -> IO (Ptr CChar)
580
581