[project @ 2002-08-30 14:54:58 by simonpj]
[ghc-base.git] / GHC / Handle.hs
index c29c6c9..43ef3d4 100644 (file)
@@ -3,12 +3,19 @@
 #undef DEBUG_DUMP
 #undef DEBUG
 
--- -----------------------------------------------------------------------------
--- $Id: Handle.hs,v 1.6 2002/03/26 17:06:32 simonmar Exp $
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  GHC.Handle
+-- Copyright   :  (c) The University of Glasgow, 1994-2001
+-- License     :  see libraries/base/LICENSE
+-- 
+-- Maintainer  :  libraries@haskell.org
+-- Stability   :  internal
+-- Portability :  non-portable
 --
--- (c) The University of Glasgow, 1994-2001
+-- This module defines the basic operations on I\/O \"handles\".
 --
--- This module defines the basic operations on I/O "handles".
+-----------------------------------------------------------------------------
 
 module GHC.Handle (
   withHandle, withHandle', withHandle_,
@@ -17,12 +24,12 @@ module GHC.Handle (
   newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
   flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, fillReadBuffer,
   read_off,  read_off_ba,
-  write_off, write_off_ba,
+  write_off, write_off_ba, unlockFile,
 
   ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
 
   stdin, stdout, stderr,
-  IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
+  IOMode(..), IOModeEx(..), openFile, openFileEx, openFd, fdToHandle,
   hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
   hFlush, 
 
@@ -299,16 +306,23 @@ stdHandleFinalizer m = do
 handleFinalizer :: MVar Handle__ -> IO ()
 handleFinalizer m = do
   h_ <- takeMVar m
-  flushWriteBufferOnly h_
-  let fd = fromIntegral (haFD h_)
-  unlockFile fd
-  when (fd /= -1) 
+  let
+    -- hClose puts both the fd and the handle's type
+    -- into a closed state, so it's a bit excessive
+    -- to test for both here, but caution sometimes
+    -- pays off..
+   alreadyClosed = 
+     case haType h_ of { ClosedHandle{} -> True; _ -> False }
+   fd = fromIntegral (haFD h_)
+
+  when (not alreadyClosed && fd /= -1) $ do
+       flushWriteBufferOnly h_
+       unlockFile fd
 #ifdef mingw32_TARGET_OS
        (closeFd (haIsStream h_) fd >> return ())
 #else
        (c_close fd >> return ())
 #endif
-  return ()
 
 -- ---------------------------------------------------------------------------
 -- Grimy buffer operations
@@ -541,9 +555,6 @@ Two files are the same if they have the same absolute name.  An
 implementation is free to impose stricter conditions.
 -}
 
-data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
-                    deriving (Eq, Ord, Ix, Enum, Read, Show)
-
 data IOModeEx 
  = BinaryMode IOMode
  | TextMode   IOMode
@@ -660,6 +671,12 @@ openFd fd mb_fd_type filepath mode binary truncate = do
           mkFileHandle fd is_stream filepath ha_type binary
 
 
+fdToHandle :: FD -> IO Handle
+fdToHandle fd = do
+   mode <- fdGetMode fd
+   let fd_str = "<file descriptor: " ++ show fd ++ ">"
+   openFd fd Nothing fd_str mode True{-bin mode-} False{-no truncate-}
+
 foreign import ccall unsafe "lockFile"
   lockFile :: CInt -> CInt -> CInt -> IO CInt
 
@@ -1181,6 +1198,14 @@ hIsTerminalDevice handle = do
 -- -----------------------------------------------------------------------------
 -- hSetBinaryMode
 
+-- | On Windows, reading a file in text mode (which is the default) will
+-- translate CRLF to LF, and writing will translate LF to CRLF. This
+-- is usually what you want with text files. With binary files this is
+-- undesirable; also, as usual under Microsoft operating systems, text
+-- mode treats control-Z as EOF.  Setting binary mode using
+-- 'hSetBinaryMode' turns off all special treatment of end-of-line and
+-- end-of-file characters.
+--
 hSetBinaryMode :: Handle -> Bool -> IO ()
 hSetBinaryMode handle bin =
   withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->