7728ce8 · text · git.iko.soy

git.iko.soy/text

on master help sign in

Finish off support for strict text I/O.

7728ce8Bryan O'Sullivan17 years ago

Data/Text/IO.hs+68−27

compare with master

unifiedsplit

@@ -8,7 +8,7 @@

8-- Stability : experimental

9-- Portability : GHC

10--

11−-- Support for text I\/O.

11+-- Efficient locale-sensitive support for text I\/O.

13module Data.Text.IO

14 (

@@ -31,15 +31,16 @@ module Data.Text.IO

31 , putStrLn

32 ) where

34−import Debug.Trace

35import Data.Text (Text)

34import Data.Text (Text)

36import Prelude hiding (appendFile, getContents, getLine, interact, putStr,

35import Prelude hiding (appendFile, getContents, getLine, interact, putStr,

37 putStrLn, readFile, writeFile)

36 putStrLn, readFile, writeFile)

38−import System.IO (Handle, hPutChar, stdin, stdout)

37+import System.IO (Handle, IOMode(..), hPutChar, openFile, stdin, stdout,

38+ withFile)

39#if __GLASGOW_HASKELL__ <= 610

40import qualified Data.ByteString as B

41import Data.Text.Encoding (decodeUtf8, encodeUtf8)

42#else

43+import Control.Exception (throw)

43import Data.IORef (readIORef, writeIORef)

44import Data.IORef (readIORef, writeIORef)

44import qualified Data.Text as T

45import qualified Data.Text as T

45import Data.Text.Fusion (stream, unstream)

46import Data.Text.Fusion (stream, unstream)

@@ -48,14 +49,15 @@ import Data.Text.Fusion.Size (exactSize, maxSize)

48import Data.Text.Unsafe (inlinePerformIO)

49import Data.Text.Unsafe (inlinePerformIO)

49import Foreign.Storable (peekElemOff)

50import Foreign.Storable (peekElemOff)

50import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,

51import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,

52+ RawCharBuffer, bufferAdjustL, bufferElems, charSize,

51− RawCharBuffer, bufferAdjustL, bufferElems, charSize, emptyBuffer, isEmptyBuffer, newCharBuffer, readCharBuf, withRawBuffer,

53+ emptyBuffer, isEmptyBuffer, newCharBuffer, readCharBuf,

52− writeCharBuf)

54+ withRawBuffer, writeCharBuf)

53−import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_,

55+import GHC.IO.Handle.Internals (augmentIOError, ioe_EOF, readTextDevice,

56+ wantReadableHandle_, hClose_help,

54− wantWritableHandle)

57+ wantReadableHandle, wantWritableHandle)

55import GHC.IO.Handle.Text (commitBuffer')

58import GHC.IO.Handle.Text (commitBuffer')

56import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),

59import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),

57 Newline(..))

60 Newline(..))

58−import System.IO (IOMode(..), openFile, withFile)

59import System.IO.Error (isEOFError)

61import System.IO.Error (isEOFError)

60#endif

62#endif

@@ -74,12 +76,43 @@ writeFile p = withFile p WriteMode . flip hPutStr

74appendFile :: FilePath -> Text -> IO ()

76appendFile :: FilePath -> Text -> IO ()

75appendFile p = withFile p AppendMode . flip hPutStr

77appendFile p = withFile p AppendMode . flip hPutStr

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.

78hGetContents :: Handle -> IO Text

90hGetContents :: Handle -> IO Text

79#if __GLASGOW_HASKELL__ <= 610

91#if __GLASGOW_HASKELL__ <= 610

80hGetContents = fmap decodeUtf8 . B.hGetContents

92hGetContents = fmap decodeUtf8 . B.hGetContents

81#else

93#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)

83#endif

116#endif

117

85-- | Read a single line from a handle.

118-- | Read a single line from a handle.

@@ -117,7 +150,6 @@ hGetLineLoop hh@Handle__{..} ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do

117 -- we reached EOF. There might be a lone \r left

150 -- we reached EOF. There might be a lone \r left

118 -- in the buffer, so check for that and

151 -- in the buffer, so check for that and

119 -- append it to the line if necessary.

152 -- append it to the line if necessary.

120− --

121 let pre | isEmptyBuffer buf1 = T.empty

153 let pre | isEmptyBuffer buf1 = T.empty

122 | otherwise = T.singleton '\r'

154 | otherwise = T.singleton '\r'

123 writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }

155 writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }

@@ -125,8 +157,7 @@ hGetLineLoop hh@Handle__{..} ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do

125 if T.null str

157 if T.null str

126 then ioe_EOF

158 then ioe_EOF

127 else return str

159 else return str

128− Just new_buf ->

129− hGetLineLoop hh (t:ts) new_buf

160+ Just new_buf -> hGetLineLoop hh (t:ts) new_buf

130

161

131-- This function is lifted almost verbatim from GHC.IO.Handle.Text.

162-- This function is lifted almost verbatim from GHC.IO.Handle.Text.

132maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)

163maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)

@@ -139,19 +170,19 @@ maybeFillReadBuffer handle_ buf

139unpack :: RawCharBuffer -> Int -> Int -> IO Text

170unpack :: RawCharBuffer -> Int -> Int -> IO Text

140unpack !buf !r !w

171unpack !buf !r !w

141 | charSize /= 4 = sizeError "unpack"

172 | charSize /= 4 = sizeError "unpack"

142− | r == w = return T.empty

173+ | r >= w = return T.empty

143 | otherwise = withRawBuffer buf go

174 | otherwise = withRawBuffer buf go

144 where

175 where

145 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))

176 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))

146 where

177 where

147 next !i | i >= w = Done

178 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)

149 ix i = inlinePerformIO $ peekElemOff pbuf i

180 ix i = inlinePerformIO $ peekElemOff pbuf i

150

181

151unpack_nl :: RawCharBuffer -> Int -> Int -> IO (Text, Int)

182unpack_nl :: RawCharBuffer -> Int -> Int -> IO (Text, Int)

152unpack_nl !buf !r !w

183unpack_nl !buf !r !w

153 | charSize /= 4 = sizeError "unpack_nl"

184 | charSize /= 4 = sizeError "unpack_nl"

154− | r == w = return (T.empty, 0)

185+ | r >= w = return (T.empty, 0)

155 | otherwise = withRawBuffer buf $ go

186 | otherwise = withRawBuffer buf $ go

156 where

187 where

157 go pbuf = do

188 go pbuf = do

@@ -198,8 +229,7 @@ getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =

198 return buf

229 return buf

199

230

200 -- buffer has some chars in it already: just return it

231 -- buffer has some chars in it already: just return it

201− _otherwise ->

232+ _otherwise -> return buf

202− return buf

203#endif

233#endif

204

234

205-- | Write a string to a handle.

235-- | Write a string to a handle.

@@ -311,12 +341,26 @@ putStrLn = hPutStrLn stdout

311

341

312-- $locale

342-- $locale

313--

343--

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+--

314−-- Under GHC 6.10 and earlier, the system I\/O libraries do not

350+-- 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

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+--

316−-- module is decoded as UTF-8, and before data is written, it is first

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+--

317−-- encoded as UTF-8. If you must use a non-UTF-8 locale on an older

362+-- If you must use a non-UTF-8 locale on an older version of GHC, you

318−-- version of GHC, you will have to perform the transcoding yourself,

363+-- will have to perform the transcoding yourself, e.g. as follows:

319−-- e.g. as follows:

320--

364--

321-- > import qualified Data.ByteString as B

365-- > import qualified Data.ByteString as B

322-- > import Data.Text (Text)

366-- > import Data.Text (Text)

@@ -324,6 +368,3 @@ putStrLn = hPutStrLn stdout

324-- >

368-- >

325-- > putStr_Utf16LE :: Text -> IO ()

369-- > putStr_Utf16LE :: Text -> IO ()

326-- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)

370-- > 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.