[project @ 2003-06-24 09:40:51 by stolz]

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

diff --git a/GHC/Handle.hs b/GHC/Handle.hs
index 4381de0..13a051b 100644 (file)
--- a/GHC/Handle.hs
+++ b/GHC/Handle.hs
@@ -34,7 +34,7 @@ module GHC.Handle (
   ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
 
   stdin, stdout, stderr,
-  IOMode(..), IOModeEx(..), openFile, openFileEx, openFd, fdToHandle,
+  IOMode(..), openFile, openBinaryFile, openFd, fdToHandle,
   hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
   hFlush, hDuplicate, hDuplicateTo,
 
@@ -60,8 +60,8 @@ import Data.Maybe
 import Foreign
 import Foreign.C
 import System.IO.Error
+import System.Posix.Internals
 
-import GHC.Posix
 import GHC.Real
 
 import GHC.Arr
@@ -319,9 +319,14 @@ stdHandleFinalizer m = do
 
 handleFinalizer :: MVar Handle__ -> IO ()
 handleFinalizer m = do
-  h_ <- takeMVar m
-  hClose_help h_
-  return ()
+  handle_ <- takeMVar m
+  case haType handle_ of 
+      ClosedHandle -> return ()
+      _ -> do flushWriteBufferOnly handle_ `catchException` \_ -> return ()
+               -- ignore errors and async exceptions, and close the
+               -- descriptor anyway...
+             hClose_handle_ handle_
+             return ()
 
 -- ---------------------------------------------------------------------------
 -- Grimy buffer operations
@@ -634,38 +639,25 @@ Two files are the same if they have the same absolute name.  An
 implementation is free to impose stricter conditions.
 -}
 
-data IOModeEx 
- = BinaryMode IOMode
- | TextMode   IOMode
-   deriving (Eq, Read, Show)
-
 addFilePathToIOError fun fp (IOError h iot _ str _)
   = IOError h iot fun str (Just fp)
 
 openFile :: FilePath -> IOMode -> IO Handle
 openFile fp im = 
   catch 
-    (openFile' fp (if   dEFAULT_OPEN_IN_BINARY_MODE 
-                   then BinaryMode im
-                   else TextMode im))
+    (openFile' fp im dEFAULT_OPEN_IN_BINARY_MODE)
     (\e -> ioError (addFilePathToIOError "openFile" fp e))
 
-openFileEx :: FilePath -> IOModeEx -> IO Handle
-openFileEx fp m =
+openBinaryFile :: FilePath -> IOMode -> IO Handle
+openBinaryFile fp m =
   catch
-    (openFile' fp m)
-    (\e -> ioError (addFilePathToIOError "openFileEx" fp e))
+    (openFile' fp m True)
+    (\e -> ioError (addFilePathToIOError "openBinaryFile" fp e))
 
-
-openFile' filepath ex_mode =
+openFile' filepath mode binary =
   withCString filepath $ \ f ->
 
     let 
-      (mode, binary) =
-       case ex_mode of
-           BinaryMode bmo -> (bmo, True)
-          TextMode   tmo -> (tmo, False)
-
       oflags1 = case mode of
                  ReadMode      -> read_flags  
                  WriteMode     -> write_flags 
@@ -856,37 +848,38 @@ hClose_help :: Handle__ -> IO Handle__
 hClose_help handle_ =
   case haType handle_ of 
       ClosedHandle -> return handle_
-      _ -> do
-         let fd = haFD handle_
-             c_fd = fromIntegral fd
-
-         flushWriteBufferOnly handle_
-
-         -- close the file descriptor, but not when this is the read
-         -- side of a duplex handle, and not when this is one of the
-         -- std file handles.
-         case haOtherSide handle_ of
-           Nothing -> 
-               when (fd /= fd_stdin && fd /= fd_stdout && fd /= fd_stderr) $
-                       throwErrnoIfMinus1Retry_ "hClose" 
+      _ -> do flushWriteBufferOnly handle_ -- interruptible
+             hClose_handle_ handle_
+
+hClose_handle_ handle_ = do
+    let fd = haFD handle_
+        c_fd = fromIntegral fd
+
+    -- close the file descriptor, but not when this is the read
+    -- side of a duplex handle, and not when this is one of the
+    -- std file handles.
+    case haOtherSide handle_ of
+      Nothing -> 
+         when (fd /= fd_stdin && fd /= fd_stdout && fd /= fd_stderr) $
+                 throwErrnoIfMinus1Retry_ "hClose" 
 #ifdef mingw32_TARGET_OS
                                (closeFd (haIsStream handle_) c_fd)
 #else
                                (c_close c_fd)
 #endif
-           Just _  -> return ()
-
-         -- free the spare buffers
-         writeIORef (haBuffers handle_) BufferListNil
-
-         -- unlock it
-         unlockFile c_fd
+      Just _  -> return ()
 
-         -- we must set the fd to -1, because the finalizer is going
-         -- to run eventually and try to close/unlock it.
-         return (handle_{ haFD        = -1, 
-                          haType      = ClosedHandle
-                        })
+    -- free the spare buffers
+    writeIORef (haBuffers handle_) BufferListNil
+  
+    -- unlock it
+    unlockFile c_fd
+  
+    -- we must set the fd to -1, because the finalizer is going
+    -- to run eventually and try to close/unlock it.
+    return (handle_{ haFD        = -1, 
+                    haType      = ClosedHandle
+                  })
 
 -----------------------------------------------------------------------------
 -- Detecting the size of a file
@@ -1242,10 +1235,9 @@ hIsSeekable handle =
                                                || tEXT_MODE_SEEK_ALLOWED))
 
 -- -----------------------------------------------------------------------------
--- Changing echo status
+-- Changing echo status (Non-standard GHC extensions)
 
--- Non-standard GHC extension is to allow the echoing status
--- of a handles connected to terminals to be reconfigured:
+-- | Set the echoing status of a handle connected to a terminal (GHC only).
 
 hSetEcho :: Handle -> Bool -> IO ()
 hSetEcho handle on = do
@@ -1258,6 +1250,8 @@ hSetEcho handle on = do
          ClosedHandle -> ioe_closedHandle
          _            -> setEcho (haFD handle_) on
 
+-- | Get the echoing status of a handle connected to a terminal (GHC only).
+
 hGetEcho :: Handle -> IO Bool
 hGetEcho handle = do
     isT   <- hIsTerminalDevice handle
@@ -1269,6 +1263,8 @@ hGetEcho handle = do
          ClosedHandle -> ioe_closedHandle
          _            -> getEcho (haFD handle_)
 
+-- | Is the handle connected to a terminal? (GHC only)
+
 hIsTerminalDevice :: Handle -> IO Bool
 hIsTerminalDevice handle = do
     withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do