Add errno to the IOError type

diff --git a/Foreign/C/Error.hs b/Foreign/C/Error.hs
index 950a7a4..7c48180 100644 (file)
--- a/Foreign/C/Error.hs
+++ b/Foreign/C/Error.hs
@@ -498,8 +498,9 @@ errnoToIOError  :: String       -- ^ the location where the error occurred
 errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
     str <- strerror errno >>= peekCString
 #if __GLASGOW_HASKELL__
-    return (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

diff --git a/Foreign/Marshal/Alloc.hs b/Foreign/Marshal/Alloc.hs
index 9fd576d..282791a 100644 (file)
--- a/Foreign/Marshal/Alloc.hs
+++ b/Foreign/Marshal/Alloc.hs
@@ -178,7 +178,10 @@ failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
 failWhenNULL name f = do
    addr <- f
    if addr == nullPtr
-#if __GLASGOW_HASKELL__ || __HUGS__
+#if __GLASGOW_HASKELL__
+      then ioError (IOError Nothing ResourceExhausted name 
+                                        "out of memory" Nothing Nothing)
+#elif __HUGS__
       then ioError (IOError Nothing ResourceExhausted name 
                                         "out of memory" Nothing)
 #else

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index 97b7f88..6255a79 100644 (file)
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -187,8 +187,8 @@ withHandle__' fun h m act =
    return ()
 
 augmentIOError :: IOException -> String -> Handle -> IOException
-augmentIOError (IOError _ iot _ str fp) fun h
-  = IOError (Just h) iot fun str filepath
+augmentIOError ioe@IOError{ ioe_filename = fp } fun h
+  = ioe { ioe_handle = Just h, ioe_location = fun, ioe_filename = filepath }
   where filepath
           | Just _ <- fp = fp
           | otherwise = case h of
@@ -267,7 +267,7 @@ checkReadableHandle act handle_ =
 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
   ioException (IOError (Just h) IllegalOperation fun
-                   "handle is not seekable" Nothing)
+                   "handle is not seekable" Nothing Nothing)
 wantSeekableHandle fun h@(FileHandle _ m) act =
   withHandle_' fun h m (checkSeekableHandle act)
 
@@ -289,32 +289,32 @@ ioe_closedHandle, ioe_EOF,
 
 ioe_closedHandle = ioException
    (IOError Nothing IllegalOperation ""
-        "handle is closed" Nothing)
+        "handle is closed" Nothing Nothing)
 ioe_EOF = ioException
-   (IOError Nothing EOF "" "" Nothing)
+   (IOError Nothing EOF "" "" Nothing Nothing)
 ioe_notReadable = ioException
    (IOError Nothing IllegalOperation ""
-        "handle is not open for reading" Nothing)
+        "handle is not open for reading" Nothing Nothing)
 ioe_notWritable = ioException
    (IOError Nothing IllegalOperation ""
-        "handle is not open for writing" Nothing)
+        "handle is not open for writing" Nothing Nothing)
 ioe_notSeekable = ioException
    (IOError Nothing IllegalOperation ""
-        "handle is not seekable" Nothing)
+        "handle is not seekable" Nothing Nothing)
 ioe_notSeekable_notBin = ioException
    (IOError Nothing IllegalOperation ""
       "seek operations on text-mode handles are not allowed on this platform"
-        Nothing)
+        Nothing Nothing)
 
 ioe_finalizedHandle :: FilePath -> Handle__
 ioe_finalizedHandle fp = throw
    (IOError Nothing IllegalOperation ""
-        "handle is finalized" (Just fp))
+        "handle is finalized" Nothing (Just fp))
 
 ioe_bufsiz :: Int -> IO a
 ioe_bufsiz n = ioException
    (IOError Nothing InvalidArgument "hSetBuffering"
-        ("illegal buffer size " ++ showsPrec 9 n []) Nothing)
+        ("illegal buffer size " ++ showsPrec 9 n []) Nothing Nothing)
                                 -- 9 => should be parens'ified.
 
 -- -----------------------------------------------------------------------------
