on master help sign in
Implement lazy hGetContents.
53836e2Bryan O'Sullivan
Data/Text/Lazy/IO.hs+45−3
@@ -31,7 +31,7 @@ module Data.Text.Lazy.IO
31 , putStrLn
31 , putStrLn
32 ) where
32 ) where
33
33
34−import Data.Text.Lazy (Text)
34+import Data.Text.Lazy.Internal (Text(..))
35import Prelude hiding (appendFile, getContents, getLine, interact, putStr,
35import Prelude hiding (appendFile, getContents, getLine, interact, putStr,
36 putStrLn, readFile, writeFile)
36 putStrLn, readFile, writeFile)
37import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
37import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
@@ -43,7 +43,23 @@ import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)
43import qualified Data.ByteString.Char8 as S8
43import qualified Data.ByteString.Char8 as S8
44import qualified Data.ByteString.Lazy.Char8 as L8
44import qualified Data.ByteString.Lazy.Char8 as L8
45#else
45#else
46+import Control.Exception (throw)
47+import Data.IORef (readIORef, writeIORef)
46−import Data.Text.IO.Internal (hGetLineWith)
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)
47#endif
63#endif
48
64
49-- | The 'readFile' function reads a file and returns the contents of
65-- | The 'readFile' function reads a file and returns the contents of
@@ -65,7 +81,33 @@ hGetContents :: Handle -> IO Text
65#if __GLASGOW_HASKELL__ <= 610
81#if __GLASGOW_HASKELL__ <= 610
66hGetContents = fmap decodeUtf8 . L8.hGetContents
82hGetContents = fmap decodeUtf8 . L8.hGetContents
67#else
83#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)
69#endif
111#endif
70
112
71-- | Read a single line from a handle.
113-- | Read a single line from a handle.