From abf20a8ee0691a8eca62ab3d15a050eb92d0593c Mon Sep 17 00:00:00 2001
From: Jared Hance <jaredhance@gmail.com>
Date: Sun, 8 Apr 2012 17:44:13 -0500
Subject: [PATCH] Add hGetChunk

---
 Data/Text/IO.hs | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

diff --git a/Data/Text/IO.hs b/Data/Text/IO.hs
index 4cd4d710..85bad489 100644
--- a/Data/Text/IO.hs
+++ b/Data/Text/IO.hs
@@ -26,6 +26,7 @@ module Data.Text.IO
     , appendFile
     -- * Operations on handles
     , hGetContents
+    , hGetChunk
     , hGetLine
     , hPutStr
     , hPutStrLn
@@ -97,6 +98,22 @@ writeFile p = withFile p WriteMode . flip hPutStr
 appendFile :: FilePath -> Text -> IO ()
 appendFile p = withFile p AppendMode . flip hPutStr
 
+-- | Read a single chunk of strict text from a 'Handle'.
+hGetChunk :: Handle -> IO Text
+hGetChunk h = wantReadableHandle "hGetChunk" h readSingleChunk
+ where
+  readSingleChunk hh@Handle__{..} = do
+    let catchError e
+          | isEOFError e = do
+              buf <- readIORef haCharBuffer
+              return $ if isEmptyBuffer buf
+                       then T.empty
+                       else T.singleton '\r'
+          | otherwise = throwIO (augmentIOError e "hGetChunk" h)
+    buf <- readIORef haCharBuffer
+    t <- readChunk hh buf `catch` catchError
+    return (hh, t)
+
 -- | Read the remaining contents of a 'Handle' as a string.  The
 -- 'Handle' is closed once the contents have been read, or if an
 -- exception is thrown.