@@ -843,8 +843,8 @@ stderr = unsafePerformIO $ do
 -- Opening and Closing Files
 
 addFilePathToIOError :: String -> FilePath -> IOException -> IOException
-addFilePathToIOError fun fp (IOError h iot _ str _)
-  = IOError h iot fun str (Just fp)
+addFilePathToIOError fun fp ioe
+  = ioe{ ioe_location = fun, ioe_filename = Just fp }
 
 -- | Computation 'openFile' @file mode@ allocates and returns a new, open
 -- handle to manage the file @file@.  It manages input if @mode@
@@ -994,7 +994,7 @@ fdToHandle_stat fd mb_stat is_socket filepath mode binary = do
     case fd_type of
         Directory -> 
            ioException (IOError Nothing InappropriateType "openFile"
-                           "is a directory" Nothing) 
+                           "is a directory" Nothing Nothing) 
 
         -- regular files need to be locked
         RegularFile -> do
@@ -1005,7 +1005,7 @@ fdToHandle_stat fd mb_stat is_socket filepath mode binary = do
            r <- lockFile fd dev ino (fromBool write)
            when (r == -1)  $
                 ioException (IOError Nothing ResourceBusy "openFile"
-                                   "file is locked" Nothing)
+                                   "file is locked" Nothing Nothing)
 #endif
            mkFileHandle fd is_socket filepath ha_type binary
 
@@ -1232,7 +1232,7 @@ hFileSize handle =
               if r /= -1
                  then return r
                  else ioException (IOError Nothing InappropriateType "hFileSize"
-                                   "not a regular file" Nothing)
+                                   "not a regular file" Nothing Nothing)
 
 
 -- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.
@@ -1746,7 +1746,7 @@ hDuplicateTo h1@(DuplexHandle _ r1 w1) h2@(DuplexHandle _ r2 w2)  = do
    withHandle' "hDuplicateTo" h1 r1 (dupHandleTo (Just w1) r2_)
 hDuplicateTo h1 _ =
    ioException (IOError (Just h1) IllegalOperation "hDuplicateTo" 
-                "handles are incompatible" Nothing)
+                "handles are incompatible" Nothing Nothing)
 
 -- ---------------------------------------------------------------------------
 -- showing Handles.

diff --git a/GHC/IO.hs b/GHC/IO.hs
index e73b592..a17714f 100644 (file)
--- a/GHC/IO.hs
+++ b/GHC/IO.hs
@@ -341,7 +341,7 @@ lazyRead handle =
           SemiClosedHandle -> lazyRead' handle handle_
           _ -> ioException 
                   (IOError (Just handle) IllegalOperation "lazyRead"
-                        "illegal handle type" Nothing)
+                        "illegal handle type" Nothing Nothing)
 
 lazyRead' :: Handle -> Handle__ -> IO (Handle__, [Char])
 lazyRead' h handle_ = do
@@ -971,4 +971,4 @@ illegalBufferSize handle fn sz =
         ioException (IOError (Just handle)
                             InvalidArgument  fn
                             ("illegal buffer size " ++ showsPrec 9 sz [])
-                            Nothing)
+                            Nothing Nothing)

diff --git a/GHC/IOBase.lhs b/GHC/IOBase.lhs
index c15d6c7..48a0950 100644 (file)
--- a/GHC/IOBase.lhs
+++ b/GHC/IOBase.lhs
@@ -787,6 +787,7 @@ data IOException
      ioe_type     :: IOErrorType,    -- what it was.
      ioe_location :: String,         -- location.
      ioe_description :: String,      -- error type specific information.
+     ioe_errno    :: Maybe CInt,     -- errno leading to this error, if any.
      ioe_filename :: Maybe FilePath  -- filename the error is related to.
    }
     deriving Typeable
