@@ -8,7 +8,7 @@
88-- Stability : experimental
99-- Portability : GHC
1010--
11−-- Support for text I\/O.
11+-- Efficient locale-sensitive support for text I\/O.
1212
1313module Data.Text.IO
1414 (
@@ -31,15 +31,16 @@ module Data.Text.IO
3131 , putStrLn
3232 ) where
3333
34−import Debug.Trace
3534import Data.Text (Text)
3635import Prelude hiding (appendFile, getContents, getLine, interact, putStr,
3736 putStrLn, readFile, writeFile)
38−import System.IO (Handle, hPutChar, stdin, stdout)
37+import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,
38+ withFile)
3939#if __GLASGOW_HASKELL__ <= 610
4040import qualified Data.ByteString as B
4141import Data.Text.Encoding (decodeUtf8, encodeUtf8)
4242#else
43+import Control.Exception (throw)
4344import Data.IORef (readIORef, writeIORef)
4445import qualified Data.Text as T
4546import Data.Text.Fusion (stream, unstream)
@@ -48,14 +49,15 @@ import Data.Text.Fusion.Size (exactSize, maxSize)
4849import Data.Text.Unsafe (inlinePerformIO)
4950import Foreign.Storable (peekElemOff)
5051import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,
51− RawCharBuffer, bufferAdjustL, bufferElems, charSize, emptyBuffer, isEmptyBuffer, newCharBuffer, readCharBuf, withRawBuffer,
52− writeCharBuf)
53−import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_,
54− wantWritableHandle)
52+ RawCharBuffer, bufferAdjustL, bufferElems, charSize,
53+ emptyBuffer, isEmptyBuffer, newCharBuffer, readCharBuf,
54+ withRawBuffer, writeCharBuf)
55+import GHC.IO.Handle.Internals (augmentIOError, ioe_EOF, readTextDevice,
56+ wantReadableHandle_, hClose_help,
57+ wantReadableHandle, wantWritableHandle)
5558import GHC.IO.Handle.Text (commitBuffer')
5659import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),
5760 Newline(..))
58−import System.IO (IOMode(..), openFile, withFile)
5961import System.IO.Error (isEOFError)
6062#endif
6163
@@ -74,12 +76,43 @@ writeFile p = withFile p WriteMode . flip hPutStr
7476appendFile :: FilePath -> Text -> IO ()
7577appendFile p = withFile p AppendMode . flip hPutStr
7678
77−-- | Read the remaining contents of a handle as a string.
79+-- | Read the remaining contents of a 'Handle' as a string. The
80+-- 'Handle' is closed once the contents have been read, or if an
81+-- exception is thrown.
82+--
83+-- Internally, this function reads a chunk at a time from the
84+-- lower-level buffering abstraction, and concatenates the chunks into
85+-- a single string once the entire file has been read.
86+--
87+-- As a result, it requires approximately twice as much memory as its
88+-- result to construct its result. For files more than a half of
89+-- available RAM in size, this may result in memory exhaustion.
7890hGetContents :: Handle -> IO Text
7991#if __GLASGOW_HASKELL__ <= 610
8092hGetContents = fmap decodeUtf8 . B.hGetContents
8193#else
82−hGetContents = undefined
94+hGetContents h = wantReadableHandle "hGetContents" h $ \hh -> do
95+ (hh',ts) <- readAll hh
96+ return (hh',T.concat ts)
97+ where
98+ readAll hh@Handle__{..} = do
99+ buf <- readIORef haCharBuffer
100+ let readChunks = do
101+ buf'@Buffer{..} <- getSomeCharacters hh buf
102+ (t,r) <- if haInputNL == CRLF
103+ then unpack_nl bufRaw bufL bufR
104+ else do t <- unpack bufRaw bufL bufR
105+ return (t,bufR)
106+ writeIORef haCharBuffer (bufferAdjustL r buf')
107+ (hh',ts) <- readAll hh
108+ return (hh', t:ts)
109+ readChunks `catch` \e -> do
110+ (hh', _) <- hClose_help hh
111+ if isEOFError e
112+ then return $ if isEmptyBuffer buf
113+ then (hh', [])
114+ else (hh', [T.singleton '\r'])
115+ else throw (augmentIOError e "hGetContents" h)
83116#endif
84117
85118-- | Read a single line from a handle.
@@ -117,7 +150,6 @@ hGetLineLoop hh@Handle__{..} ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do
117150 -- we reached EOF. There might be a lone \r left
118151 -- in the buffer, so check for that and
119152 -- append it to the line if necessary.
120− --
121153 let pre | isEmptyBuffer buf1 = T.empty
122154 | otherwise = T.singleton '\r'
123155 writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }
@@ -125,8 +157,7 @@ hGetLineLoop hh@Handle__{..} ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do
125157 if T.null str
126158 then ioe_EOF
127159 else return str
128− Just new_buf ->
129− hGetLineLoop hh (t:ts) new_buf
160+ Just new_buf -> hGetLineLoop hh (t:ts) new_buf
130161
131162-- This function is lifted almost verbatim from GHC.IO.Handle.Text.
132163maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)
@@ -139,19 +170,19 @@ maybeFillReadBuffer handle_ buf
139170unpack :: RawCharBuffer -> Int -> Int -> IO Text
140171unpack !buf !r !w
141172 | charSize /= 4 = sizeError "unpack"
142− | r == w = return T.empty
173+ | r >= w = return T.empty
143174 | otherwise = withRawBuffer buf go
144175 where
145176 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))
146177 where
147178 next !i | i >= w = Done
148− | otherwise = Yield (let c = ix i in trace (show (w,i,c)) c) (i+1)
179+ | otherwise = Yield (ix i) (i+1)
149180 ix i = inlinePerformIO $ peekElemOff pbuf i
150181
151182unpack_nl :: RawCharBuffer -> Int -> Int -> IO (Text, Int)
152183unpack_nl !buf !r !w
153184 | charSize /= 4 = sizeError "unpack_nl"
154− | r == w = return (T.empty, 0)
185+ | r >= w = return (T.empty, 0)
155186 | otherwise = withRawBuffer buf $ go
156187 where
157188 go pbuf = do
@@ -198,8 +229,7 @@ getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =
198229 return buf
199230
200231 -- buffer has some chars in it already: just return it
201− _otherwise ->
202− return buf
232+ _otherwise -> return buf
203233#endif
204234
205235-- | Write a string to a handle.
@@ -311,12 +341,26 @@ putStrLn = hPutStrLn stdout
311341
312342-- $locale
313343--
314−-- Under GHC 6.10 and earlier, the system I\/O libraries do not
315−-- support locale-sensitive I\/O. All data read by functions in this
316−-- module is decoded as UTF-8, and before data is written, it is first
317−-- encoded as UTF-8. If you must use a non-UTF-8 locale on an older
318−-- version of GHC, you will have to perform the transcoding yourself,
319−-- e.g. as follows:
344+-- /Note/: The behaviour of functions in this module depends on the
345+-- version of GHC you are using.
346+--
347+-- Beginning with GHC 6.12, text I\/O is performed using the system or
348+-- handle's current locale and line ending conventions.
349+--
350+-- Under GHC 6.10 and earlier, the system I\/O libraries /do not
351+-- support/ locale-sensitive I\/O or line ending conversion. On these
352+-- versions of GHC, functions in this library all use UTF-8. What
353+-- does this mean in practice?
354+--
355+-- * All data that is read will be decoded as UTF-8.
356+--
357+-- * Before data is written, it is first encoded as UTF-8.
358+--
359+-- * On both reading and writing, the platform's native newline
360+-- conversion is performed.
361+--
362+-- If you must use a non-UTF-8 locale on an older version of GHC, you
363+-- will have to perform the transcoding yourself, e.g. as follows:
320364--
321365-- > import qualified Data.ByteString as B
322366-- > import Data.Text (Text)
@@ -324,6 +368,3 @@ putStrLn = hPutStrLn stdout
324368-- >
325369-- > putStr_Utf16LE :: Text -> IO ()
326370-- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)
327−--
328−-- Beginning with GHC 6.12, text I\/O is performed using the system or
329−-- handle's current locale.