[project @ 2004-08-13 13:29:00 by simonmar]
[ghc.git] / libraries / base / GHC / Handle.hs
index 260074d..901a4ae 100644 (file)
@@ -22,37 +22,36 @@ module GHC.Handle (
   wantWritableHandle, wantReadableHandle, wantSeekableHandle,
   
   newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
-  flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, fillReadBuffer,
+  flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, 
+  fillReadBuffer, fillReadBufferWithoutBlocking,
   readRawBuffer, readRawBufferPtr,
   writeRawBuffer, writeRawBufferPtr,
   unlockFile,
   
-  {- ought to be unnecessary, but just in case.. -}
-  write_off, write_rawBuffer,
-  read_off,  read_rawBuffer,
-
   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,
 
   hClose, hClose_help,
 
-  HandlePosn(..), hGetPosn, hSetPosn,
+  HandlePosition, HandlePosn(..), hGetPosn, hSetPosn,
   SeekMode(..), hSeek, hTell,
 
   hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
   hSetEcho, hGetEcho, hIsTerminalDevice,
 
+  hShow,
+
 #ifdef DEBUG_DUMP
   puts,
 #endif
 
  ) where
 
-#include "config.h"
+#include "ghcconfig.h"
 
 import Control.Monad
 import Data.Bits
@@ -60,8 +59,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
@@ -96,11 +95,11 @@ dEFAULT_OPEN_IN_BINARY_MODE = False :: Bool
 -- ---------------------------------------------------------------------------
 -- Creating a new handle
 
-newFileHandle     :: (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle
-newFileHandle finalizer hc = do 
+newFileHandle :: FilePath -> (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle
+newFileHandle filepath finalizer hc = do 
   m <- newMVar hc
   addMVarFinalizer m (finalizer m)
-  return (FileHandle m)
+  return (FileHandle filepath m)
 
 -- ---------------------------------------------------------------------------
 -- Working with Handles
@@ -129,8 +128,8 @@ but we might want to revisit this in the future --SDM ].
 
 {-# INLINE withHandle #-}
 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
-withHandle fun h@(FileHandle m)     act = withHandle' fun h m act
-withHandle fun h@(DuplexHandle m _) act = withHandle' fun h m act
+withHandle fun h@(FileHandle m)     act = withHandle' fun h m act
+withHandle fun h@(DuplexHandle m _) act = withHandle' fun h m act
 
 withHandle' :: String -> Handle -> MVar Handle__
    -> (Handle__ -> IO (Handle__,a)) -> IO a
@@ -141,16 +140,16 @@ withHandle' fun h m act =
    (h',v)  <- catchException (act h_) 
                (\ err -> putMVar m h_ >>
                          case err of
-                             IOException ex -> ioError (augmentIOError ex fun h h_)
-                             _ -> throw err)
+                            IOException ex -> ioError (augmentIOError ex fun h)
+                            _ -> throw err)
    checkBufferInvariants h'
    putMVar m h'
    return v
 
 {-# INLINE withHandle_ #-}
 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
-withHandle_ fun h@(FileHandle m)     act = withHandle_' fun h m act
-withHandle_ fun h@(DuplexHandle m _) act = withHandle_' fun h m act
+withHandle_ fun h@(FileHandle m)     act = withHandle_' fun h m act
+withHandle_ fun h@(DuplexHandle m _) act = withHandle_' fun h m act
 
 withHandle_' fun h m act = 
    block $ do
@@ -159,15 +158,15 @@ withHandle_' fun h m act =
    v  <- catchException (act h_) 
                (\ err -> putMVar m h_ >>
                          case err of
-                             IOException ex -> ioError (augmentIOError ex fun h h_)
-                             _ -> throw err)
+                            IOException ex -> ioError (augmentIOError ex fun h)
+                            _ -> throw err)
    checkBufferInvariants h_
    putMVar m h_
    return v
 
 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
-withAllHandles__ fun h@(FileHandle m)     act = withHandle__' fun h m act
-withAllHandles__ fun h@(DuplexHandle r w) act = do
+withAllHandles__ fun h@(FileHandle m)     act = withHandle__' fun h m act
+withAllHandles__ fun h@(DuplexHandle r w) act = do
   withHandle__' fun h r act
   withHandle__' fun h w act
 
@@ -178,24 +177,27 @@ withHandle__' fun h m act =
    h'  <- catchException (act h_)
                (\ err -> putMVar m h_ >>
                          case err of
-                             IOException ex -> ioError (augmentIOError ex fun h h_)
-                             _ -> throw err)
+                            IOException ex -> ioError (augmentIOError ex fun h)
+                            _ -> throw err)
    checkBufferInvariants h'
    putMVar m h'
    return ()
 
-augmentIOError (IOError _ iot _ str fp) fun h h_
+augmentIOError (IOError _ iot _ str fp) fun h
   = IOError (Just h) iot fun str filepath
-  where filepath | Just _ <- fp = fp
-                | otherwise    = Just (haFilePath h_)
+  where filepath
+         | Just _ <- fp = fp
+         | otherwise = case h of
+                         FileHandle fp _     -> Just fp
+                         DuplexHandle fp _ _ -> Just fp
 
 -- ---------------------------------------------------------------------------
 -- Wrapper for write operations.
 
 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
-wantWritableHandle fun h@(FileHandle m) act
+wantWritableHandle fun h@(FileHandle m) act
   = wantWritableHandle' fun h m act
-wantWritableHandle fun h@(DuplexHandle _ m) act
+wantWritableHandle fun h@(DuplexHandle _ m) act
   = wantWritableHandle' fun h m act
   -- ToDo: in the Duplex case, we don't need to checkWritableHandle
 
@@ -226,9 +228,9 @@ checkWritableHandle act handle_
 -- Wrapper for read operations.
 
 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
-wantReadableHandle fun h@(FileHandle   m)   act
+wantReadableHandle fun h@(FileHandle  _ m)   act
   = wantReadableHandle' fun h m act
-wantReadableHandle fun h@(DuplexHandle m _) act
+wantReadableHandle fun h@(DuplexHandle m _) act
   = wantReadableHandle' fun h m act
   -- ToDo: in the Duplex case, we don't need to checkReadableHandle
 
@@ -257,10 +259,10 @@ checkReadableHandle act handle_ =
 -- Wrapper for seek operations.
 
 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
-wantSeekableHandle fun h@(DuplexHandle _ _) _act =
+wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
   ioException (IOError (Just h) IllegalOperation fun 
                   "handle is not seekable" Nothing)
-wantSeekableHandle fun h@(FileHandle m) act =
+wantSeekableHandle fun h@(FileHandle m) act =
   withHandle_' fun h m (checkSeekableHandle act)
   
 checkSeekableHandle act handle_ = 
@@ -319,24 +321,14 @@ stdHandleFinalizer m = do
 
 handleFinalizer :: MVar Handle__ -> IO ()
 handleFinalizer m = do
-  h_ <- takeMVar m
-  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
+  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
@@ -446,7 +438,8 @@ flushReadBuffer fd buf
      return buf{ bufWPtr=0, bufRPtr=0 }
 
 flushWriteBuffer :: FD -> Bool -> Buffer -> IO Buffer
-flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w }  = do
+flushWriteBuffer fd is_stream buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w }  =
+  seq fd $ do -- strictness hack
   let bytes = w - r
 #ifdef DEBUG_DUMP
   puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")