@@ -794,8 +795,8 @@ data IOException
 instance Exception IOException
 
 instance Eq IOException where
-  (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) = 
-    e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2
+  (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) = 
+    e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2
 
 -- | An abstract type that contains a value for each variant of 'IOError'.
 data IOErrorType
@@ -857,13 +858,13 @@ instance Show IOErrorType where
 -- >   fail s = ioError (userError s)
 --
 userError       :: String  -> IOError
-userError str   =  IOError Nothing UserError "" str Nothing
+userError str   =  IOError Nothing UserError "" str Nothing Nothing
 
 -- ---------------------------------------------------------------------------
 -- Showing IOErrors
 
 instance Show IOException where
-    showsPrec p (IOError hdl iot loc s fn) =
+    showsPrec p (IOError hdl iot loc s _ fn) =
       (case fn of
          Nothing -> case hdl of
                         Nothing -> id

diff --git a/System/Environment.hs b/System/Environment.hs
index 4b32987..c734158 100644 (file)
--- a/System/Environment.hs
+++ b/System/Environment.hs
@@ -123,7 +123,7 @@ getEnv name =
       if litstring /= nullPtr
         then peekCString litstring
         else ioException (IOError Nothing NoSuchThing "getEnv"
-                          "no environment variable" (Just name))
+                          "no environment variable" Nothing (Just name))
 
 foreign import ccall unsafe "getenv"
    c_getenv :: CString -> IO (Ptr CChar)

diff --git a/System/Exit.hs b/System/Exit.hs
index e211ca5..f4fbac5 100644 (file)
--- a/System/Exit.hs
+++ b/System/Exit.hs
@@ -64,7 +64,7 @@ exitWith ExitSuccess = throwIO ExitSuccess
 exitWith code@(ExitFailure n)
   | n /= 0 = throwIO code
 #ifdef __GLASGOW_HASKELL__
-  | otherwise = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing)
+  | otherwise = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing Nothing)
 #endif
 #endif  /* ! __NHC__ */
 

diff --git a/System/IO/Error.hs b/System/IO/Error.hs
index 0313d7b..fcbffad 100644 (file)
--- a/System/IO/Error.hs
+++ b/System/IO/Error.hs
@@ -155,6 +155,9 @@ mkIOError t location maybe_hdl maybe_filename =
                IOError{ ioe_type = t, 
                         ioe_location = location,
                         ioe_description = "",
+#if defined(__GLASGOW_HASKELL__)
+                        ioe_errno = Nothing,
+#endif
                         ioe_handle = maybe_hdl, 
                         ioe_filename = maybe_filename
                         }
@@ -370,8 +373,9 @@ annotateIOError :: IOError
               -> Maybe Handle 
               -> Maybe FilePath 
               -> IOError 
-annotateIOError (IOError ohdl errTy _ str opath) loc hdl path = 
-  IOError (hdl `mplus` ohdl) errTy loc str (path `mplus` opath)
+annotateIOError ioe loc hdl path = 
+  ioe{ ioe_handle = hdl `mplus` ioe_handle ioe,
+       ioe_location = loc, ioe_filename = path `mplus` ioe_filename ioe }
   where
     Nothing `mplus` ys = ys
     xs      `mplus` _  = xs

diff --git a/System/Posix/Internals.hs b/System/Posix/Internals.hs
index 1a9f845..ebd9ec9 100644 (file)
--- a/System/Posix/Internals.hs
+++ b/System/Posix/Internals.hs
@@ -129,7 +129,11 @@ statGetType p_stat = do
     
 ioe_unknownfiletype :: IOException
 ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType"
-                        "unknown file type" Nothing
+                        "unknown file type"
+#if __GLASGOW_HASKELL__
+                        Nothing
+#endif
+                        Nothing
 
 #if __GLASGOW_HASKELL__ && (defined(mingw32_HOST_OS) || defined(__MINGW32__))
 closeFd :: Bool -> CInt -> IO CInt