on master help sign in
Implement lazy hGetContents.

--HG-- extra : convert_revision : 13c56e44b94d596afb78ebaf2a3180fd7e49c387

commit53836e2f2fc7b7a2e520e39f4f9b499ef5fe8f26 authorBryan O'Sullivan <bos@serpentine.com> dateTue 15 Dec 2009, 01:14 (17 years ago) parent0797768
1 file changed+45−3
Data/Text/Lazy/IO.hs+45−3
Data/Text/Lazy/IO.hs+45−3
@@ -31,7 +31,7 @@ module Data.Text.Lazy.IO
3131 , putStrLn
3232 ) where
3333
34−import Data.Text.Lazy (Text)
34+import Data.Text.Lazy.Internal (Text(..))
3535import Prelude hiding (appendFile, getContents, getLine, interact, putStr,
3636 putStrLn, readFile, writeFile)
3737import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
@@ -43,7 +43,23 @@ import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
4343import qualified Data.ByteString.Char8 as S8
4444import qualified Data.ByteString.Lazy.Char8 as L8
4545#else
46−import Data.Text.IO.Internal (hGetLineWith)
46+import Control.Exception (throw)
47+import Data.IORef (readIORef, writeIORef)
48+import Data.Text.IO.Internal (hGetLineWith, readChunk)
49+import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,
50+ RawCharBuffer, bufferAdjustL, bufferElems, charSize,
51+ emptyBuffer, isEmptyBuffer, newCharBuffer, readCharBuf,
52+ withRawBuffer, writeCharBuf)
53+import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)
54+import GHC.IO.Handle.Internals (augmentIOError, ioe_EOF, readTextDevice,
55+ wantReadableHandle_, hClose_help,
56+ wantReadableHandle, wantWritableHandle,
57+ withHandle)
58+import GHC.IO.Handle.Text (commitBuffer')
59+import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),
60+ HandleType(..), Newline(..))
61+import System.IO.Error (isEOFError)
62+import System.IO.Unsafe (unsafeInterleaveIO)
4763#endif
4864
4965-- | The 'readFile' function reads a file and returns the contents of
@@ -65,7 +81,33 @@ hGetContents :: Handle -> IO Text
6581#if __GLASGOW_HASKELL__ <= 610
6682hGetContents = fmap decodeUtf8 . L8.hGetContents
6783#else
68−hGetContents = undefined
84+hGetContents h =
85+ wantReadableHandle "hGetContents" h $ \hh -> do
86+ ts <- lazyRead h
87+ return (hh{haType=SemiClosedHandle}, ts)
88+
89+lazyRead :: Handle -> IO Text
90+lazyRead h = unsafeInterleaveIO $
91+ withHandle "hGetContents" h $ \hh -> do
92+ case haType hh of
93+ ClosedHandle -> return (hh, L.empty)
94+ SemiClosedHandle -> lazyReadBuffered h hh
95+ _ -> ioException
96+ (IOError (Just h) IllegalOperation "hGetContents"
97+ "illegal handle type" Nothing Nothing)
98+
99+lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, Text)
100+lazyReadBuffered h hh@Handle__{..} = do
101+ buf <- readIORef haCharBuffer
102+ (do t <- readChunk hh buf
103+ ts <- lazyRead h
104+ return (hh, Chunk t ts)) `catch` \e -> do
105+ (hh', _) <- hClose_help hh
106+ if isEOFError e
107+ then return $ if isEmptyBuffer buf
108+ then (hh', Empty)
109+ else (hh', L.singleton '\r')
110+ else throw (augmentIOError e "hGetContents" h)
69111#endif
70112
71113-- | Read a single line from a handle.