@@ -497,90 +490,185 @@ fillReadBufferLoop fd is_line is_stream buf b w size = do
             else return buf{ bufRPtr=0, bufWPtr=w+res' }
  
 
+fillReadBufferWithoutBlocking :: FD -> Bool -> Buffer -> IO Buffer
+fillReadBufferWithoutBlocking fd is_stream
+      buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
+  -- buffer better be empty:
+  assert (r == 0 && w == 0) $ do
+#ifdef DEBUG_DUMP
+  puts ("fillReadBufferLoopNoBlock: bytes = " ++ show bytes ++ "\n")
+#endif
+  res <- readRawBufferNoBlock "fillReadBuffer" fd is_stream b
+                      0 (fromIntegral size)
+  let res' = fromIntegral res
+#ifdef DEBUG_DUMP
+  puts ("fillReadBufferLoopNoBlock:  res' = " ++ show res' ++ "\n")
+#endif
+  return buf{ bufRPtr=0, bufWPtr=res' }
 -- Low level routines for reading/writing to (raw)buffers:
 
 #ifndef mingw32_TARGET_OS
 readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 readRawBuffer loc fd is_stream buf off len = 
   throwErrnoIfMinus1RetryMayBlock loc
-           (read_rawBuffer fd is_stream buf off len)
+           (read_rawBuffer fd buf off len)
            (threadWaitRead fd)
 
+readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
+readRawBufferNoBlock loc fd is_stream buf off len = 
+  throwErrnoIfMinus1RetryOnBlock loc
+           (read_rawBuffer fd buf off len)
+           (return 0)
+
 readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
 readRawBufferPtr loc fd is_stream buf off len = 
   throwErrnoIfMinus1RetryMayBlock loc
-           (read_off fd is_stream buf off len)
+           (read_off fd buf off len)
            (threadWaitRead fd)
 
 writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
 writeRawBuffer loc fd is_stream buf off len = 
   throwErrnoIfMinus1RetryMayBlock loc
-               (write_rawBuffer (fromIntegral fd) is_stream buf off len)
+               (write_rawBuffer (fromIntegral fd) buf off len)
                (threadWaitWrite fd)
 
 writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
 writeRawBufferPtr loc fd is_stream buf off len = 
   throwErrnoIfMinus1RetryMayBlock loc
-               (write_off (fromIntegral fd) is_stream buf off len)
+               (write_off (fromIntegral fd) buf off len)
                (threadWaitWrite fd)
 
 foreign import ccall unsafe "__hscore_PrelHandle_read"
-   read_rawBuffer :: FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
+   read_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt
 
 foreign import ccall unsafe "__hscore_PrelHandle_read"
-   read_off :: FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
+   read_off :: FD -> Ptr CChar -> Int -> CInt -> IO CInt
 
 foreign import ccall unsafe "__hscore_PrelHandle_write"
-   write_rawBuffer :: CInt -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
+   write_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
 
 foreign import ccall unsafe "__hscore_PrelHandle_write"
-   write_off :: CInt -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
+   write_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt
+
+#else /* mingw32_TARGET_OS.... */
 
-#else
 readRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
-readRawBuffer loc fd is_stream buf off len = do
-  (l, rc) <- asyncReadBA fd (if is_stream then 1 else 0) (fromIntegral len) off buf
-  if l == (-1)
-   then 
-    ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
-    else return (fromIntegral l)
+readRawBuffer loc fd is_stream buf off len
+  | threaded  = blockingReadRawBuffer loc fd is_stream buf off len
+  | otherwise = asyncReadRawBuffer loc fd is_stream buf off len
 
 readRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
-readRawBufferPtr loc fd is_stream buf off len = do
-  (l, rc) <- asyncRead fd (if is_stream then 1 else 0) (fromIntegral len) (buf `plusPtr` off)
-  if l == (-1)
-   then 
-    ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
-    else return (fromIntegral l)
+readRawBufferPtr loc fd is_stream buf off len
+  | threaded  = blockingReadRawBufferPtr loc fd is_stream buf off len
+  | otherwise = asyncReadRawBufferPtr loc fd is_stream buf off len
 
 writeRawBuffer :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
-writeRawBuffer loc fd is_stream buf off len = do
-  (l, rc) <- asyncWriteBA fd (if is_stream then 1 else 0) (fromIntegral len) off buf
-  if l == (-1)
-   then 
-    ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
-    else return (fromIntegral l)
+writeRawBuffer loc fd is_stream buf off len
+  | threaded =  blockingWriteRawBuffer loc fd is_stream buf off len
+  | otherwise = asyncWriteRawBuffer    loc fd is_stream buf off len
 
 writeRawBufferPtr :: String -> FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
-writeRawBufferPtr loc fd is_stream buf off len = do
-  (l, rc) <- asyncWrite fd (if is_stream then 1 else 0) (fromIntegral len) (buf `plusPtr` off)
-  if l == (-1)
-   then 
-    ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
-    else return (fromIntegral l)
-
-foreign import ccall unsafe "__hscore_PrelHandle_read"
-   read_rawBuffer :: FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
-
-foreign import ccall unsafe "__hscore_PrelHandle_read"
-   read_off :: FD -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
-
-foreign import ccall unsafe "__hscore_PrelHandle_write"
-   write_rawBuffer :: CInt -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
-
-foreign import ccall unsafe "__hscore_PrelHandle_write"
-   write_off :: CInt -> Bool -> Ptr CChar -> Int -> CInt -> IO CInt
-
+writeRawBufferPtr loc fd is_stream buf off len
+  | threaded  = blockingWriteRawBufferPtr loc fd is_stream buf off len
+  | otherwise = asyncWriteRawBufferPtr    loc fd is_stream buf off len
+
+-- ToDo: we don't have a non-blocking primitve read on Win32
+readRawBufferNoBlock :: String -> FD -> Bool -> RawBuffer -> Int -> CInt -> IO CInt
+readRawBufferNoBlock = readRawBufferNoBlock
+
+-- Async versions of the read/write primitives, for the non-threaded RTS
+
+asyncReadRawBuffer loc fd is_stream buf off len = do
+    (l, rc) <- asyncReadBA fd (if is_stream then 1 else 0) 
+                (fromIntegral len) off buf
+    if l == (-1)
+      then 
+       ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
+      else return (fromIntegral l)
+
+asyncReadRawBufferPtr loc fd is_stream buf off len = do
+    (l, rc) <- asyncRead fd (if is_stream then 1 else 0) 
+                       (fromIntegral len) (buf `plusPtr` off)
+    if l == (-1)
+      then 
+        ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
+      else return (fromIntegral l)
+
+asyncWriteRawBuffer loc fd is_stream buf off len = do
+    (l, rc) <- asyncWriteBA fd (if is_stream then 1 else 0) 
+                       (fromIntegral len) off buf
+    if l == (-1)
+      then 
+        ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
+      else return (fromIntegral l)
+
+asyncWriteRawBufferPtr loc fd is_stream buf off len = do
+    (l, rc) <- asyncWrite fd (if is_stream then 1 else 0) 
+                 (fromIntegral len) (buf `plusPtr` off)
+    if l == (-1)
+      then 
+        ioError (errnoToIOError loc (Errno (fromIntegral rc)) Nothing Nothing)
+      else return (fromIntegral l)
+
+-- Blocking versions of the read/write primitives, for the threaded RTS
+
+blockingReadRawBuffer loc fd True buf off len = 
+  throwErrnoIfMinus1Retry loc $
+    recv_rawBuffer fd buf off len
+blockingReadRawBuffer loc fd False buf off len = 
+  throwErrnoIfMinus1Retry loc $
+    read_rawBuffer fd buf off len
+
+blockingReadRawBufferPtr loc fd True buf off len = 
+  throwErrnoIfMinus1Retry loc $
+    recv_off fd buf off len
+blockingReadRawBufferPtr loc fd False buf off len = 
+  throwErrnoIfMinus1Retry loc $
+    read_off fd buf off len
+
+blockingWriteRawBuffer loc fd True buf off len = 
+  throwErrnoIfMinus1Retry loc $
+    send_rawBuffer (fromIntegral fd) buf off len
+blockingWriteRawBuffer loc fd False buf off len = 
+  throwErrnoIfMinus1Retry loc $
+    write_rawBuffer (fromIntegral fd) buf off len
+
+blockingWriteRawBufferPtr loc fd True buf off len = 
+  throwErrnoIfMinus1Retry loc $
+    send_off (fromIntegral fd) buf off len
+blockingWriteRawBufferPtr loc fd False buf off len = 
+  throwErrnoIfMinus1Retry loc $
+    write_off (fromIntegral fd) buf off len
+
+-- NOTE: "safe" versions of the read/write calls for use by the threaded RTS.
+-- These calls may block, but that's ok.
+
+foreign import ccall safe "__hscore_PrelHandle_read"
+   read_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt
+
+foreign import ccall safe "__hscore_PrelHandle_read"
+   read_off :: FD -> Ptr CChar -> Int -> CInt -> IO CInt
+
+foreign import ccall safe "__hscore_PrelHandle_write"
+   write_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
+
+foreign import ccall safe "__hscore_PrelHandle_write"
+   write_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt
+
+foreign import ccall safe "__hscore_PrelHandle_recv"
+   recv_rawBuffer :: FD -> RawBuffer -> Int -> CInt -> IO CInt
+
+foreign import ccall safe "__hscore_PrelHandle_recv"
+   recv_off :: FD -> Ptr CChar -> Int -> CInt -> IO CInt
+
+foreign import ccall safe "__hscore_PrelHandle_send"
+   send_rawBuffer :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
+
+foreign import ccall safe "__hscore_PrelHandle_send"
+   send_off :: CInt -> Ptr CChar -> Int -> CInt -> IO CInt
+
+foreign import ccall "rtsSupportsBoundThreads" threaded :: Bool
 #endif
 
 -- ---------------------------------------------------------------------------
@@ -595,6 +683,7 @@ fd_stdin  = 0 :: FD
 fd_stdout = 1 :: FD
 fd_stderr = 2 :: FD
 
+-- | A handle managing input from the Haskell program's standard input channel.
 stdin :: Handle
 stdin = unsafePerformIO $ do
    -- ToDo: acquire lock
@@ -602,6 +691,7 @@ stdin = unsafePerformIO $ do
    (buf, bmode) <- getBuffer fd_stdin ReadBuffer
    mkStdHandle fd_stdin "<stdin>" ReadHandle buf bmode
 
+-- | A handle managing output to the Haskell program's standard output channel.
 stdout :: Handle
 stdout = unsafePerformIO $ do
    -- ToDo: acquire lock
@@ -611,6 +701,7 @@ stdout = unsafePerformIO $ do
    (buf, bmode) <- getBuffer fd_stdout WriteBuffer
    mkStdHandle fd_stdout "<stdout>" WriteHandle buf bmode
 
+-- | A handle managing output to the Haskell program's standard error channel.
 stderr :: Handle
 stderr = unsafePerformIO $ do
     -- ToDo: acquire lock
@@ -623,64 +714,58 @@ stderr = unsafePerformIO $ do
 -- ---------------------------------------------------------------------------
 -- Opening and Closing Files
 
-{-
-Computation `openFile file mode' allocates and returns a new, open
-handle to manage the file `file'.  It manages input if `mode'
-is `ReadMode', output if `mode' is `WriteMode' or `AppendMode',
-and both input and output if mode is `ReadWriteMode'.
-
-If the file does not exist and it is opened for output, it should be
-created as a new file.  If `mode' is `WriteMode' and the file
-already exists, then it should be truncated to zero length.  The
-handle is positioned at the end of the file if `mode' is
-`AppendMode', and otherwise at the beginning (in which case its
-internal position is 0).
-
-Implementations should enforce, locally to the Haskell process,
-multiple-reader single-writer locking on files, which is to say that
-there may either be many handles on the same file which manage input,
-or just one handle on the file which manages output.  If any open or
-semi-closed handle is managing a file for output, no new handle can be
-allocated for that file.  If any open or semi-closed handle is
-managing a file for input, new handles can only be allocated if they
-do not manage output.
-
-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)
 
+-- | Computation 'openFile' @file mode@ allocates and returns a new, open
+-- handle to manage the file @file@.  It manages input if @mode@
+-- is 'ReadMode', output if @mode@ is 'WriteMode' or 'AppendMode',
+-- and both input and output if mode is 'ReadWriteMode'.
+--
+-- If the file does not exist and it is opened for output, it should be
+-- created as a new file.  If @mode@ is 'WriteMode' and the file
+-- already exists, then it should be truncated to zero length.
+-- Some operating systems delete empty files, so there is no guarantee
+-- that the file will exist following an 'openFile' with @mode@
+-- 'WriteMode' unless it is subsequently written to successfully.
+-- The handle is positioned at the end of the file if @mode@ is
+-- 'AppendMode', and otherwise at the beginning (in which case its
+-- internal position is 0).
+-- The initial buffer mode is implementation-dependent.
+--
+-- This operation may fail with:
+--
+--  * 'isAlreadyInUseError' if the file is already open and cannot be reopened;
+--
+--  * 'isDoesNotExistError' if the file does not exist; or
+--
+--  * 'isPermissionError' if the user does not have permission to open the file.
+
 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 =
+-- | Like 'openFile', but open the file in binary mode.
+-- 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.  Binary mode turns off all special
+-- treatment of end-of-line and end-of-file characters.
+-- (See also 'hSetBinaryMode'.)
+
+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 
@@ -706,7 +791,10 @@ openFile' filepath ex_mode =
              throwErrnoIfMinus1Retry "openFile"
                (c_open f (fromIntegral oflags) 0o666)
 
-    openFd fd Nothing filepath mode binary truncate
+    openFd fd Nothing False filepath mode binary truncate
+       `catchException` \e -> do c_close (fromIntegral fd); throw e
+       -- NB. don't forget to close the FD if openFd fails, otherwise
+       -- this FD leaks.
        -- ASSERT: if we just created the file, then openFd won't fail
        -- (so we don't need to worry about removing the newly created file
        --  in the event of an error).
@@ -722,8 +810,8 @@ append_flags = write_flags  .|. o_APPEND
 -- ---------------------------------------------------------------------------
 -- openFd
 
-openFd :: FD -> Maybe FDType -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
-openFd fd mb_fd_type filepath mode binary truncate = do
+openFd :: FD -> Maybe FDType -> Bool -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
+openFd fd mb_fd_type is_socket filepath mode binary truncate = do
     -- turn on non-blocking mode
     setNonBlockingFD fd
 
@@ -740,15 +828,15 @@ openFd fd mb_fd_type filepath mode binary truncate = do
       case mb_fd_type of
         Just x  -> return x
        Nothing -> fdType fd
-    let is_stream = fd_type == Stream
+
     case fd_type of
        Directory -> 
           ioException (IOError Nothing InappropriateType "openFile"
                           "is a directory" Nothing) 
 
        Stream
-          | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_stream filepath binary
-          | otherwise                  -> mkFileHandle fd is_stream filepath ha_type binary
+          | ReadWriteHandle <- ha_type -> mkDuplexHandle fd is_socket filepath binary
+          | otherwise                  -> mkFileHandle fd is_socket filepath ha_type binary
 
        -- regular files need to be locked
        RegularFile -> do
@@ -760,14 +848,14 @@ openFd fd mb_fd_type filepath mode binary truncate = do
           -- truncate the file if necessary
           when truncate (fileTruncate filepath)
 
-          mkFileHandle fd is_stream filepath ha_type binary
+          mkFileHandle fd is_socket 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-}
+   openFd fd Nothing False{-XXX!-} fd_str mode True{-bin mode-} False{-no truncate-}
 
 foreign import ccall unsafe "lockFile"
   lockFile :: CInt -> CInt -> CInt -> IO CInt
@@ -779,13 +867,12 @@ mkStdHandle :: FD -> FilePath -> HandleType -> IORef Buffer -> BufferMode
        -> IO Handle
 mkStdHandle fd filepath ha_type buf bmode = do
    spares <- newIORef BufferListNil
-   newFileHandle stdHandleFinalizer
+   newFileHandle filepath stdHandleFinalizer
            (Handle__ { haFD = fd,
                        haType = ha_type,
                         haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
                        haIsStream = False,
                        haBufferMode = bmode,
-                       haFilePath = filepath,
                        haBuffer = buf,
                        haBuffers = spares,
                        haOtherSide = Nothing
@@ -795,13 +882,12 @@ mkFileHandle :: FD -> Bool -> FilePath -> HandleType -> Bool -> IO Handle
 mkFileHandle fd is_stream filepath ha_type binary = do
   (buf, bmode) <- getBuffer fd (initBufferState ha_type)
   spares <- newIORef BufferListNil
-  newFileHandle handleFinalizer
+  newFileHandle filepath handleFinalizer
            (Handle__ { haFD = fd,
                        haType = ha_type,
                         haIsBin = binary,
                        haIsStream = is_stream,
                        haBufferMode = bmode,
-                       haFilePath = filepath,
                        haBuffer = buf,
                        haBuffers = spares,
                        haOtherSide = Nothing
@@ -817,7 +903,6 @@ mkDuplexHandle fd is_stream filepath binary = do
                         haIsBin = binary,
                        haIsStream = is_stream,
                        haBufferMode = w_bmode,
-                       haFilePath = filepath,
                        haBuffer = w_buf,
                        haBuffers = w_spares,
                        haOtherSide = Nothing
@@ -832,15 +917,14 @@ mkDuplexHandle fd is_stream filepath binary = do
                         haIsBin = binary,
                        haIsStream = is_stream,
                        haBufferMode = r_bmode,
-                       haFilePath = filepath,
                        haBuffer = r_buf,
                        haBuffers = r_spares,
                        haOtherSide = Just write_side
                      }
   read_side <- newMVar r_handle_
 
-  addMVarFinalizer read_side (handleFinalizer read_side)
-  return (DuplexHandle read_side write_side)
+  addMVarFinalizer write_side (handleFinalizer write_side)
+  return (DuplexHandle filepath read_side write_side)
    
 
 initBufferState ReadHandle = ReadBuffer
@@ -849,16 +933,18 @@ initBufferState _            = WriteBuffer
 -- ---------------------------------------------------------------------------
 -- Closing a handle
 
--- Computation `hClose hdl' makes handle `hdl' closed.  Before the
--- computation finishes, any items buffered for output and not already
--- sent to the operating system are flushed as for `hFlush'.
-
--- For a duplex handle, we close&flush the write side, and just close
--- the read side.
+-- | Computation 'hClose' @hdl@ makes handle @hdl@ closed.  Before the
+-- computation finishes, if @hdl@ is writable its buffer is flushed as
+-- for 'hFlush'.
+-- Performing 'hClose' on a handle that has already been closed has no effect; 
+-- doing so not an error.  All other operations on a closed handle will fail.
+-- If 'hClose' fails for any reason, any further operations (apart from
+-- 'hClose') on the handle will still fail as if @hdl@ had been successfully
+-- closed.
 
 hClose :: Handle -> IO ()
-hClose h@(FileHandle m)     = hClose' h m
-hClose h@(DuplexHandle r w) = hClose' h w >> hClose' h r
+hClose h@(FileHandle m)     = hClose' h m
+hClose h@(DuplexHandle r w) = hClose' h w >> hClose' h r
 
 hClose' h m = withHandle__' "hClose" h m $ hClose_help
 
@@ -871,44 +957,44 @@ 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
 
--- For a handle `hdl' which attached to a physical file, `hFileSize
--- hdl' returns the size of `hdl' in terms of the number of items
--- which can be read from `hdl'.
+-- | For a handle @hdl@ which attached to a physical file,
+-- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.
 
 hFileSize :: Handle -> IO Integer
 hFileSize handle =
@@ -926,10 +1012,10 @@ hFileSize handle =
 -- ---------------------------------------------------------------------------
 -- Detecting the End of Input
 
--- For a readable handle `hdl', `hIsEOF hdl' returns
--- `True' if no further input can be taken from `hdl' or for a
--- physical file, if the current I/O position is equal to the length of
--- the file.  Otherwise, it returns `False'.
+-- | For a readable handle @hdl@, 'hIsEOF' @hdl@ returns
+-- 'True' if no further input can be taken from @hdl@ or for a
+-- physical file, if the current I\/O position is equal to the length of
+-- the file.  Otherwise, it returns 'False'.
 
 hIsEOF :: Handle -> IO Bool
 hIsEOF handle =
@@ -937,15 +1023,22 @@ hIsEOF handle =
      (do hLookAhead handle; return False)
      (\e -> if isEOFError e then return True else ioError e)
 
+-- | The computation 'isEOF' is identical to 'hIsEOF',
+-- except that it works only on 'stdin'.
+
 isEOF :: IO Bool
 isEOF = hIsEOF stdin
 
 -- ---------------------------------------------------------------------------
 -- Looking ahead
 
--- hLookahead returns the next character from the handle without
--- removing it from the input buffer, blocking until a character is
--- available.
+-- | Computation 'hLookAhead' returns the next character from the handle
+-- without removing it from the input buffer, blocking until a character
+-- is available.
+--
+-- This operation may fail with:
+--
+--  * 'isEOFError' if the end of file has been reached.
 
 hLookAhead :: Handle -> IO Char
 hLookAhead handle = do
@@ -972,23 +1065,21 @@ hLookAhead handle = do
 -- block-buffering or no-buffering.  See GHC.IOBase for definition and
 -- further explanation of what the type represent.
 
--- Computation `hSetBuffering hdl mode' sets the mode of buffering for
--- handle hdl on subsequent reads and writes.
+-- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for
+-- handle @hdl@ on subsequent reads and writes.
 --
---   * If mode is LineBuffering, line-buffering should be enabled if possible.
+-- If the buffer mode is changed from 'BlockBuffering' or
+-- 'LineBuffering' to 'NoBuffering', then
 --
---   * If mode is `BlockBuffering size', then block-buffering
---     should be enabled if possible.  The size of the buffer is n items
---     if size is `Just n' and is otherwise implementation-dependent.
+--  * if @hdl@ is writable, the buffer is flushed as for 'hFlush';
 --
---   * If mode is NoBuffering, then buffering is disabled if possible.
-
--- If the buffer mode is changed from BlockBuffering or
--- LineBuffering to NoBuffering, then any items in the output
--- buffer are written to the device, and any items in the input buffer
--- are discarded.  The default buffering mode when a handle is opened
--- is implementation-dependent and may depend on the object which is
--- attached to that handle.
+--  * if @hdl@ is not writable, the contents of the buffer is discarded.
+--
+-- This operation may fail with:
+--
+--  * 'isPermissionError' if the handle has already been used for reading
+--    or writing and the implementation does not allow the buffering mode
+--    to be changed.
 
 hSetBuffering :: Handle -> BufferMode -> IO ()
 hSetBuffering handle mode =
@@ -1041,9 +1132,16 @@ hSetBuffering handle mode =
 -- -----------------------------------------------------------------------------
 -- hFlush
 
--- The action `hFlush hdl' causes any items buffered for output
--- in handle `hdl' to be sent immediately to the operating
--- system.
+-- | The action 'hFlush' @hdl@ causes any items buffered for output
+-- in handle @hdl@ to be sent immediately to the operating system.
+--
+-- This operation may fail with:
+--
+--  * 'isFullError' if the device is full;
+--
+--  * 'isPermissionError' if a system resource limit would be exceeded.
+--    It is unspecified whether the characters in the buffer are discarded
+--    or retained under these circumstances.
 
 hFlush :: Handle -> IO () 
 hFlush handle =
@@ -1073,40 +1171,38 @@ instance Show HandlePosn where
   -- that reports the position back via (merely) an Int.
 type HandlePosition = Integer
 
--- Computation `hGetPosn hdl' returns the current I/O position of
--- `hdl' as an abstract position.  Computation `hSetPosn p' sets the
--- position of `hdl' to a previously obtained position `p'.
+-- | Computation 'hGetPosn' @hdl@ returns the current I\/O position of
+-- @hdl@ as a value of the abstract type 'HandlePosn'.
 
 hGetPosn :: Handle -> IO HandlePosn
 hGetPosn handle = do
     posn <- hTell handle
     return (HandlePosn handle posn)
 
+-- | If a call to 'hGetPosn' @hdl@ returns a position @p@,
+-- then computation 'hSetPosn' @p@ sets the position of @hdl@
+-- to the position it held at the time of the call to 'hGetPosn'.
+--
+-- This operation may fail with:
+--
+--  * 'isPermissionError' if a system resource limit would be exceeded.
+
 hSetPosn :: HandlePosn -> IO () 
 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
 
 -- ---------------------------------------------------------------------------
 -- hSeek
 
-{-
-The action `hSeek hdl mode i' sets the position of handle
-`hdl' depending on `mode'.  If `mode' is
-
- * AbsoluteSeek - The position of `hdl' is set to `i'.
- * RelativeSeek - The position of `hdl' is set to offset `i' from
-                  the current position.
- * SeekFromEnd  - The position of `hdl' is set to offset `i' from
-                  the end of the file.
-
-Some handles may not be seekable (see `hIsSeekable'), or only
-support a subset of the possible positioning operations (e.g. it may
-only be possible to seek to the end of a tape, or to a positive
-offset from the beginning or current position).
+-- | A mode that determines the effect of 'hSeek' @hdl mode i@, as follows:
+data SeekMode
+  = AbsoluteSeek       -- ^ the position of @hdl@ is set to @i@.
+  | RelativeSeek       -- ^ the position of @hdl@ is set to offset @i@
+                       -- from the current position.
+  | SeekFromEnd                -- ^ the position of @hdl@ is set to offset @i@
+                       -- from the end of the file.
+    deriving (Eq, Ord, Ix, Enum, Read, Show)
 
-It is not possible to set a negative I/O position, or for a physical
-file, an I/O position beyond the current end-of-file. 
-
-Note: 
+{- Note: 
  - when seeking using `SeekFromEnd', positive offsets (>=0) means
    seeking at or past EOF.
 
@@ -1115,8 +1211,23 @@ Note:
    clear here.
 -}
 
-data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
-                    deriving (Eq, Ord, Ix, Enum, Read, Show)
+-- | Computation 'hSeek' @hdl mode i@ sets the position of handle
+-- @hdl@ depending on @mode@.
+-- The offset @i@ is given in terms of 8-bit bytes.
+--
+-- If @hdl@ is block- or line-buffered, then seeking to a position which is not
+-- in the current buffer will first cause any items in the output buffer to be
+-- written to the device, and then cause the input buffer to be discarded.
+-- Some handles may not be seekable (see 'hIsSeekable'), or only support a
+-- subset of the possible positioning operations (for instance, it may only
+-- be possible to seek to the end of a tape, or to a positive offset from
+-- the beginning or current position).
+-- It is not possible to set a negative I\/O position, or for
+-- a physical file, an I\/O position beyond the current end-of-file.
+--
+-- This operation may fail with:
+--
+--  * 'isPermissionError' if a system resource limit would be exceeded.
 
 hSeek :: Handle -> SeekMode -> Integer -> IO () 
 hSeek handle mode offset =
@@ -1215,7 +1326,7 @@ hIsClosed handle =
 -}
 
 hIsReadable :: Handle -> IO Bool
-hIsReadable (DuplexHandle _ _) = return True
+hIsReadable (DuplexHandle _ _ _) = return True
 hIsReadable handle =
     withHandle_ "hIsReadable" handle $ \ handle_ -> do
     case haType handle_ of 
@@ -1224,7 +1335,7 @@ hIsReadable handle =
       htype               -> return (isReadableHandleType htype)
 
 hIsWritable :: Handle -> IO Bool
-hIsWritable (DuplexHandle _ _) = return False
+hIsWritable (DuplexHandle _ _ _) = return True
 hIsWritable handle =
     withHandle_ "hIsWritable" handle $ \ handle_ -> do
     case haType handle_ of 
@@ -1232,7 +1343,8 @@ hIsWritable handle =
       SemiClosedHandle            -> ioe_closedHandle
       htype               -> return (isWritableHandleType htype)
 
--- Querying how a handle buffers its data:
+-- | Computation 'hGetBuffering' @hdl@ returns the current buffering mode
+-- for @hdl@.
 
 hGetBuffering :: Handle -> IO BufferMode
 hGetBuffering handle = 
@@ -1257,10 +1369,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.
 
 hSetEcho :: Handle -> Bool -> IO ()
 hSetEcho handle on = do
@@ -1273,6 +1384,8 @@ hSetEcho handle on = do
          ClosedHandle -> ioe_closedHandle
          _            -> setEcho (haFD handle_) on
 
+-- | Get the echoing status of a handle connected to a terminal.
+
 hGetEcho :: Handle -> IO Bool
 hGetEcho handle = do
     isT   <- hIsTerminalDevice handle
@@ -1284,6 +1397,8 @@ hGetEcho handle = do
          ClosedHandle -> ioe_closedHandle
          _            -> getEcho (haFD handle_)
 
+-- | Is the handle connected to a terminal?
+
 hIsTerminalDevice :: Handle -> IO Bool
 hIsTerminalDevice handle = do
     withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
@@ -1294,14 +1409,9 @@ 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.
---
+-- | Select binary mode ('True') or text mode ('False') on a open handle.
+-- (See also 'openBinaryFile'.)
+
 hSetBinaryMode :: Handle -> Bool -> IO ()
 hSetBinaryMode handle bin =
   withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
@@ -1320,16 +1430,16 @@ foreign import ccall unsafe "__hscore_setmode"
 -- discarding any input data, before the handle is duplicated.
 
 hDuplicate :: Handle -> IO Handle
-hDuplicate h@(FileHandle m) = do
+hDuplicate h@(FileHandle path m) = do
   new_h_ <- withHandle' "hDuplicate" h m (dupHandle_ Nothing)
   new_m <- newMVar new_h_
-  return (FileHandle new_m)
-hDuplicate h@(DuplexHandle r w) = do
+  return (FileHandle path new_m)
+hDuplicate h@(DuplexHandle path r w) = do
   new_w_ <- withHandle' "hDuplicate" h w (dupHandle_ Nothing)
   new_w <- newMVar new_w_
   new_r_ <- withHandle' "hDuplicate" h r (dupHandle_ (Just new_w))
   new_r <- newMVar new_r_
-  return (DuplexHandle new_r new_w)
+  return (DuplexHandle path new_r new_w)
 
 dupHandle_ other_side h_ = do
   -- flush the buffer first, so we don't have to copy its contents
@@ -1359,11 +1469,11 @@ This can be used to retarget the standard Handles, for example:
 -}
 
 hDuplicateTo :: Handle -> Handle -> IO ()
-hDuplicateTo h1@(FileHandle m1) h2@(FileHandle m2)  = do
+hDuplicateTo h1@(FileHandle _ m1) h2@(FileHandle _ m2)  = do
  withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do
    _ <- hClose_help h2_
    withHandle' "hDuplicateTo" h1 m1 (dupHandle_ Nothing)
-hDuplicateTo h1@(DuplexHandle r1 w1) h2@(DuplexHandle r2 w2)  = do
+hDuplicateTo h1@(DuplexHandle _ r1 w1) h2@(DuplexHandle _ r2 w2)  = do
  withHandle__' "hDuplicateTo" h2 w2  $ \w2_ -> do
    _ <- hClose_help w2_
    withHandle' "hDuplicateTo" h1 r1 (dupHandle_ Nothing)
@@ -1375,6 +1485,49 @@ hDuplicateTo h1 _ =
                "handles are incompatible" Nothing)
 
 -- ---------------------------------------------------------------------------
+-- showing Handles.
+--
+-- | 'hShow' is in the 'IO' monad, and gives more comprehensive output
+-- than the (pure) instance of 'Show' for 'Handle'.
+
+hShow :: Handle -> IO String
+hShow h@(FileHandle path _) = showHandle' path False h
+hShow h@(DuplexHandle path _ _) = showHandle' path True h
+
+showHandle' filepath is_duplex h = 
+  withHandle_ "showHandle" h $ \hdl_ ->
+    let
+     showType | is_duplex = showString "duplex (read-write)"
+             | otherwise = shows (haType hdl_)
+    in
+    return 
+      (( showChar '{' . 
+        showHdl (haType hdl_) 
+           (showString "loc=" . showString filepath . showChar ',' .
+            showString "type=" . showType . showChar ',' .
+            showString "binary=" . shows (haIsBin hdl_) . showChar ',' .
+            showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
+      ) "")
+   where
+
+    showHdl :: HandleType -> ShowS -> ShowS
+    showHdl ht cont = 
+       case ht of
+        ClosedHandle  -> shows ht . showString "}"
+       _ -> cont
+
+    showBufMode :: Buffer -> BufferMode -> ShowS
+    showBufMode buf bmo =
+      case bmo of
+        NoBuffering   -> showString "none"
+       LineBuffering -> showString "line"
+       BlockBuffering (Just n) -> showString "block " . showParen True (shows n)
+       BlockBuffering Nothing  -> showString "block " . showParen True (shows def)
+      where
+       def :: Int 
+       def = bufSize buf
+
+-- ---------------------------------------------------------------------------
 -- debugging
 
 #ifdef DEBUG_DUMP
@@ -1384,6 +1537,23 @@ puts s = withCString s $ \cstr -> do write_rawBuffer 1 False cstr 0 (fromIntegra
 #endif
 
 -- -----------------------------------------------------------------------------
+-- utils
+
+throwErrnoIfMinus1RetryOnBlock  :: String -> IO CInt -> IO CInt -> IO CInt
+throwErrnoIfMinus1RetryOnBlock loc f on_block  = 
+  do
+    res <- f
+    if (res :: CInt) == -1
+      then do
+       err <- getErrno
+       if err == eINTR
+         then throwErrnoIfMinus1RetryOnBlock loc f on_block
+          else if err == eWOULDBLOCK || err == eAGAIN
+                then do on_block
+                 else throwErrno loc
+      else return res
+
+-- -----------------------------------------------------------------------------
 -- wrappers to platform-specific constants:
 
 foreign import ccall unsafe "__hscore_supportsTextMode"