summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
3f95ab8)
Fix a bug in hGetContents, namely that it wasn't closing the handle
when the end of file was reached. Also tried to tidy the code up a
bit while I was here.
#undef DEBUG
-- -----------------------------------------------------------------------------
#undef DEBUG
-- -----------------------------------------------------------------------------
--- $Id: PrelHandle.hsc,v 1.10 2001/06/22 12:36:33 rrt Exp $
+-- $Id: PrelHandle.hsc,v 1.11 2001/06/29 12:45:39 simonmar Exp $
--
-- (c) The University of Glasgow, 1994-2001
--
--
-- (c) The University of Glasgow, 1994-2001
--
stdin, stdout, stderr,
IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
stdin, stdout, stderr,
IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
- hClose, hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
+ hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
HandlePosn(..), hGetPosn, hSetPosn,
SeekMode(..), hSeek,
HandlePosn(..), hGetPosn, hSetPosn,
SeekMode(..), hSeek,
{-# INLINE withHandle #-}
withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
withHandle fun h@(FileHandle m) act = withHandle' fun h m act
{-# 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 r w) act = do
- withHandle' fun h r act
- withHandle' fun h w act
+withHandle fun h@(DuplexHandle m _) act = withHandle' fun h m act
withHandle' fun h m act =
block $ do
withHandle' fun h m act =
block $ do
-hClose' h m =
- withHandle__' "hClose" h m $ \ handle_ -> do
+hClose' h m = withHandle__' "hClose" h m $ hClose_help
+
+hClose_help handle_ =
case haType handle_ of
ClosedHandle -> return handle_
_ -> do
case haType handle_ of
ClosedHandle -> return handle_
_ -> do
#ifdef _WIN32
hSetBinaryMode handle bin =
#ifdef _WIN32
hSetBinaryMode handle bin =
- withHandle "hSetBinaryMode" handle $ \ handle_ ->
+ withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
do let flg | bin = (#const O_BINARY)
| otherwise = (#const O_TEXT)
throwErrnoIfMinus1_ "hSetBinaryMode"
(setmode (fromIntegral (haFD handle_)) flg)
do let flg | bin = (#const O_BINARY)
| otherwise = (#const O_TEXT)
throwErrnoIfMinus1_ "hSetBinaryMode"
(setmode (fromIntegral (haFD handle_)) flg)
- return (handle_{haIsBin=bin}, ())
+ return handle_{haIsBin=bin}
+ return ()
foreign import "setmode" setmode :: CInt -> CInt -> IO CInt
#else
foreign import "setmode" setmode :: CInt -> CInt -> IO CInt
#else
-hSetBinaryMode handle bin =
- withHandle "hSetBinaryMode" handle $ \ handle_ ->
- return (handle_{haIsBin=bin}, ())
+hSetBinaryMode handle bin = do
+ withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
+ return handle_{haIsBin=bin}
+ return ()
#endif
-- -----------------------------------------------------------------------------
#endif
-- -----------------------------------------------------------------------------
#undef DEBUG_DUMP
-- -----------------------------------------------------------------------------
#undef DEBUG_DUMP
-- -----------------------------------------------------------------------------
--- $Id: PrelIO.hsc,v 1.5 2001/06/22 12:36:33 rrt Exp $
+-- $Id: PrelIO.hsc,v 1.6 2001/06/29 12:45:39 simonmar Exp $
--
-- (c) The University of Glasgow, 1992-2001
--
--
-- (c) The University of Glasgow, 1992-2001
--
hGetLineBufferedLoop handle_ ref new_buf (xs:xss)
hGetLineBufferedLoop handle_ ref new_buf (xs:xss)
+maybeFillReadBuffer fd is_line buf
+ = catch
+ (do buf <- fillReadBuffer fd is_line buf
+ return (Just buf)
+ )
+ (\e -> do if isEOFError e
+ then return Nothing
+ else throw e)
+
+
unpack :: RawBuffer -> Int -> Int -> IO [Char]
unpack buf r 0 = return ""
unpack buf (I## r) (I## len) = IO $ \s -> unpack [] (len -## 1##) s
unpack :: RawBuffer -> Int -> Int -> IO [Char]
unpack buf r 0 = return ""
unpack buf (I## r) (I## len) = IO $ \s -> unpack [] (len -## 1##) s
-- carry on writing to it afterwards.
hGetContents :: Handle -> IO String
-- carry on writing to it afterwards.
hGetContents :: Handle -> IO String
-hGetContents handle@(DuplexHandle r w)
- = withHandle' "hGetContents" handle r (hGetContents' handle)
-hGetContents handle@(FileHandle m)
- = withHandle' "hGetContents" handle m (hGetContents' handle)
-
-hGetContents' handle handle_ =
+hGetContents handle =
+ withHandle "hGetContents" handle $ \handle_ ->
case haType handle_ of
ClosedHandle -> ioe_closedHandle
SemiClosedHandle -> ioe_closedHandle
case haType handle_ of
ClosedHandle -> ioe_closedHandle
SemiClosedHandle -> ioe_closedHandle
lazyRead :: Handle -> IO String
lazyRead handle =
unsafeInterleaveIO $
lazyRead :: Handle -> IO String
lazyRead handle =
unsafeInterleaveIO $
- withHandle_ "lazyRead" handle $ \ handle_ -> do
+ withHandle "lazyRead" handle $ \ handle_ -> do
- ClosedHandle -> return ""
+ ClosedHandle -> return (handle_, "")
SemiClosedHandle -> lazyRead' handle handle_
_ -> ioException
(IOError (Just handle) IllegalOperation "lazyRead"
SemiClosedHandle -> lazyRead' handle handle_
_ -> ioException
(IOError (Just handle) IllegalOperation "lazyRead"
-- (see hLookAhead)
buf <- readIORef ref
if not (bufferEmpty buf)
-- (see hLookAhead)
buf <- readIORef ref
if not (bufferEmpty buf)
- then lazyReadBuffered h fd ref buf
+ then lazyReadHaveBuffer h handle_ fd ref buf
else do
case haBufferMode handle_ of
else do
case haBufferMode handle_ of
-- make use of the minimal buffer we already have
let raw = bufBuf buf
fd = haFD handle_
-- make use of the minimal buffer we already have
let raw = bufBuf buf
fd = haFD handle_
- r <- throwErrnoIfMinus1RetryMayBlock "hGetChar"
+ r <- throwErrnoIfMinus1RetryMayBlock "lazyRead"
(read_off (fromIntegral fd) raw 0 1)
(threadWaitRead fd)
if r == 0
(read_off (fromIntegral fd) raw 0 1)
(threadWaitRead fd)
if r == 0
+ then do handle_ <- hClose_help handle_
+ return (handle_, "")
else do (c,_) <- readCharFromBuffer raw 0
rest <- lazyRead h
else do (c,_) <- readCharFromBuffer raw 0
rest <- lazyRead h
+ return (handle_, c : rest)
- LineBuffering -> lazyReadBuffered h fd ref buf
- BlockBuffering _ -> lazyReadBuffered h fd ref buf
+ LineBuffering -> lazyReadBuffered h handle_ fd ref buf
+ BlockBuffering _ -> lazyReadBuffered h handle_ fd ref buf
-- we never want to block during the read, so we call fillReadBuffer with
-- is_line==True, which tells it to "just read what there is".
-- we never want to block during the read, so we call fillReadBuffer with
-- is_line==True, which tells it to "just read what there is".
-lazyReadBuffered h fd ref buf = do
- maybe_new_buf <-
- if bufferEmpty buf
- then maybeFillReadBuffer fd True buf
- else return (Just buf)
- case maybe_new_buf of
- Nothing -> return ""
- Just buf -> do
- more <- lazyRead h
- writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
-
-
-maybeFillReadBuffer fd is_line buf
- = catch
- (do buf <- fillReadBuffer fd is_line buf
- return (Just buf)
- )
- (\e -> if isEOFError e
- then return Nothing
- else throw e)
+lazyReadBuffered h handle_ fd ref buf = do
+ catch
+ (do buf <- fillReadBuffer fd True{-is_line-} buf
+ lazyReadHaveBuffer h handle_ fd ref buf
+ )
+ -- all I/O errors are discarded. Additionally, we close the handle.
+ (\e -> do handle_ <- hClose_help handle_
+ return (handle_, "")
+ )
+
+lazyReadHaveBuffer h handle_ fd ref buf = do
+ more <- lazyRead h
+ writeIORef ref buf{ bufRPtr=0, bufWPtr=0 }
+ s <- unpackAcc (bufBuf buf) (bufRPtr buf) (bufWPtr buf) more
+ return (handle_, s)
unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]
unpackAcc :: RawBuffer -> Int -> Int -> [Char] -> IO [Char]