[project @ 2001-05-24 10:41:13 by simonmar]

Make hGetContents work on DuplexHandles, and some small cleanups.

diff --git a/ghc/lib/std/PrelHandle.hsc b/ghc/lib/std/PrelHandle.hsc
index 9f50cf1..0f62333 100644 (file)
--- a/ghc/lib/std/PrelHandle.hsc
+++ b/ghc/lib/std/PrelHandle.hsc
@@ -4,21 +4,21 @@
 #undef DEBUG
 
 -- -----------------------------------------------------------------------------
--- $Id: PrelHandle.hsc,v 1.4 2001/05/21 11:02:50 simonmar Exp $
+-- $Id: PrelHandle.hsc,v 1.5 2001/05/24 10:41:13 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1994-2001
 --
 -- This module defines the basic operations on I/O "handles".
 
 module PrelHandle (
-  withHandle, withHandle_,
+  withHandle, withHandle', withHandle_,
   wantWritableHandle, wantReadableHandle, wantSeekableHandle,
   
   newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
   flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, fillReadBuffer,
   read_off,
 
-  ioe_closedHandle, ioe_EOF,
+  ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
 
   stdin, stdout, stderr,
   IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
@@ -184,7 +184,7 @@ checkWritableHandle act handle_
   = case haType handle_ of 
       ClosedHandle        -> ioe_closedHandle
       SemiClosedHandle            -> ioe_closedHandle
-      ReadHandle          -> ioException not_writeable_error
+      ReadHandle          -> ioe_notWritable
       ReadWriteHandle             -> do
                let ref = haBuffer handle_
                buf <- readIORef ref
@@ -196,10 +196,6 @@ checkWritableHandle act handle_
                writeIORef ref new_buf
                act handle_
       _other              -> act handle_
-  where
-   not_writeable_error = 
-       IOError Nothing IllegalOperation ""
-               "handle is not open for writing" Nothing
 
 -- ---------------------------------------------------------------------------
 -- Wrapper for read operations.
@@ -221,8 +217,8 @@ checkReadableHandle act handle_ =
     case haType handle_ of 
       ClosedHandle        -> ioe_closedHandle
       SemiClosedHandle            -> ioe_closedHandle
-      AppendHandle        -> ioException not_readable_error
-      WriteHandle         -> ioException not_readable_error
+      AppendHandle        -> ioe_notReadable
+      WriteHandle         -> ioe_notReadable
       ReadWriteHandle     -> do 
        let ref = haBuffer handle_
        buf <- readIORef ref
@@ -231,10 +227,6 @@ checkReadableHandle act handle_ =
           writeIORef ref new_buf{ bufState=ReadBuffer }
        act handle_
       _other              -> act handle_
-  where
-   not_readable_error = 
-       IOError Nothing IllegalOperation ""
-               "handle is not open for reading" Nothing
 
 -- ---------------------------------------------------------------------------
 -- Wrapper for seek operations.
@@ -250,21 +242,29 @@ checkSeekableHandle act handle_ =
     case haType handle_ of 
       ClosedHandle        -> ioe_closedHandle
       SemiClosedHandle    -> ioe_closedHandle
-      AppendHandle         -> not_seekable_error
+      AppendHandle         -> ioe_notSeekable
       _                   -> act handle_
 
-not_seekable_error
-  = ioException (IOError Nothing IllegalOperation ""
-                  "handle is not seekable" Nothing)
-
 -- -----------------------------------------------------------------------------
 -- Handy IOErrors
 
-ioe_closedHandle :: IO a
-ioe_closedHandle = ioException (IOError Nothing IllegalOperation "" "" Nothing)
-
-ioe_EOF :: IO a
-ioe_EOF = ioException (IOError Nothing EOF "" "" Nothing)
+ioe_closedHandle, ioe_EOF, 
+  ioe_notReadable, ioe_notWritable, ioe_notSeekable :: IO a
+
+ioe_closedHandle = ioException 
+   (IOError Nothing IllegalOperation "" 
+       "handle is closed" Nothing)
+ioe_EOF = ioException 
+   (IOError Nothing EOF "" "" Nothing)
+ioe_notReadable = ioException 
+   (IOError Nothing IllegalOperation "" 
+       "handle is not open for reading" Nothing)
+ioe_notWritable = ioException 
+   (IOError Nothing IllegalOperation "" 
+       "handle is not open for writing" Nothing)
+ioe_notSeekable = ioException 
+   (IOError Nothing IllegalOperation ""
+       "handle is not seekable" Nothing)
 
 -- -----------------------------------------------------------------------------
 -- Handle Finalizers

diff --git a/ghc/lib/std/PrelIO.hsc b/ghc/lib/std/PrelIO.hsc
index 90c8b80..0b7ac8c 100644 (file)
--- a/ghc/lib/std/PrelIO.hsc
+++ b/ghc/lib/std/PrelIO.hsc
@@ -3,7 +3,7 @@
 #undef DEBUG_DUMP
 
 -- -----------------------------------------------------------------------------
--- $Id: PrelIO.hsc,v 1.3 2001/05/22 15:06:47 simonmar Exp $
+-- $Id: PrelIO.hsc,v 1.4 2001/05/24 10:41:13 simonmar Exp $
 --
 -- (c) The University of Glasgow, 1992-2001
 --
@@ -293,26 +293,27 @@ hGetLineUnBuffered h = do
 -- unread portion of the channel or file managed by the handle, which
 -- is made semi-closed.
 
+-- hGetContents on a DuplexHandle only affects the read side: you can
+-- carry on writing to it afterwards.
+
 hGetContents :: Handle -> IO String
-hGetContents handle = 
-       -- can't use wantReadableHandle here, because we want to side effect
-       -- the handle.
-    withHandle "hGetContents" handle $ \ handle_ -> do
+hGetContents handle@(DuplexHandle r w) 
+  = withHandle' "hGetContents" handle r (hGetContents' handle)
+hGetContents handle@(FileHandle m) 
+  = withHandle' "hGetContents" handle m (hGetContents' handle)
+
+hGetContents' handle handle_ = 
     case haType handle_ of 
       ClosedHandle        -> ioe_closedHandle
       SemiClosedHandle            -> ioe_closedHandle
-      AppendHandle        -> ioException not_readable_error
-      WriteHandle         -> ioException not_readable_error
+      AppendHandle        -> ioe_notReadable
+      WriteHandle         -> ioe_notReadable
       _ -> do xs <- lazyRead handle
              return (handle_{ haType=SemiClosedHandle}, xs )
-  where
-   not_readable_error = 
-       IOError (Just handle) IllegalOperation "hGetContents"
-               "handle is not open for reading" Nothing
 
 -- Note that someone may close the semi-closed handle (or change its
--- buffering), so each these lazy read functions are pulled on, they
--- have to check whether the handle has indeed been closed.
+-- buffering), so each time these lazy read functions are pulled on,
+-- they have to check whether the handle has indeed been closed.
 
 lazyRead :: Handle -> IO String
 lazyRead handle =