← Back to branch summary

~ubuntu-branches/ubuntu/precise/ghc/precise

« back to all changes in this revision

Viewing changes to libraries/base/Foreign/C/Error.hs

  • Committer: Bazaar Package Importer
  • Author(s): Joachim Breitner
  • Date: 2011-01-17 12:49:24 UTC
  • Revision ID: james.westby@ubuntu.com-20110117124924-do1pym1jlf5o636m
Tags: upstream-7.0.1
Import upstream version 7.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
libraries/base/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 additionally 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)