[project @ 2003-02-17 15:13:56 by simonpj]

[ghc-base.git] / GHC / Handle.hs

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index 13ceee1..6760b1f 100644 (file)
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -47,6 +47,8 @@ module GHC.Handle (
 
  ) where
 
+#include "config.h"
+
 import Control.Monad
 import Data.Bits
 import Data.Maybe
@@ -132,7 +134,10 @@ withHandle' fun h m act =
    h_ <- takeMVar m
    checkBufferInvariants h_
    (h',v)  <- catchException (act h_) 
-               (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
+               (\ err -> putMVar m h_ >>
+                         case err of
+                             IOException ex -> ioError (augmentIOError ex fun h h_)
+                             _ -> throw err)
    checkBufferInvariants h'
    putMVar m h'
    return v
@@ -147,7 +152,10 @@ withHandle_' fun h m act =
    h_ <- takeMVar m
    checkBufferInvariants h_
    v  <- catchException (act h_) 
-           (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
+               (\ err -> putMVar m h_ >>
+                         case err of
+                             IOException ex -> ioError (augmentIOError ex fun h h_)
+                             _ -> throw err)
    checkBufferInvariants h_
    putMVar m h_
    return v
@@ -163,17 +171,18 @@ withHandle__' fun h m act =
    h_ <- takeMVar m
    checkBufferInvariants h_
    h'  <- catchException (act h_)
-           (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
+               (\ err -> putMVar m h_ >>
+                         case err of
+                             IOException ex -> ioError (augmentIOError ex fun h h_)
+                             _ -> throw err)
    checkBufferInvariants h'
    putMVar m h'
    return ()
 
-augmentIOError (IOException (IOError _ iot _ str fp)) fun h h_
-  = IOException (IOError (Just h) iot fun str filepath)
+augmentIOError (IOError _ iot _ str fp) fun h h_
+  = IOError (Just h) iot fun str filepath
   where filepath | Just _ <- fp = fp
                 | otherwise    = Just (haFilePath h_)
-augmentIOError other_exception _ _ _
-  = other_exception
 
 -- ---------------------------------------------------------------------------
 -- Wrapper for write operations.
@@ -560,10 +569,8 @@ data IOModeEx
  | TextMode   IOMode
    deriving (Eq, Read, Show)
 
-addFilePathToIOError fun fp (IOException (IOError h iot _ str _))
-  = IOException (IOError h iot fun str (Just fp))
-addFilePathToIOError _   _  other_exception
-  = other_exception
+addFilePathToIOError fun fp (IOError h iot _ str _)
+  = IOError h iot fun str (Just fp)
 
 openFile :: FilePath -> IOMode -> IO Handle
 openFile fp im = 
@@ -571,13 +578,13 @@ openFile fp im =
     (openFile' fp (if   dEFAULT_OPEN_IN_BINARY_MODE 
                    then BinaryMode im
                    else TextMode im))
-    (\e -> throw (addFilePathToIOError "openFile" fp e))
+    (\e -> ioError (addFilePathToIOError "openFile" fp e))
 
 openFileEx :: FilePath -> IOModeEx -> IO Handle
 openFileEx fp m =
   catch
     (openFile' fp m)
-    (\e -> throw (addFilePathToIOError "openFileEx" fp e))
+    (\e -> ioError (addFilePathToIOError "openFileEx" fp e))
 
 
 openFile' filepath ex_mode =
@@ -843,7 +850,7 @@ hIsEOF :: Handle -> IO Bool
 hIsEOF handle =
   catch
      (do hLookAhead handle; return False)
-     (\e -> if isEOFError e then return True else throw e)
+     (\e -> if isEOFError e then return True else ioError e)
 
 isEOF :: IO Bool
 isEOF = hIsEOF stdin
@@ -934,7 +941,11 @@ hSetBuffering handle mode =
          is_tty <- fdIsTTY (haFD handle_)
          when (is_tty && isReadableHandleType (haType handle_)) $
                case mode of
+#ifndef mingw32_TARGET_OS
+       -- 'raw' mode under win32 is a bit too specialised (and troublesome
+       -- for most common uses), so simply disable its use here.
                  NoBuffering -> setCooked (haFD handle_) False
+#endif
                  _           -> setCooked (haFD handle_) True
 
          -- throw away spare buffers, they might be the wrong size