import GHC.IO.Buffer
import qualified GHC.IO.BufferedIO as Buffered
import GHC.IO.Exception
+import GHC.Exception
import GHC.IO.Handle.Types
import GHC.IO.Handle.Internals
import qualified GHC.IO.Device as IODevice
hWaitForInput :: Handle -> Int -> IO Bool
hWaitForInput h msecs = do
wantReadableHandle_ "hWaitForInput" h $ \ handle_@Handle__{..} -> do
- buf <- readIORef haCharBuffer
+ cbuf <- readIORef haCharBuffer
- if not (isEmptyBuffer buf)
- then return True
- else do
+ if not (isEmptyBuffer cbuf) then return True else do
if msecs < 0
- then do buf' <- readTextDevice handle_ buf
- writeIORef haCharBuffer buf'
+ then do cbuf' <- readTextDevice handle_ cbuf
+ writeIORef haCharBuffer cbuf'
return True
- else do r <- IODevice.ready haDevice False{-read-} msecs
+ else do
+ -- there might be bytes in the byte buffer waiting to be decoded
+ cbuf' <- readTextDeviceNonBlocking handle_ cbuf
+ writeIORef haCharBuffer cbuf'
+
+ if not (isEmptyBuffer cbuf') then return True else do
+
+ r <- IODevice.ready haDevice False{-read-} msecs
if r then do -- Call hLookAhead' to throw an EOF
-- exception if appropriate
_ <- hLookAhead_ handle_
return True
else return False
+ -- XXX we should only return when there are full characters
+ -- not when there are only bytes. That would mean looping
+ -- and re-running IODevice.ready if we don't have any full
+ -- characters; but we don't know how long we've waited
+ -- so far.
-- ---------------------------------------------------------------------------
-- hGetChar
-- ---------------------------------------------------------------------------
-- hGetLine
--- ToDo: the unbuffered case is wrong: it doesn't lock the handle for
--- the duration.
-
-- | Computation 'hGetLine' @hdl@ reads a line from the file or
-- channel managed by @hdl@.
--
lazyRead :: Handle -> IO String
lazyRead handle =
unsafeInterleaveIO $
- withHandle "lazyRead" handle $ \ handle_ -> do
+ withHandle "hGetContents" handle $ \ handle_ -> do
case haType handle_ of
ClosedHandle -> return (handle_, "")
SemiClosedHandle -> lazyReadBuffered handle handle_
_ -> ioException
- (IOError (Just handle) IllegalOperation "lazyRead"
+ (IOError (Just handle) IllegalOperation "hGetContents"
"illegal handle type" Nothing Nothing)
lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, [Char])
writeIORef haCharBuffer (bufferAdjustL r buf')
return (handle_, s)
)
- -- all I/O errors are discarded. Additionally, we close the handle.
(\e -> do (handle_', _) <- hClose_help handle_
debugIO ("hGetContents caught: " ++ show e)
-- We might have a \r cached in CRLF mode. So we
-- need to check for that and return it:
- if not (isEmptyBuffer buf)
- then return (handle_', "\r")
- else return (handle_', "")
+ let r = if isEOFError e
+ then if not (isEmptyBuffer buf)
+ then "\r"
+ else ""
+ else
+ throw (augmentIOError e "hGetContents" h)
+
+ return (handle_', r)
)
-- ensure we have some characters in the buffer
-- 'hPutBuf' ignores any text encoding that applies to the 'Handle',
-- writing the bytes directly to the underlying file or device.
--
+-- 'hPutBuf' ignores the prevailing 'TextEncoding' and
+-- 'NewlineMode' on the 'Handle', and writes bytes directly.
+--
-- This operation may fail with:
--
-- * 'ResourceVanished' if the handle is a pipe or socket, and the
-- else, we have to flush
else do debugIO "hPutBuf: flushing first"
- Buffered.flushWriteBuffer haDevice old_buf
+ old_buf' <- Buffered.flushWriteBuffer haDevice old_buf
-- TODO: we should do a non-blocking flush here
- writeIORef haByteBuffer old_buf{bufL=0,bufR=0}
+ writeIORef haByteBuffer old_buf'
-- if we can fit in the buffer, then just loop
if count < size
then bufWrite h_ ptr count can_block
-- If the handle is a pipe or socket, and the writing end
-- is closed, 'hGetBuf' will behave as if EOF was reached.
--
+-- 'hGetBuf' ignores the prevailing 'TextEncoding' and 'NewlineMode'
+-- on the 'Handle', and reads bytes directly.
hGetBuf :: Handle -> Ptr a -> Int -> IO Int
hGetBuf h ptr count
-- If the handle is a pipe or socket, and the writing end
-- is closed, 'hGetBufNonBlocking' will behave as if EOF was reached.
--
+-- 'hGetBufNonBlocking' ignores the prevailing 'TextEncoding' and
+-- 'NewlineMode' on the 'Handle', and reads bytes directly.
+
hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int
hGetBufNonBlocking h ptr count
| count == 0 = return 0
projects / ghc-base.git / blobdiff