Commit 818b3c38 authored by Xia Li-yao's avatar Xia Li-yao Committed by Marge Bot

base: add strict IO functions: readFile', getContents', hGetContents'

parent cfcc3c9a
Pipeline #16790 passed with stages
in 417 minutes and 7 seconds
......@@ -45,7 +45,7 @@ module GHC.IO.Handle (
hShow,
hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
hWaitForInput, hGetChar, hGetLine, hGetContents, hGetContents', hPutChar, hPutStr,
hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking
) where
......
......@@ -28,7 +28,7 @@ module GHC.IO.Handle.Text (
hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
commitBuffer', -- hack, see below
hGetBuf, hGetBufSome, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking,
memcpy, hPutStrLn,
memcpy, hPutStrLn, hGetContents',
) where
import GHC.IO
......@@ -48,6 +48,7 @@ import Foreign.C
import qualified Control.Exception as Exception
import Data.Typeable
import System.IO.Error
import Data.Either (Either(..))
import Data.Maybe
import GHC.IORef
......@@ -453,6 +454,90 @@ getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =
_otherwise ->
return buf
-- -----------------------------------------------------------------------------
-- hGetContents'
-- We read everything into a list of CharBuffer chunks, and convert it lazily
-- to a string, which minimizes memory usage.
-- In the worst case, space usage is at most that of the complete String,
-- as the chunks can be garbage collected progressively.
-- For streaming consumers, space usage is at most that of the list of chunks.
-- | The 'hGetContents'' operation reads all input on the given handle
-- before returning it as a 'String' and closing the handle.
--
-- @since 4.14.0.0
hGetContents' :: Handle -> IO String
hGetContents' handle = do
es <- wantReadableHandle "hGetContents'" handle (strictRead handle)
case es of
Right s -> return s
Left e ->
case fromException e of
Just ioe -> throwIO (augmentIOError ioe "hGetContents'" handle)
Nothing -> throwIO e
strictRead :: Handle -> Handle__ -> IO (Handle__, Either SomeException String)
strictRead h handle_@Handle__{..} = do
cbuf <- readIORef haCharBuffer
cbufs <- strictReadLoop' handle_ [] cbuf
(handle_', me) <- hClose_help handle_
case me of
Just e -> return (handle_', Left e)
Nothing -> do
s <- lazyBuffersToString haInputNL cbufs ""
return (handle_', Right s)
strictReadLoop :: Handle__ -> [CharBuffer] -> CharBuffer -> IO [CharBuffer]
strictReadLoop handle_ cbufs cbuf0 = do
mcbuf <- Exception.catch
(do r <- readTextDevice handle_ cbuf0
return (Just r))
(\e -> if isEOFError e
then return Nothing
else throw e)
case mcbuf of
Nothing -> return (cbuf0 : cbufs)
Just cbuf1 -> strictReadLoop' handle_ cbufs cbuf1
-- If 'cbuf' is full, allocate a new buffer.
strictReadLoop' :: Handle__ -> [CharBuffer] -> CharBuffer -> IO [CharBuffer]
strictReadLoop' handle_ cbufs cbuf
| isFullCharBuffer cbuf = do
cbuf' <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE ReadBuffer
strictReadLoop handle_ (cbuf : cbufs) cbuf'
| otherwise = strictReadLoop handle_ cbufs cbuf
-- Lazily convert a list of buffers to a String. The buffers are
-- in reverse order: the first buffer is the end of the String.
lazyBuffersToString :: Newline -> [CharBuffer] -> String -> IO String
lazyBuffersToString LF = loop where
loop [] s = return s
loop (Buffer{..} : cbufs) s = do
s' <- unsafeInterleaveIO (unpack bufRaw bufL bufR s)
loop cbufs s'
lazyBuffersToString CRLF = loop '\0' where
loop before [] s = return s
loop before (Buffer{..} : cbufs) s
| bufL == bufR = loop before cbufs s -- skip empty buffers
| otherwise = do
-- When a CRLF is broken across two buffers, we already have a newline
-- from decoding the LF, so we ignore the CR in the current buffer.
s1 <- if before == '\n'
then return s
else do
-- We restore trailing CR not followed by LF.
c <- peekCharBuf bufRaw (bufR - 1)
if c == '\r'
then return ('\r' : s)
else return s
s2 <- unsafeInterleaveIO (do
(s2, _) <- unpack_nl bufRaw bufL bufR s1
return s2)
c0 <- peekCharBuf bufRaw bufL
loop c0 cbufs s2
-- ---------------------------------------------------------------------------
-- hPutChar
......
......@@ -60,6 +60,7 @@ module System.IO (
-- | These functions are also exported by the "Prelude".
readFile,
readFile',
writeFile,
appendFile,
......@@ -123,6 +124,7 @@ module System.IO (
hGetLine,
hLookAhead,
hGetContents,
hGetContents',
-- ** Text output
......@@ -143,6 +145,7 @@ module System.IO (
getChar,
getLine,
getContents,
getContents',
readIO,
readLn,
......@@ -305,6 +308,15 @@ getLine = hGetLine stdin
getContents :: IO String
getContents = hGetContents stdin
-- | The 'getContents'' operation returns all user input as a single string,
-- which is fully read before being returned
-- (same as 'hGetContents'' 'stdin').
--
-- @since 4.14.0.0
getContents' :: IO String
getContents' = hGetContents' stdin
-- | The 'interact' function takes a function of type @String->String@
-- as its argument. The entire input from the standard input device is
-- passed to this function as its argument, and the resulting string is
......@@ -321,6 +333,15 @@ interact f = do s <- getContents
readFile :: FilePath -> IO String
readFile name = openFile name ReadMode >>= hGetContents
-- | The 'readFile'' function reads a file and
-- returns the contents of the file as a string.
-- The file is fully read before being returned, as with 'getContents''.
--
-- @since 4.14.0.0
readFile' :: FilePath -> IO String
readFile' name = openFile name ReadMode >>= hGetContents'
-- | The computation 'writeFile' @file str@ function writes the string @str@,
-- to the file @file@.
writeFile :: FilePath -> String -> IO ()
......
......@@ -51,6 +51,9 @@
* Add `IsList` instance for `ZipList`.
* Add `hGetContents'`, `getContents'`, and `readFile'` in `System.IO`:
Strict IO variants of `hGetContents`, `getContents`, and `readFile`.
## 4.13.0.0 *July 2019*
* Bundled with GHC 8.8.1
......
......@@ -122,6 +122,7 @@
/IO/hFlush001.out
/IO/hGetBuf001
/IO/hGetBuffering001
/IO/hGetContentsS001
/IO/hGetChar001
/IO/hGetLine001
/IO/hGetLine002
......
......@@ -20,6 +20,7 @@ test('hGetBuffering001',
[omit_ways(['ghci']), set_stdin('hGetBuffering001.hs')],
compile_and_run, [''])
test('hGetContentsS001', normal, compile_and_run, [''])
test('hGetChar001', normal, compile_and_run, [''])
test('hGetLine001', set_stdin('hGetLine001.hs'), compile_and_run, ['-cpp'])
test('hGetLine002', normal, compile_and_run, [''])
......
import System.IO
file = "hGetContentsS001.txt"
main = do
writeFile file "ab\ncd\nef\ngh\n"
h <- openFile file ReadMode
hGetContents' h >>= putStr
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment