master..0d6d979 · text

git.iko.soy/text

117 files changed+2209−5042

unifiedsplit

.gitignoredeleted−3

@@ -1,3 +0,0 @@

1−dist

2−cabal-dev

3−cabal.sandbox.config

.hgignore+3−9

@@ -1,14 +1,8 @@

1−^(?:dist|benchmarks/dist|tests/coverage|tests/dist)$

2−^benchmarks/.*\.txt$

1+^(?:dist|tests/benchmarks/dist|tests/tests/dist)$

2+^tests/benchmarks/.*\.txt$

33^tests/text-testdata.tar.bz2$

5−\.(?:aux|eventlog|h[ip]|log|[oa]|orig|prof|ps|rej|swp|tix)$

5+\.(?:aux|eventlog|h[ip]|log|[oa]|orig|prof|ps|rej|swp)$

66~$

7−

87syntax: glob

98.\#*

10−cabal-dev

11−cabal.sandbox.config

12−\.cabal-sandbox

13−scripts/CaseFolding.txt

14−scripts/SpecialCasing.txt

.hgtags−27

@@ -37,30 +37,3 @@ b75d3041d275e8e76b26605b0d426a572ddf1249 0.11.1.3

37378b981edd27befa4c2dd334fcb7db22ac67e22b67 0.11.1.11

3838204da16b5098531bdf858c388e2620238ef2aa5e 0.11.1.12

39396a3d847a56a69d0514a79cb212cb218271ad0917 0.11.1.13

40−1d2c6fa9092c6a4000b2abdd9d01f3efcd477be5 0.11.2.0

41−78219784cf3652cc662805bf2971bd62d80210a9 0.11.2.1

42−4297307ebc11ad677cfba6b40319e7e5e2c0cfee 0.11.2.3

43−7fa79662b66aade97fe49394977213fe6432942e 0.11.3.0

44−d99cd091cdf71ce807a4255f6cc509c3154f51ea 0.11.3.1

45−31f57612fd425d1bb56352ce6b79e41ce6699a45 1.0.0.0

46−7cba97c86467c1881dfced68613891f3c65561b0 1.0.0.1

47−62674a9bbc83145d1d7be28a05d456ab6bb5ff89 1.1.0.0

48−68a32d80c0829da164d1e6b3acedcc3efeda0957 1.1.0.1

49−6d863daafbf0e1289ec0a0eb9b4be2a0a9cb8d3d 1.1.1.0

50−fb7299f22449750c653ac64dee4bd63c13ea6e4c 1.1.1.1

51−eb170cb533b63534d166b5fd5344b36676adf140 1.1.1.2

52−e749e05f715d02445803f653cd3d97d5395d7c6f 1.1.1.3

53−b0dff8ca1142595bab489a768ca62e6a6805aac4 1.1.1.4

54−f8a60279237c1c28e094868740d9188dd94fcc9e 1.2.0.0

55−6231451979b2d33e28038b75f2dab19c9731f5c3 1.2.0.1

56−99a3503b4ad001fc1894e90286e96d7dea1e9195 1.2.0.2

57−47f138edf15576b9adaeed64784e30811099f202 1.2.0.3

58−0b064b0c69106bbcd13cb0099e72ae5fa2347bf0 1.2.0.4

59−8bbb3e222a0037035d893f731b0a23be449f7346 1.2.0.5

60−18c7f8e19872762b7e28ee1871e72f70ea54e3cd 1.2.0.6

61−42f751b87b4a187db93f595a8166d51746ff57d4 1.2.1.0

62−78227a84740b70dcd4cf7a65f3bcf603d87e48e2 1.2.1.1

63−40f268e6735749ef36f487e1d928eaa957bb431d 1.2.1.2

64−631fd055e27fa10983e17e9ad36d1b285b85c661 1.2.1.3

65−8221a68ed5ec37028357df9c6c25f52320e54ad9 1.2.2.0

66−ce1c5ac65eb9f5580114b4e380092b05a485e95d 1.2.2.1

Data/Text.hs+163−361

@@ -1,20 +1,15 @@

1−{-# LANGUAGE BangPatterns, CPP, MagicHash, Rank2Types, UnboxedTuples #-}

1+{-# LANGUAGE BangPatterns, CPP, Rank2Types, UnboxedTuples #-}

22{-# OPTIONS_GHC -fno-warn-orphans #-}

3−#if __GLASGOW_HASKELL__ >= 702

4−{-# LANGUAGE Trustworthy #-}

5−#endif

6−#if __GLASGOW_HASKELL__ >= 708

7−{-# LANGUAGE TypeFamilies #-}

8−#endif

104-- |

115-- Module : Data.Text

159--

1610-- License : BSD-style

17−-- Maintainer : bos@serpentine.com

11+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

12+-- duncan@haskell.org

1813-- Stability : experimental

1914-- Portability : GHC

2015--

@@ -32,8 +27,8 @@

3227--

3328-- To use an extended and very rich family of functions for working

3429-- with Unicode text (including normalization, regular expressions,

35−-- non-standard encodings, text breaking, and locales), see

36−-- <http://hackage.haskell.org/package/text-icu the text-icu package >.

30+-- non-standard encodings, text breaking, and locales), see the

31+-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>

3732

3833module Data.Text

3934 (

@@ -81,7 +76,6 @@ module Data.Text

8176 , toCaseFold

8277 , toLower

8378 , toUpper

84− , toTitle

8579

8680 -- ** Justification

8781 , justifyLeft

@@ -125,11 +119,8 @@ module Data.Text

125119

126120 -- ** Breaking strings

127121 , take

128− , takeEnd

129122 , drop

130− , dropEnd

131123 , takeWhile

132− , takeWhileEnd

133124 , dropWhile

134125 , dropWhileEnd

135126 , dropAround

@@ -176,110 +167,93 @@ module Data.Text

176167 , partition

177168

178169 -- , findSubstring

179−

170+

180171 -- * Indexing

181172 -- $index

182173 , index

183174 , findIndex

184175 , count

185176

186− -- * Zipping

177+ -- * Zipping and unzipping

187178 , zip

188179 , zipWith

189180

190181 -- -* Ordered text

191182 -- , sort

192−

193− -- * Low level operations

194− , copy

195− , unpackCString#

196183 ) where

197184

198185import Prelude (Char, Bool(..), Int, Maybe(..), String,

199186 Eq(..), Ord(..), Ordering(..), (++),

200− Read(..),

201− (&&), (||), (+), (-), (.), ($), ($!), (>>),

202− not, return, otherwise, quot)

187+ Read(..), Show(..),

188+ (&&), (||), (+), (-), (.), ($), ($!), (>>), (*),

189+ div, maxBound, not, return, otherwise)

203190#if defined(HAVE_DEEPSEQ)

204−import Control.DeepSeq (NFData(rnf))

191+import Control.DeepSeq (NFData)

205192#endif

206193#if defined(ASSERTS)

207194import Control.Exception (assert)

208195#endif

209196import Data.Char (isSpace)

210−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,

211− Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))

197+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))

198+#if __GLASGOW_HASKELL__ >= 612

199+import Data.Data (mkNoRepType)

200+#else

201+import Data.Data (mkNorepType)

202+#endif

212203import Control.Monad (foldM)

213−import Control.Monad.ST (ST)

214204import qualified Data.Text.Array as A

215205import qualified Data.List as L

216−import Data.Binary (Binary(get, put))

217206import Data.Monoid (Monoid(..))

218−#if MIN_VERSION_base(4,9,0)

219−import Data.Semigroup (Semigroup(..))

220−#endif

221207import Data.String (IsString(..))

222−import qualified Data.Text.Internal.Fusion as S

223−import qualified Data.Text.Internal.Fusion.Common as S

224−import Data.Text.Encoding (decodeUtf8', encodeUtf8)

225−import Data.Text.Internal.Fusion (stream, reverseStream, unstream)

226−import Data.Text.Internal.Private (span_)

227−import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)

228−import Data.Text.Show (singleton, unpack, unpackCString#)

208+import qualified Data.Text.Fusion as S

209+import qualified Data.Text.Fusion.Common as S

210+import Data.Text.Fusion (stream, reverseStream, unstream)

211+import Data.Text.Private (span_)

212+import Data.Text.Internal (Text(..), empty, firstf, safe, text, textP)

229213import qualified Prelude as P

230214import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,

231− reverseIter_, unsafeHead, unsafeTail)

232−import Data.Text.Internal.Unsafe.Char (unsafeChr)

233−import qualified Data.Text.Internal.Functions as F

234−import qualified Data.Text.Internal.Encoding.Utf16 as U16

235−import Data.Text.Internal.Search (indices)

215+ unsafeHead, unsafeTail)

216+import Data.Text.UnsafeChar (unsafeChr)

217+import qualified Data.Text.Util as U

218+import qualified Data.Text.Encoding.Utf16 as U16

219+import Data.Text.Search (indices)

236220#if defined(__HADDOCK__)

237221import Data.ByteString (ByteString)

238222import qualified Data.Text.Lazy as L

239223import Data.Int (Int64)

240224#endif

241−import GHC.Base (eqInt, neInt, gtInt, geInt, ltInt, leInt)

242−#if __GLASGOW_HASKELL__ >= 708

243−import qualified GHC.Exts as Exts

244−#endif

245−#if MIN_VERSION_base(4,7,0)

246−import Text.Printf (PrintfArg, formatArg, formatString)

247−#endif

248225

249226-- $strict

250227--

251228-- This package provides both strict and lazy 'Text' types. The

252−-- strict type is provided by the "Data.Text" module, while the lazy

253−-- type is provided by the "Data.Text.Lazy" module. Internally, the

229+-- strict type is provided by the 'Data.Text' package, while the lazy

230+-- type is provided by the 'Data.Text.Lazy' package. Internally, the

254231-- lazy @Text@ type consists of a list of strict chunks.

255232--

256233-- The strict 'Text' type requires that an entire string fit into

257−-- memory at once. The lazy 'Data.Text.Lazy.Text' type is capable of

258−-- streaming strings that are larger than memory using a small memory

259−-- footprint. In many cases, the overhead of chunked streaming makes

260−-- the lazy 'Data.Text.Lazy.Text' type slower than its strict

261−-- counterpart, but this is not always the case. Sometimes, the time

262−-- complexity of a function in one module may be different from the

263−-- other, due to their differing internal structures.

234+-- memory at once. The lazy @Text@ type is capable of streaming

235+-- strings that are larger than memory using a small memory footprint.

236+-- In many cases, the overhead of chunked streaming makes the lazy

237+-- @Text@ type slower than its strict counterpart, but this is not

238+-- always the case. Sometimes, the time complexity of a function in

239+-- one module may be different from the other, due to their differing

240+-- internal structures.

264241--

265242-- Each module provides an almost identical API, with the main

266243-- difference being that the strict module uses 'Int' values for

267−-- lengths and counts, while the lazy module uses 'Data.Int.Int64'

268−-- lengths.

244+-- lengths and counts, while the lazy module uses 'Int64' lengths.

269245

270246-- $replacement

271247--

272248-- A 'Text' value is a sequence of Unicode scalar values, as defined

273−-- in

274−-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.

275−-- As such, a 'Text' cannot contain values in the range U+D800 to

276−-- U+DFFF inclusive. Haskell implementations admit all Unicode code

277−-- points

278−-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)

279−-- as 'Char' values, including code points from this invalid range.

280−-- This means that there are some 'Char' values that are not valid

281−-- Unicode scalar values, and the functions in this module must handle

282−-- those cases.

249+-- in §3.9, definition D76 of the Unicode 5.2 standard:

250+-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35>. As

251+-- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF

252+-- inclusive. Haskell implementations admit all Unicode code points

253+-- (§3.4, definition D10) as 'Char' values, including code points

254+-- from this invalid range. This means that there are some 'Char'

255+-- values that are not valid Unicode scalar values, and the functions

256+-- in this module must handle those cases.

283257--

284258-- Within this module, many functions construct a 'Text' from one or

285259-- more 'Char' values. Those functions will substitute 'Char' values

@@ -293,8 +267,8 @@ import Text.Printf (PrintfArg, formatArg, formatString)

293267-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate

294268-- code points, and so cannot be represented. The functions replace

295269-- invalid scalar values, instead of dropping them, as a security

296−-- measure. For details, see

297−-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)

270+-- measure. For details, see Unicode Technical Report 36, §3.5:

271+-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters>)

298272

299273-- $fusion

300274--

@@ -312,11 +286,11 @@ import Text.Printf (PrintfArg, formatArg, formatString)

312286-- > countChars = T.length . T.toUpper . E.decodeUtf8

313287--

314288-- From the type signatures involved, this looks like it should

315−-- allocate one 'Data.ByteString.ByteString' value, and two 'Text'

316−-- values. However, when a module is compiled with optimisation

317−-- enabled under GHC, the two intermediate 'Text' values will be

318−-- optimised away, and the function will be compiled down to a single

319−-- loop over the source 'Data.ByteString.ByteString'.

289+-- allocate one 'ByteString' value, and two 'Text' values. However,

290+-- when a module is compiled with optimisation enabled under GHC, the

291+-- two intermediate 'Text' values will be optimised away, and the

292+-- function will be compiled down to a single loop over the source

293+-- 'ByteString'.

320294--

321295-- Functions that can be fused by the compiler are documented with the

322296-- phrase \"Subject to fusion\".

@@ -330,83 +304,46 @@ instance Eq Text where

330304instance Ord Text where

331305 compare = compareText

332306

307+instance Show Text where

308+ showsPrec p ps r = showsPrec p (unpack ps) r

309+

333310instance Read Text where

334311 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]

335312

336−#if MIN_VERSION_base(4,9,0)

337−-- Semigroup orphan instances for older GHCs are provided by

338−-- 'semigroups` package

339−

340−instance Semigroup Text where

341− (<>) = append

342−#endif

343−

344313instance Monoid Text where

345314 mempty = empty

346−#if MIN_VERSION_base(4,9,0)

347− mappend = (<>) -- future-proof definition

348−#else

349315 mappend = append

350−#endif

351316 mconcat = concat

352317

353318instance IsString Text where

354319 fromString = pack

355320

356−#if __GLASGOW_HASKELL__ >= 708

357−instance Exts.IsList Text where

358− type Item Text = Char

359− fromList = pack

360− toList = unpack

361−#endif

362−

363321#if defined(HAVE_DEEPSEQ)

364−instance NFData Text where rnf !_ = ()

322+instance NFData Text

365323#endif

366324

367−instance Binary Text where

368− put t = put (encodeUtf8 t)

369− get = do

370− bs <- get

371− case decodeUtf8' bs of

372− P.Left exn -> P.fail (P.show exn)

373− P.Right a -> P.return a

374−

375−-- | This instance preserves data abstraction at the cost of inefficiency.

325+-- This instance preserves data abstraction at the cost of inefficiency.

376326-- We omit reflection services for the sake of data abstraction.

327+--

328+-- This instance was created by copying the behavior of Data.Set and

329+-- Data.Map. If you feel a mistake has been made, please feel free to

330+-- submit improvements.

377331--

378−-- This instance was created by copying the updated behavior of

379−-- @"Data.Set".@'Data.Set.Set' and @"Data.Map".@'Data.Map.Map'. If you

380−-- feel a mistake has been made, please feel free to submit

381−-- improvements.

382−--

383−-- The original discussion is archived here:

384−-- <http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93 could we get a Data instance for Data.Text.Text? >

385−--

386−-- The followup discussion that changed the behavior of 'Data.Set.Set'

387−-- and 'Data.Map.Map' is archived here:

388−-- <http://markmail.org/message/trovdc6zkphyi3cr#query:+page:1+mid:a46der3iacwjcf6n+state:results Proposal: Allow gunfold for Data.Map, ... >

332+-- Original discussion is archived here:

333+

334+-- "could we get a Data instance for Data.Text.Text?"

335+-- http://groups.google.com/group/haskell-cafe/browse_thread/thread/b5bbb1b28a7e525d/0639d46852575b93

389336

390337instance Data Text where

391338 gfoldl f z txt = z pack `f` (unpack txt)

392− toConstr _ = packConstr

393− gunfold k z c = case constrIndex c of

394− 1 -> k (z pack)

395− _ -> P.error "gunfold"

396− dataTypeOf _ = textDataType

397−

398−#if MIN_VERSION_base(4,7,0)

399−-- | Only defined for @base-4.7.0.0@ and later

400−instance PrintfArg Text where

401− formatArg txt = formatString $ unpack txt

339+ toConstr _ = P.error "Data.Text.Text.toConstr"

340+ gunfold _ _ = P.error "Data.Text.Text.gunfold"

341+#if __GLASGOW_HASKELL__ >= 612

342+ dataTypeOf _ = mkNoRepType "Data.Text.Text"

343+#else

344+ dataTypeOf _ = mkNorepType "Data.Text.Text"

402345#endif

403346

404−packConstr :: Constr

405−packConstr = mkConstr textDataType "pack" [] Prefix

406−

407−textDataType :: DataType

408−textDataType = mkDataType "Data.Text.Text" [packConstr]

409−

410347-- | /O(n)/ Compare two 'Text' values lexicographically.

411348compareText :: Text -> Text -> Ordering

412349compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)

@@ -427,9 +364,20 @@ compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)

427364-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to

428365-- fusion. Performs replacement on invalid scalar values.

429366pack :: String -> Text

430−pack = unstream . S.map safe . S.streamList

367+pack = unstream . S.streamList . L.map safe

431368{-# INLINE [1] pack #-}

432369

370+-- | /O(n)/ Convert a Text into a String. Subject to fusion.

371+unpack :: Text -> String

372+unpack = S.unstreamList . stream

373+{-# INLINE [1] unpack #-}

374+

375+-- | /O(1)/ Convert a character into a Text. Subject to fusion.

376+-- Performs replacement on invalid scalar values.

377+singleton :: Char -> Text

378+singleton = unstream . S.singleton . safe

379+{-# INLINE [1] singleton #-}

380+

433381-- -----------------------------------------------------------------------------

434382-- * Basic functions

435383

@@ -460,13 +408,12 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)

460408 | otherwise = overflowError "append"

461409 where

462410 len = len1+len2

463− x :: ST s (A.MArray s)

464411 x = do

465412 arr <- A.new len

466413 A.copyI arr 0 arr1 off1 len1

467414 A.copyI arr len1 arr2 off2 len

468415 return arr

469−{-# NOINLINE append #-}

416+{-# INLINE append #-}

470417

471418{-# RULES

472419"TEXT append -> fused" [~1] forall t1 t2.

@@ -486,8 +433,8 @@ head t = S.head (stream t)

486433uncons :: Text -> Maybe (Char, Text)

487434uncons t@(Text arr off len)

488435 | len <= 0 = Nothing

489− | otherwise = Just $ let !(Iter c d) = iter t 0

490− in (c, text arr (off+d) (len-d))

436+ | otherwise = Just (c, textP arr (off+d) (len-d))

437+ where Iter c d = iter t 0

491438{-# INLINE [1] uncons #-}

492439

493440-- | Lifted from Control.Arrow and specialized.

@@ -517,7 +464,7 @@ last (Text arr off len)

517464tail :: Text -> Text

518465tail t@(Text arr off len)

519466 | len <= 0 = emptyError "tail"

520− | otherwise = text arr (off+d) (len-d)

467+ | otherwise = textP arr (off+d) (len-d)

521468 where d = iter_ t 0

522469{-# INLINE [1] tail #-}

523470

@@ -532,8 +479,8 @@ tail t@(Text arr off len)

532479-- be non-empty. Subject to fusion.

533480init :: Text -> Text

534481init (Text arr off len) | len <= 0 = emptyError "init"

535− | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)

536− | otherwise = text arr off (len-1)

482+ | n >= 0xDC00 && n <= 0xDFFF = textP arr off (len-2)

483+ | otherwise = textP arr off (len-1)

537484 where

538485 n = A.unsafeIndex arr (off+len-1)

539486{-# INLINE [1] init #-}

@@ -572,9 +519,7 @@ isSingleton = S.isSingleton . stream

572519-- Subject to fusion.

573520length :: Text -> Int

574521length t = S.length (stream t)

575−{-# INLINE [0] length #-}

576−-- length needs to be phased after the compareN/length rules otherwise

577−-- it may inline before the rules have an opportunity to fire.

522+{-# INLINE length #-}

578523

579524-- | /O(n)/ Compare the count of characters in a 'Text' to a number.

580525-- Subject to fusion.

@@ -593,32 +538,32 @@ compareLength t n = S.compareLengthI (stream t) n

593538

594539{-# RULES

595540"TEXT ==N/length -> compareLength/==EQ" [~1] forall t n.

596− eqInt (length t) n = compareLength t n == EQ

541+ (==) (length t) n = compareLength t n == EQ

597542 #-}

598543

599544{-# RULES

600545"TEXT /=N/length -> compareLength//=EQ" [~1] forall t n.

601− neInt (length t) n = compareLength t n /= EQ

546+ (/=) (length t) n = compareLength t n /= EQ

602547 #-}

603548

604549{-# RULES

605550"TEXT <N/length -> compareLength/==LT" [~1] forall t n.

606− ltInt (length t) n = compareLength t n == LT

551+ (<) (length t) n = compareLength t n == LT

607552 #-}

608553

609554{-# RULES

610555"TEXT <=N/length -> compareLength//=GT" [~1] forall t n.

611− leInt (length t) n = compareLength t n /= GT

556+ (<=) (length t) n = compareLength t n /= GT

612557 #-}

613558

614559{-# RULES

615560"TEXT >N/length -> compareLength/==GT" [~1] forall t n.

616− gtInt (length t) n = compareLength t n == GT

561+ (>) (length t) n = compareLength t n == GT

617562 #-}

618563

619564{-# RULES

620565"TEXT >=N/length -> compareLength//=LT" [~1] forall t n.

621− geInt (length t) n = compareLength t n /= LT

566+ (>=) (length t) n = compareLength t n /= LT

622567 #-}

623568

624569-- -----------------------------------------------------------------------------

@@ -634,7 +579,7 @@ map f t = unstream (S.map (safe . f) (stream t))

634579-- 'Text's and concatenates the list after interspersing the first

635580-- argument between each element of the list.

636581intercalate :: Text -> [Text] -> Text

637−intercalate t = concat . (F.intersperse t)

582+intercalate t = concat . (U.intersperse t)

638583{-# INLINE intercalate #-}

639584

640585-- | /O(n)/ The 'intersperse' function takes a character and places it

@@ -649,59 +594,16 @@ reverse :: Text -> Text

649594reverse t = S.reverse (stream t)

650595{-# INLINE reverse #-}

651596

652−-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in

653−-- @haystack@ with @replacement@.

654−--

655−-- This function behaves as though it was defined as follows:

656−--

657−-- @

658−-- replace needle replacement haystack =

659−-- 'intercalate' replacement ('splitOn' needle haystack)

660−-- @

661−--

662−-- As this suggests, each occurrence is replaced exactly once. So if

663−-- @needle@ occurs in @replacement@, that occurrence will /not/ itself

664−-- be replaced recursively:

665−--

666−-- > replace "oo" "foo" "oo" == "foo"

667−--

668−-- In cases where several instances of @needle@ overlap, only the

669−-- first one will be replaced:

670−--

671−-- > replace "ofo" "bar" "ofofo" == "barfo"

597+-- | /O(m+n)/ Replace every occurrence of one substring with another.

672598--

673599-- In (unlikely) bad cases, this function's time complexity degrades

674600-- towards /O(n*m)/.

675−replace :: Text

676− -- ^ @needle@ to search for. If this string is empty, an

677− -- error will occur.

678− -> Text

679− -- ^ @replacement@ to replace @needle@ with.

680− -> Text

681− -- ^ @haystack@ in which to search.

601+replace :: Text -- ^ Text to search for

602+ -> Text -- ^ Replacement text

603+ -> Text -- ^ Input text

682604 -> Text

683−replace needle@(Text _ _ neeLen)

684− (Text repArr repOff repLen)

685− haystack@(Text hayArr hayOff hayLen)

686− | neeLen == 0 = emptyError "replace"

687− | L.null ixs = haystack

688− | len > 0 = Text (A.run x) 0 len

689− | otherwise = empty

690− where

691− ixs = indices needle haystack

692− len = hayLen - (neeLen - repLen) `mul` L.length ixs

693− x :: ST s (A.MArray s)

694− x = do

695− marr <- A.new len

696− let loop (i:is) o d = do

697− let d0 = d + i - o

698− d1 = d0 + repLen

699− A.copyI marr d hayArr (hayOff+o) d0

700− A.copyI marr d0 repArr repOff d1

701− loop is (i + neeLen) d1

702− loop [] o d = A.copyI marr d hayArr (hayOff+o) len

703− loop ixs 0 0

704− return marr

605+replace s d = intercalate d . splitOn s

606+{-# INLINE replace #-}

705607

706608-- ----------------------------------------------------------------------------

707609-- ** Case conversions (folds)

@@ -720,13 +622,13 @@ replace needle@(Text _ _ neeLen)

720622-- /Note/: In some languages, case conversion is a locale- and

721623-- context-dependent operation. The case conversion functions in this

722624-- module are /not/ locale sensitive. Programs that require locale

723−-- sensitivity should use appropriate versions of the

724−-- <http://hackage.haskell.org/package/text-icu-0.6.3.7/docs/Data-Text-ICU.html#g:4 case mapping functions from the text-icu package >.

625+-- sensitivity should use appropriate versions of the case mapping

626+-- functions from the @text-icu@ package:

627+-- <http://hackage.haskell.org/package/text-icu>

725628

726−-- | /O(n)/ Convert a string to folded case. Subject to fusion.

727−--

728−-- This function is mainly useful for performing caseless (also known

729−-- as case insensitive) string comparisons.

629+-- | /O(n)/ Convert a string to folded case. This function is mainly

630+-- useful for performing caseless (also known as case insensitive)

631+-- string comparisons.

730632--

731633-- A string @x@ is a caseless match for a string @y@ if and only if:

732634--

@@ -741,51 +643,25 @@ replace needle@(Text _ _ neeLen)

741643-- instead of itself.

742644toCaseFold :: Text -> Text

743645toCaseFold t = unstream (S.toCaseFold (stream t))

744−{-# INLINE toCaseFold #-}

646+{-# INLINE [0] toCaseFold #-}

745647

746648-- | /O(n)/ Convert a string to lower case, using simple case

747−-- conversion. Subject to fusion.

748−--

749−-- The result string may be longer than the input string. For

750−-- instance, \"İ\" (Latin capital letter I with dot above,

751−-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)

752−-- followed by \" ̇\" (combining dot above, U+0307).

649+-- conversion. The result string may be longer than the input string.

650+-- For instance, \"İ\" (Latin capital letter I with dot above,

651+-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069) followed

652+-- by \" ̇\" (combining dot above, U+0307).

753653toLower :: Text -> Text

754654toLower t = unstream (S.toLower (stream t))

755655{-# INLINE toLower #-}

756656

757657-- | /O(n)/ Convert a string to upper case, using simple case

758−-- conversion. Subject to fusion.

759−--

760−-- The result string may be longer than the input string. For

761−-- instance, the German \"ß\" (eszett, U+00DF) maps to the

658+-- conversion. The result string may be longer than the input string.

659+-- For instance, the German \"ß\" (eszett, U+00DF) maps to the

762660-- two-letter sequence \"SS\".

763661toUpper :: Text -> Text

764662toUpper t = unstream (S.toUpper (stream t))

765663{-# INLINE toUpper #-}

766664

767−-- | /O(n)/ Convert a string to title case, using simple case

768−-- conversion. Subject to fusion.

769−--

770−-- The first letter of the input is converted to title case, as is

771−-- every subsequent letter that immediately follows a non-letter.

772−-- Every letter that immediately follows another letter is converted

773−-- to lower case.

774−--

775−-- The result string may be longer than the input string. For example,

776−-- the Latin small ligature ﬂ (U+FB02) is converted to the

777−-- sequence Latin capital letter F (U+0046) followed by Latin small

778−-- letter l (U+006C).

779−--

780−-- /Note/: this function does not take language or culture specific

781−-- rules into account. For instance, in English, different style

782−-- guides disagree on whether the book name \"The Hill of the Red

783−-- Fox\" is correctly title cased—but this function will

784−-- capitalize /every/ word.

785−toTitle :: Text -> Text

786−toTitle t = unstream (S.toTitle (stream t))

787−{-# INLINE toTitle #-}

788−

789665-- | /O(n)/ Left-justify a string to the given length, using the

790666-- specified fill character on the right. Subject to fusion.

791667-- Performs replacement on invalid scalar values.

@@ -836,7 +712,7 @@ center k c t

836712 | otherwise = replicateChar l c `append` t `append` replicateChar r c

837713 where len = length t

838714 d = k - len

839− r = d `quot` 2

715+ r = d `div` 2

840716 l = d - r

841717{-# INLINE center #-}

842718

@@ -901,7 +777,6 @@ concat ts = case ts' of

901777 where

902778 ts' = L.filter (not . null) ts

903779 len = sumP "concat" $ L.map lengthWord16 ts'

904− go :: ST s (A.MArray s)

905780 go = do

906781 arr <- A.new len

907782 let step i (Text a o l) =

@@ -915,13 +790,13 @@ concatMap f = concat . foldr ((:) . f) []

915790{-# INLINE concatMap #-}

916791

917792-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the

918−-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.

793+-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.

919794any :: (Char -> Bool) -> Text -> Bool

920795any p t = S.any p (stream t)

921796{-# INLINE any #-}

922797

923798-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the

924−-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.

799+-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.

925800all :: (Char -> Bool) -> Text -> Bool

926801all p t = S.all p (stream t)

927802{-# INLINE all #-}

@@ -1009,13 +884,13 @@ mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream

1009884-- @t@ repeated @n@ times.

1010885replicate :: Int -> Text -> Text

1011886replicate n t@(Text a o l)

1012− | n <= 0 || l <= 0 = empty

1013− | n == 1 = t

1014− | isSingleton t = replicateChar n (unsafeHead t)

1015− | otherwise = Text (A.run x) 0 len

887+ | n <= 0 || l <= 0 = empty

888+ | n == 1 = t

889+ | isSingleton t = replicateChar n (unsafeHead t)

890+ | n <= maxBound `div` l = Text (A.run x) 0 len

891+ | otherwise = overflowError "replicate"

1016892 where

1017− len = l `mul` n

1018− x :: ST s (A.MArray s)

893+ len = l * n

1019894 x = do

1020895 arr <- A.new len

1021896 let loop !d !i | i >= n = return arr

@@ -1066,16 +941,14 @@ take :: Int -> Text -> Text

1066941take n t@(Text arr off len)

1067942 | n <= 0 = empty

1068943 | n >= len = t

1069− | otherwise = text arr off (iterN n t)

944+ | otherwise = Text arr off (loop 0 0)

945+ where

946+ loop !i !cnt

947+ | i >= len || cnt >= n = i

948+ | otherwise = loop (i+d) (cnt+1)

949+ where d = iter_ t i

1070950{-# INLINE [1] take #-}

1071951

1072−iterN :: Int -> Text -> Int

1073−iterN n t@(Text _arr _off len) = loop 0 0

1074− where loop !i !cnt

1075− | i >= len || cnt >= n = i

1076− | otherwise = loop (i+d) (cnt+1)

1077− where d = iter_ t i

1078−

1079952{-# RULES

1080953"TEXT take -> fused" [~1] forall n t.

1081954 take n t = unstream (S.take n (stream t))

@@ -1083,27 +956,6 @@ iterN n t@(Text _arr _off len) = loop 0 0

1083956 unstream (S.take n (stream t)) = take n t

1084957 #-}

1085958

1086−-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after

1087−-- taking @n@ characters from the end of @t@.

1088−--

1089−-- Examples:

1090−--

1091−-- > takeEnd 3 "foobar" == "bar"

1092−takeEnd :: Int -> Text -> Text

1093−takeEnd n t@(Text arr off len)

1094− | n <= 0 = empty

1095− | n >= len = t

1096− | otherwise = text arr (off+i) (len-i)

1097− where i = iterNEnd n t

1098−

1099−iterNEnd :: Int -> Text -> Int

1100−iterNEnd n t@(Text _arr _off len) = loop (len-1) n

1101− where loop i !m

1102− | i <= 0 = 0

1103− | m <= 1 = i

1104− | otherwise = loop (i+d) (m-1)

1105− where d = reverseIter_ t i

1106−

1107959-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the

1108960-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@

1109961-- is greater than the length of the 'Text'. Subject to fusion.

@@ -1111,8 +963,11 @@ drop :: Int -> Text -> Text

1111963drop n t@(Text arr off len)

1112964 | n <= 0 = t

1113965 | n >= len = empty

1114− | otherwise = text arr (off+i) (len-i)

1115− where i = iterN n t

966+ | otherwise = loop 0 0

967+ where loop !i !cnt

968+ | i >= len || cnt >= n = Text arr (off+i) (len-i)

969+ | otherwise = loop (i+d) (cnt+1)

970+ where d = iter_ t i

1116971{-# INLINE [1] drop #-}

1117972

1118973{-# RULES

@@ -1122,18 +977,6 @@ drop n t@(Text arr off len)

1122977 unstream (S.drop n (stream t)) = drop n t

1123978 #-}

1124979

1125−-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after

1126−-- dropping @n@ characters from the end of @t@.

1127−--

1128−-- Examples:

1129−--

1130−-- > dropEnd 3 "foobar" == "foo"

1131−dropEnd :: Int -> Text -> Text

1132−dropEnd n t@(Text arr off len)

1133− | n <= 0 = t

1134− | n >= len = empty

1135− | otherwise = text arr off (iterNEnd n t)

1136−

1137980-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',

1138981-- returns the longest prefix (possibly empty) of elements that

1139982-- satisfy @p@. Subject to fusion.

@@ -1141,7 +984,7 @@ takeWhile :: (Char -> Bool) -> Text -> Text

1141984takeWhile p t@(Text arr off len) = loop 0

1142985 where loop !i | i >= len = t

1143986 | p c = loop (i+d)

1144− | otherwise = text arr off i

987+ | otherwise = textP arr off i

1145988 where Iter c d = iter t i

1146989{-# INLINE [1] takeWhile #-}

1147990

@@ -1152,27 +995,6 @@ takeWhile p t@(Text arr off len) = loop 0

1152995 unstream (S.takeWhile p (stream t)) = takeWhile p t

1153996 #-}

1154997

1155−-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',

1156−-- returns the longest suffix (possibly empty) of elements that

1157−-- satisfy @p@. Subject to fusion.

1158−-- Examples:

1159−--

1160−-- > takeWhileEnd (=='o') "foo" == "oo"

1161−takeWhileEnd :: (Char -> Bool) -> Text -> Text

1162−takeWhileEnd p t@(Text arr off len) = loop (len-1) len

1163− where loop !i !l | l <= 0 = t

1164− | p c = loop (i+d) (l+d)

1165− | otherwise = text arr (off+l) (len-l)

1166− where (c,d) = reverseIter t i

1167−{-# INLINE [1] takeWhileEnd #-}

1168−

1169−{-# RULES

1170−"TEXT takeWhileEnd -> fused" [~1] forall p t.

1171− takeWhileEnd p t = S.reverse (S.takeWhile p (S.reverseStream t))

1172−"TEXT takeWhileEnd -> unfused" [1] forall p t.

1173− S.reverse (S.takeWhile p (S.reverseStream t)) = takeWhileEnd p t

1174− #-}

1175−

1176998-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after

1177999-- 'takeWhile' @p@ @t@. Subject to fusion.

11781000dropWhile :: (Char -> Bool) -> Text -> Text

@@ -1191,9 +1013,8 @@ dropWhile p t@(Text arr off len) = loop 0 0

11911013 #-}

11921014

11931015-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after

1194−-- dropping characters that satisfy the predicate @p@ from the end of

1016+-- dropping characters that fail the predicate @p@ from the end of

11951017-- @t@. Subject to fusion.

1196−--

11971018-- Examples:

11981019--

11991020-- > dropWhileEnd (=='.') "foo..." == "foo"

@@ -1213,7 +1034,7 @@ dropWhileEnd p t@(Text arr off len) = loop (len-1) len

12131034 #-}

12141035

12151036-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after

1216−-- dropping characters that satisfy the predicate @p@ from both the

1037+-- dropping characters that fail the predicate @p@ from both the

12171038-- beginning and end of @t@. Subject to fusion.

12181039dropAround :: (Char -> Bool) -> Text -> Text

12191040dropAround p = dropWhile p . dropWhileEnd p

@@ -1248,8 +1069,13 @@ splitAt :: Int -> Text -> (Text, Text)

12481069splitAt n t@(Text arr off len)

12491070 | n <= 0 = (empty, t)

12501071 | n >= len = (t, empty)

1251− | otherwise = let k = iterN n t

1252− in (text arr off k, text arr (off+k) (len-k))

1072+ | otherwise = (Text arr off k, Text arr (off+k) (len-k))

1073+ where k = loop 0 0

1074+ loop !i !cnt

1075+ | i >= len || cnt >= n = i

1076+ | otherwise = loop (i+d) (cnt+1)

1077+ where d = iter_ t i

1078+{-# INLINE splitAt #-}

12531079

12541080-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns

12551081-- a pair whose first element is the longest prefix (possibly empty)

@@ -1284,7 +1110,7 @@ findAIndexOrEnd q t@(Text _arr _off len) = go 0

12841110 where go !i | i >= len || q c = i

12851111 | otherwise = go (i+d)

12861112 where Iter c d = iter t i

1287−

1113+

12881114-- | /O(n)/ Group characters in a string by equality.

12891115group :: Text -> [Text]

12901116group = groupBy (==)

@@ -1308,38 +1134,31 @@ tails t | null t = [empty]

13081134-- copies to create substrings; they just construct new 'Text's that

13091135-- are slices of the original.

13101136

1311−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'

1312−-- argument (which cannot be empty), consuming the delimiter. An empty

1313−-- delimiter is invalid, and will cause an error to be raised.

1137+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first

1138+-- 'Text' argument, consuming the delimiter. An empty delimiter is

1139+-- invalid, and will cause an error to be raised.

13141140--

13151141-- Examples:

13161142--

13171143-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]

13181144-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]

13191145-- > splitOn "x" "x" == ["",""]

1320−--

1146+--

13211147-- and

13221148--

13231149-- > intercalate s . splitOn s == id

13241150-- > splitOn (singleton c) == split (==c)

13251151--

1326−-- (Note: the string @s@ to split on above cannot be empty.)

1327−--

13281152-- In (unlikely) bad cases, this function's time complexity degrades

13291153-- towards /O(n*m)/.

1330−splitOn :: Text

1331− -- ^ String to split on. If this string is empty, an error

1332− -- will occur.

1333− -> Text

1334− -- ^ Input text.

1335− -> [Text]

1154+splitOn :: Text -> Text -> [Text]

13361155splitOn pat@(Text _ _ l) src@(Text arr off len)

13371156 | l <= 0 = emptyError "splitOn"

13381157 | isSingleton pat = split (== unsafeHead pat) src

13391158 | otherwise = go 0 (indices pat src)

13401159 where

1341− go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs

1342− go s _ = [text arr (s+off) (len-s)]

1160+ go !s (x:xs) = textP arr (s+off) (x-s) : go (x+l) xs

1161+ go s _ = [textP arr (s+off) (len-s)]

13431162{-# INLINE [1] splitOn #-}

13441163

13451164{-# RULES

@@ -1431,7 +1250,7 @@ breakOn pat src@(Text arr off len)

14311250 | null pat = emptyError "breakOn"

14321251 | otherwise = case indices pat src of

14331252 [] -> (src, empty)

1434− (x:_) -> (text arr off x, text arr (off+x) (len-x))

1253+ (x:_) -> (textP arr off x, textP arr (off+x) (len-x))

14351254{-# INLINE breakOn #-}

14361255

14371256-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the

@@ -1473,7 +1292,7 @@ breakOnAll pat src@(Text arr off slen)

14731292 | otherwise = L.map step (indices pat src)

14741293 where

14751294 step x = (chunk 0 x, chunk x (slen-x))

1476− chunk !n !l = text arr (n+off) l

1295+ chunk !n !l = textP arr (n+off) l

14771296{-# INLINE breakOnAll #-}

14781297

14791298-------------------------------------------------------------------------------

@@ -1540,7 +1359,7 @@ countChar c t = S.countChar c (stream t)

15401359-- equivalent to a pair of 'unpack' operations.

15411360zip :: Text -> Text -> [(Char,Char)]

15421361zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)

1543−{-# INLINE zip #-}

1362+{-# INLINE [0] zip #-}

15441363

15451364-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function

15461365-- given as the first argument, instead of a tupling function.

@@ -1548,7 +1367,7 @@ zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)

15481367zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text

15491368zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))

15501369 where g a b = safe (f a b)

1551−{-# INLINE zipWith #-}

1370+{-# INLINE [0] zipWith #-}

15521371

15531372-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's

15541373-- representing white space.

@@ -1673,7 +1492,7 @@ isInfixOf needle haystack

16731492-- > fnordLength _ = -1

16741493stripPrefix :: Text -> Text -> Maybe Text

16751494stripPrefix p@(Text _arr _off plen) t@(Text arr off len)

1676− | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)

1495+ | p `isPrefixOf` t = Just $! textP arr (off+plen) (len-plen)

16771496 | otherwise = Nothing

16781497

16791498-- | /O(n)/ Find the longest non-empty common prefix of two strings

@@ -1693,8 +1512,8 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0

16931512 where

16941513 go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)

16951514 | i > 0 = Just (Text arr0 off0 i,

1696− text arr0 (off0+i) (len0-i),

1697− text arr1 (off1+j) (len1-j))

1515+ textP arr0 (off0+i) (len0-i),

1516+ textP arr1 (off1+j) (len1-j))

16981517 | otherwise = Nothing

16991518 where Iter a d0 = iter t0 i

17001519 Iter b d1 = iter t1 j

@@ -1719,7 +1538,7 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0

17191538-- > quuxLength _ = -1

17201539stripSuffix :: Text -> Text -> Maybe Text

17211540stripSuffix p@(Text _arr _off plen) t@(Text arr off len)

1722− | p `isSuffixOf` t = Just $! text arr off (len-plen)

1541+ | p `isSuffixOf` t = Just $! textP arr off (len-plen)

17231542 | otherwise = Nothing

17241543

17251544-- | Add a list of non-negative numbers. Errors out on overflow.

@@ -1736,20 +1555,3 @@ emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"

17361555

17371556overflowError :: String -> a

17381557overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"

1739−

1740−-- | /O(n)/ Make a distinct copy of the given string, sharing no

1741−-- storage with the original string.

1742−--

1743−-- As an example, suppose you read a large string, of which you need

1744−-- only a small portion. If you do not use 'copy', the entire original

1745−-- array will be kept alive in memory by the smaller string. Making a

1746−-- copy \"breaks the link\" to the original array, allowing it to be

1747−-- garbage collected if there are no other live references to it.

1748−copy :: Text -> Text

1749−copy (Text arr off len) = Text (A.run go) 0 len

1750− where

1751− go :: ST s (A.MArray s)

1752− go = do

1753− marr <- A.new len

1754− A.copyI marr 0 arr off len

1755− return marr

Data/Text/Array.hs+11−15

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

77--

88-- License : BSD-style

9−-- Maintainer : bos@serpentine.com

9+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

10+-- duncan@haskell.org

1011-- Stability : experimental

1112-- Portability : portable

1213--

@@ -20,13 +21,13 @@

2021-- > import qualified Data.Text.Array as A

2122--

2223-- The names in this module resemble those in the 'Data.Array' family

23−-- of modules, but are shorter due to the assumption of qualified

24+-- of modules, but are shorter due to the assumption of qualifid

2425-- naming.

2526module Data.Text.Array

2627 (

2728 -- * Types

28− Array(Array, aBA)

29− , MArray(MArray, maBA)

29+ Array(aBA)

30+ , MArray(maBA)

3031

3132 -- * Functions

3233 , copyM

@@ -65,8 +66,8 @@ import Control.Monad.ST.Unsafe (unsafeIOToST)

6566import Control.Monad.ST (unsafeIOToST)

6667#endif

6768import Data.Bits ((.&.), xor)

68−import Data.Text.Internal.Unsafe (inlinePerformIO)

69−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)

69+import Data.Text.Unsafe.Base (inlinePerformIO)

70+import Data.Text.UnsafeShift (shiftL, shiftR)

7071#if __GLASGOW_HASKELL__ >= 703

7172import Foreign.C.Types (CInt(CInt), CSize(CSize))

7273#else

@@ -74,7 +75,7 @@ import Foreign.C.Types (CInt, CSize)

7475#endif

7576import GHC.Base (ByteArray#, MutableByteArray#, Int(..),

7677 indexWord16Array#, newByteArray#,

77− unsafeFreezeByteArray#, writeWord16Array#)

78+ unsafeCoerce#, writeWord16Array#)

7879import GHC.ST (ST(..), runST)

7980import GHC.Word (Word16(..))

8081import Prelude hiding (length, read)

@@ -113,7 +114,7 @@ instance IArray (MArray s) where

113114-- | Create an uninitialized mutable array.

114115new :: forall s. Int -> ST s (MArray s)

115116new n

116− | n < 0 || n .&. highBit /= 0 = array_size_error

117+ | n < 0 || n .&. highBit /= 0 = error $ "Data.Text.Array.new: size overflow"

117118 | otherwise = ST $ \s1# ->

118119 case newByteArray# len# s1# of

119120 (# s2#, marr# #) -> (# s2#, MArray marr#

@@ -125,14 +126,10 @@ new n

125126 highBit = maxBound `xor` (maxBound `shiftR` 1)

126127{-# INLINE new #-}

127128

128−array_size_error :: a

129−array_size_error = error "Data.Text.Array.new: size overflow"

130−

131129-- | Freeze a mutable array. Do not mutate the 'MArray' afterwards!

132130unsafeFreeze :: MArray s -> ST s Array

133−unsafeFreeze MArray{..} = ST $ \s1# ->

134− case unsafeFreezeByteArray# maBA s1# of

135− (# s2#, ba# #) -> (# s2#, Array ba#

131+unsafeFreeze MArray{..} = ST $ \s# ->

132+ (# s#, Array (unsafeCoerce# maBA)

136133#if defined(ASSERTS)

137134 maLen

138135#endif

@@ -184,7 +181,6 @@ run2 k = runST (do

184181 (marr,b) <- k

185182 arr <- unsafeFreeze marr

186183 return (arr,b))

187−{-# INLINE run2 #-}

188184

189185-- | Copy some elements of a mutable array.

190186copyM :: MArray s -- ^ Destination

Data/Text/Encoding.hs+97−296

@@ -1,8 +1,5 @@

1−{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, GeneralizedNewtypeDeriving, MagicHash,

1+{-# LANGUAGE BangPatterns, CPP, ForeignFunctionInterface, MagicHash,

22 UnliftedFFITypes #-}

3−#if __GLASGOW_HASKELL__ >= 702

4−{-# LANGUAGE Trustworthy #-}

5−#endif

63-- |

74-- Module : Data.Text.Encoding

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

118--

129-- License : BSD-style

13−-- Maintainer : bos@serpentine.com

10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

11+-- duncan@haskell.org

1412-- Stability : experimental

1513-- Portability : portable

1614--

@@ -25,7 +23,6 @@ module Data.Text.Encoding

2523 -- * Decoding ByteStrings to Text

2624 -- $strict

2725 decodeASCII

28− , decodeLatin1

2926 , decodeUtf8

3027 , decodeUtf16LE

3128 , decodeUtf16BE

@@ -42,59 +39,39 @@ module Data.Text.Encoding

4239 , decodeUtf32LEWith

4340 , decodeUtf32BEWith

4441

45− -- ** Stream oriented decoding

46− -- $stream

47− , streamDecodeUtf8

48− , streamDecodeUtf8With

49− , Decoding(..)

50−

5142 -- * Encoding Text to ByteStrings

5243 , encodeUtf8

5344 , encodeUtf16LE

5445 , encodeUtf16BE

5546 , encodeUtf32LE

5647 , encodeUtf32BE

57−

58− -- * Encoding Text using ByteString Builders

59− , encodeUtf8Builder

60− , encodeUtf8BuilderEscaped

6148 ) where

6249

50+import Control.Exception (evaluate, try)

6351#if __GLASGOW_HASKELL__ >= 702

6452import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)

6553#else

6654import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)

6755#endif

68−

69−import Control.Exception (evaluate, try)

70−import Control.Monad.ST (runST)

7156import Data.Bits ((.&.))

7257import Data.ByteString as B

73−import Data.ByteString.Internal as B hiding (c2w)

58+import Data.ByteString.Internal as B

7459import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)

75−import Data.Text.Internal (Text(..), safe, text)

76−import Data.Text.Internal.Private (runText)

77−import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)

78−import Data.Text.Internal.Unsafe.Shift (shiftR)

79−import Data.Text.Show ()

80−import Data.Text.Unsafe (unsafeDupablePerformIO)

81−import Data.Word (Word8, Word32)

82−import Foreign.C.Types (CSize(..))

60+import Data.Text.Internal (Text(..), textP)

61+import Data.Text.UnsafeChar (ord, unsafeWrite)

62+import Data.Text.UnsafeShift (shiftL, shiftR)

63+import Data.Word (Word8)

64+import Foreign.C.Types (CSize)

8365import Foreign.ForeignPtr (withForeignPtr)

8466import Foreign.Marshal.Utils (with)

85−import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)

86−import Foreign.Storable (Storable, peek, poke)

87−import GHC.Base (ByteArray#, MutableByteArray#)

88−import qualified Data.ByteString.Builder as B

89−import qualified Data.ByteString.Builder.Internal as B hiding (empty, append)

90−import qualified Data.ByteString.Builder.Prim as BP

91−import qualified Data.ByteString.Builder.Prim.Internal as BP

67+import Foreign.Ptr (Ptr, minusPtr, plusPtr)

68+import Foreign.Storable (peek, poke)

69+import GHC.Base (MutableByteArray#)

70+import System.IO.Unsafe (unsafePerformIO)

9271import qualified Data.Text.Array as A

93−import qualified Data.Text.Internal.Encoding.Fusion as E

94−import qualified Data.Text.Internal.Encoding.Utf16 as U16

95−import qualified Data.Text.Internal.Fusion as F

96−

97−#include "text_cbits.h"

72+import qualified Data.Text.Encoding.Fusion as E

73+import qualified Data.Text.Encoding.Utf16 as U16

74+import qualified Data.Text.Fusion as F

9875

9976-- $strict

10077--

@@ -111,181 +88,40 @@ import qualified Data.Text.Internal.Fusion as F

11188

11289-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII

11390-- encoded text.

91+--

92+-- This function is deprecated. Use 'decodeUtf8' instead.

11493decodeASCII :: ByteString -> Text

11594decodeASCII = decodeUtf8

11695{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}

11796

118−-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.

119−--

120−-- 'decodeLatin1' is semantically equivalent to

121−-- @Data.Text.pack . Data.ByteString.Char8.unpack@

122−decodeLatin1 :: ByteString -> Text

123−decodeLatin1 (PS fp off len) = text a 0 len

124− where

125− a = A.run (A.new len >>= unsafeIOToST . go)

126− go dest = withForeignPtr fp $ \ptr -> do

127− c_decode_latin1 (A.maBA dest) (ptr `plusPtr` off) (ptr `plusPtr` (off+len))

128− return dest

129−

13097-- | Decode a 'ByteString' containing UTF-8 encoded text.

13198decodeUtf8With :: OnDecodeError -> ByteString -> Text

132−decodeUtf8With onErr (PS fp off len) = runText $ \done -> do

133− let go dest = withForeignPtr fp $ \ptr ->

134− with (0::CSize) $ \destOffPtr -> do

135− let end = ptr `plusPtr` (off + len)

136− loop curPtr = do

137− curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end

138− if curPtr' == end

139− then do

140− n <- peek destOffPtr

141− unsafeSTToIO (done dest (fromIntegral n))

142− else do

143− x <- peek curPtr'

144− case onErr desc (Just x) of

145− Nothing -> loop $ curPtr' `plusPtr` 1

146− Just c -> do

147− destOff <- peek destOffPtr

148− w <- unsafeSTToIO $

149− unsafeWrite dest (fromIntegral destOff) (safe c)

150− poke destOffPtr (destOff + fromIntegral w)

151− loop $ curPtr' `plusPtr` 1

152− loop (ptr `plusPtr` off)

153− (unsafeIOToST . go) =<< A.new len

99+decodeUtf8With onErr (PS fp off len) = textP (fst a) 0 (snd a)

154100 where

155− desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"

101+ a = A.run2 (A.new len >>= unsafeIOToST . go)

102+ desc = "Data.Text.Encoding.decodeUtf8: Invalid UTF-8 stream"

103+ go dest = withForeignPtr fp $ \ptr ->

104+ with (0::CSize) $ \destOffPtr -> do

105+ let end = ptr `plusPtr` (off + len)

106+ loop curPtr = do

107+ curPtr' <- c_decode_utf8 (A.maBA dest) destOffPtr curPtr end

108+ if curPtr' == end

109+ then do

110+ n <- peek destOffPtr

111+ return (dest,fromIntegral n)

112+ else do

113+ x <- peek curPtr'

114+ case onErr desc (Just x) of

115+ Nothing -> loop $ curPtr' `plusPtr` 1

116+ Just c -> do

117+ destOff <- peek destOffPtr

118+ w <- unsafeSTToIO $

119+ unsafeWrite dest (fromIntegral destOff) c

120+ poke destOffPtr (destOff + fromIntegral w)

121+ loop $ curPtr' `plusPtr` 1

122+ loop (ptr `plusPtr` off)

156123{- INLINE[0] decodeUtf8With #-}

157124

158−-- $stream

159−--

160−-- The 'streamDecodeUtf8' and 'streamDecodeUtf8With' functions accept

161−-- a 'ByteString' that represents a possibly incomplete input (e.g. a

162−-- packet from a network stream) that may not end on a UTF-8 boundary.

163−--

164−-- 1. The maximal prefix of 'Text' that could be decoded from the

165−-- given input.

166−--

167−-- 2. The suffix of the 'ByteString' that could not be decoded due to

168−-- insufficient input.

169−--

170−-- 3. A function that accepts another 'ByteString'. That string will

171−-- be assumed to directly follow the string that was passed as

172−-- input to the original function, and it will in turn be decoded.

173−--

174−-- To help understand the use of these functions, consider the Unicode

175−-- string @\"hi ☃\"@. If encoded as UTF-8, this becomes @\"hi

176−-- \\xe2\\x98\\x83\"@; the final @\'☃\'@ is encoded as 3 bytes.

177−--

178−-- Now suppose that we receive this encoded string as 3 packets that

179−-- are split up on untidy boundaries: @[\"hi \\xe2\", \"\\x98\",

180−-- \"\\x83\"]@. We cannot decode the entire Unicode string until we

181−-- have received all three packets, but we would like to make progress

182−-- as we receive each one.

183−--

184−-- @

185−-- ghci> let s0\@('Some' _ _ f0) = 'streamDecodeUtf8' \"hi \\xe2\"

186−-- ghci> s0

187−-- 'Some' \"hi \" \"\\xe2\" _

188−-- @

189−--

190−-- We use the continuation @f0@ to decode our second packet.

191−--

192−-- @

193−-- ghci> let s1\@('Some' _ _ f1) = f0 \"\\x98\"

194−-- ghci> s1

195−-- 'Some' \"\" \"\\xe2\\x98\"

196−-- @

197−--

198−-- We could not give @f0@ enough input to decode anything, so it

199−-- returned an empty string. Once we feed our second continuation @f1@

200−-- the last byte of input, it will make progress.

201−--

202−-- @

203−-- ghci> let s2\@('Some' _ _ f2) = f1 \"\\x83\"

204−-- ghci> s2

205−-- 'Some' \"\\x2603\" \"\" _

206−-- @

207−--

208−-- If given invalid input, an exception will be thrown by the function

209−-- or continuation where it is encountered.

210−

211−-- | A stream oriented decoding result.

212−data Decoding = Some Text ByteString (ByteString -> Decoding)

213−

214−instance Show Decoding where

215− showsPrec d (Some t bs _) = showParen (d > prec) $

216− showString "Some " . showsPrec prec' t .

217− showChar ' ' . showsPrec prec' bs .

218− showString " _"

219− where prec = 10; prec' = prec + 1

220−

221−newtype CodePoint = CodePoint Word32 deriving (Eq, Show, Num, Storable)

222−newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)

223−

224−-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8

225−-- encoded text that is known to be valid.

226−--

227−-- If the input contains any invalid UTF-8 data, an exception will be

228−-- thrown (either by this function or a continuation) that cannot be

229−-- caught in pure code. For more control over the handling of invalid

230−-- data, use 'streamDecodeUtf8With'.

231−streamDecodeUtf8 :: ByteString -> Decoding

232−streamDecodeUtf8 = streamDecodeUtf8With strictDecode

233−

234−-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8

235−-- encoded text.

236−streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding

237−streamDecodeUtf8With onErr = decodeChunk B.empty 0 0

238− where

239− -- We create a slightly larger than necessary buffer to accommodate a

240− -- potential surrogate pair started in the last buffer

241− decodeChunk :: ByteString -> CodePoint -> DecoderState -> ByteString

242− -> Decoding

243− decodeChunk undecoded0 codepoint0 state0 bs@(PS fp off len) =

244− runST $ (unsafeIOToST . decodeChunkToBuffer) =<< A.new (len+1)

245− where

246− decodeChunkToBuffer :: A.MArray s -> IO Decoding

247− decodeChunkToBuffer dest = withForeignPtr fp $ \ptr ->

248− with (0::CSize) $ \destOffPtr ->

249− with codepoint0 $ \codepointPtr ->

250− with state0 $ \statePtr ->

251− with nullPtr $ \curPtrPtr ->

252− let end = ptr `plusPtr` (off + len)

253− loop curPtr = do

254− poke curPtrPtr curPtr

255− curPtr' <- c_decode_utf8_with_state (A.maBA dest) destOffPtr

256− curPtrPtr end codepointPtr statePtr

257− state <- peek statePtr

258− case state of

259− UTF8_REJECT -> do

260− -- We encountered an encoding error

261− x <- peek curPtr'

262− poke statePtr 0

263− case onErr desc (Just x) of

264− Nothing -> loop $ curPtr' `plusPtr` 1

265− Just c -> do

266− destOff <- peek destOffPtr

267− w <- unsafeSTToIO $

268− unsafeWrite dest (fromIntegral destOff) (safe c)

269− poke destOffPtr (destOff + fromIntegral w)

270− loop $ curPtr' `plusPtr` 1

271−

272− _ -> do

273− -- We encountered the end of the buffer while decoding

274− n <- peek destOffPtr

275− codepoint <- peek codepointPtr

276− chunkText <- unsafeSTToIO $ do

277− arr <- A.unsafeFreeze dest

278− return $! text arr 0 (fromIntegral n)

279− lastPtr <- peek curPtrPtr

280− let left = lastPtr `minusPtr` curPtr

281− !undecoded = case state of

282− UTF8_ACCEPT -> B.empty

283− _ -> B.append undecoded0 (B.drop left bs)

284− return $ Some chunkText undecoded

285− (decodeChunk undecoded codepoint state)

286− in loop (ptr `plusPtr` off)

287− desc = "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream"

288−

289125-- | Decode a 'ByteString' containing UTF-8 encoded text that is known

290126-- to be valid.

291127--

@@ -299,93 +135,69 @@ decodeUtf8 = decodeUtf8With strictDecode

299135{-# RULES "STREAM stream/decodeUtf8 fusion" [1]

300136 forall bs. F.stream (decodeUtf8 bs) = E.streamUtf8 strictDecode bs #-}

301137

302−-- | Decode a 'ByteString' containing UTF-8 encoded text.

138+-- | Decode a 'ByteString' containing UTF-8 encoded text..

303139--

304140-- If the input contains any invalid UTF-8 data, the relevant

305141-- exception will be returned, otherwise the decoded text.

306142decodeUtf8' :: ByteString -> Either UnicodeException Text

307−decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode

143+decodeUtf8' = unsafePerformIO . try . evaluate . decodeUtf8With strictDecode

308144{-# INLINE decodeUtf8' #-}

309145

310−-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.

311−encodeUtf8Builder :: Text -> B.Builder

312−encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)

313−

314−-- | Encode text using UTF-8 encoding and escape the ASCII characters using

315−-- a 'BP.BoundedPrim'.

316−--

317−-- Use this function is to implement efficient encoders for text-based formats

318−-- like JSON or HTML.

319−{-# INLINE encodeUtf8BuilderEscaped #-}

320−-- TODO: Extend documentation with references to source code in @blaze-html@

321−-- or @aeson@ that uses this function.

322−encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder

323−encodeUtf8BuilderEscaped be =

324− -- manual eta-expansion to ensure inlining works as expected

325− \txt -> B.builder (mkBuildstep txt)

326− where

327− bound = max 4 $ BP.sizeBound be

328−

329− mkBuildstep (Text arr off len) !k =

330− outerLoop off

331− where

332− iend = off + len

333−

334− outerLoop !i0 !br@(B.BufferRange op0 ope)

335− | i0 >= iend = k br

336− | outRemaining > 0 = goPartial (i0 + min outRemaining inpRemaining)

337− -- TODO: Use a loop with an integrated bound's check if outRemaining

338− -- is smaller than 8, as this will save on divisions.

339− | otherwise = return $ B.bufferFull bound op0 (outerLoop i0)

340− where

341− outRemaining = (ope `minusPtr` op0) `div` bound

342− inpRemaining = iend - i0

343−

344− goPartial !iendTmp = go i0 op0

345− where

346− go !i !op

347− | i < iendTmp = case A.unsafeIndex arr i of

348− w | w <= 0x7F -> do

349− BP.runB be (fromIntegral w) op >>= go (i + 1)

350− | w <= 0x7FF -> do

351− poke8 0 $ (w `shiftR` 6) + 0xC0

352− poke8 1 $ (w .&. 0x3f) + 0x80

353− go (i + 1) (op `plusPtr` 2)

354− | 0xD800 <= w && w <= 0xDBFF -> do

355− let c = ord $ U16.chr2 w (A.unsafeIndex arr (i+1))

356− poke8 0 $ (c `shiftR` 18) + 0xF0

357− poke8 1 $ ((c `shiftR` 12) .&. 0x3F) + 0x80

358− poke8 2 $ ((c `shiftR` 6) .&. 0x3F) + 0x80

359− poke8 3 $ (c .&. 0x3F) + 0x80

360− go (i + 2) (op `plusPtr` 4)

361− | otherwise -> do

362− poke8 0 $ (w `shiftR` 12) + 0xE0

363− poke8 1 $ ((w `shiftR` 6) .&. 0x3F) + 0x80

364− poke8 2 $ (w .&. 0x3F) + 0x80

365− go (i + 1) (op `plusPtr` 3)

366− | otherwise =

367− outerLoop i (B.BufferRange op ope)

368− where

369− poke8 j v = poke (op `plusPtr` j) (fromIntegral v :: Word8)

370−

371146-- | Encode text using UTF-8 encoding.

372147encodeUtf8 :: Text -> ByteString

373−encodeUtf8 (Text arr off len)

374− | len == 0 = B.empty

375− | otherwise = unsafeDupablePerformIO $ do

376− fp <- mallocByteString (len*4)

377− withForeignPtr fp $ \ptr ->

378− with ptr $ \destPtr -> do

379− c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)

380− newDest <- peek destPtr

381− let utf8len = newDest `minusPtr` ptr

382− if utf8len >= len `shiftR` 1

383− then return (PS fp 0 utf8len)

384− else do

385− fp' <- mallocByteString utf8len

386− withForeignPtr fp' $ \ptr' -> do

387− memcpy ptr' ptr (fromIntegral utf8len)

388− return (PS fp' 0 utf8len)

148+encodeUtf8 (Text arr off len) = unsafePerformIO $ do

149+ let size0 = max len 4

150+ mallocByteString size0 >>= start size0 off 0

151+ where

152+ start size n0 m0 fp = withForeignPtr fp $ loop n0 m0

153+ where

154+ loop n1 m1 ptr = go n1 m1

155+ where

156+ offLen = off + len

157+ go !n !m

158+ | n == offLen = return (PS fp 0 m)

159+ | otherwise = do

160+ let poke8 k v = poke (ptr `plusPtr` k) (fromIntegral v :: Word8)

161+ ensure k act

162+ | size-m >= k = act

163+ | otherwise = {-# SCC "resizeUtf8/ensure" #-} do

164+ let newSize = size `shiftL` 1

165+ fp' <- mallocByteString newSize

166+ withForeignPtr fp' $ \ptr' ->

167+ memcpy ptr' ptr (fromIntegral m)

168+ start newSize n m fp'

169+ {-# INLINE ensure #-}

170+ case A.unsafeIndex arr n of

171+ w| w <= 0x7F -> ensure 1 $ do

172+ poke (ptr `plusPtr` m) (fromIntegral w :: Word8)

173+ -- A single ASCII octet is likely to start a run of

174+ -- them. We see better performance when we

175+ -- special-case this assumption.

176+ let end = ptr `plusPtr` size

177+ ascii !t !u

178+ | t == offLen || u == end || v >= 0x80 =

179+ go t (u `minusPtr` ptr)

180+ | otherwise = do

181+ poke u (fromIntegral v :: Word8)

182+ ascii (t+1) (u `plusPtr` 1)

183+ where v = A.unsafeIndex arr t

184+ ascii (n+1) (ptr `plusPtr` (m+1))

185+ | w <= 0x7FF -> ensure 2 $ do

186+ poke8 m $ (w `shiftR` 6) + 0xC0

187+ poke8 (m+1) $ (w .&. 0x3f) + 0x80

188+ go (n+1) (m+2)

189+ | 0xD800 <= w && w <= 0xDBFF -> ensure 4 $ do

190+ let c = ord $ U16.chr2 w (A.unsafeIndex arr (n+1))

191+ poke8 m $ (c `shiftR` 18) + 0xF0

192+ poke8 (m+1) $ ((c `shiftR` 12) .&. 0x3F) + 0x80

193+ poke8 (m+2) $ ((c `shiftR` 6) .&. 0x3F) + 0x80

194+ poke8 (m+3) $ (c .&. 0x3F) + 0x80

195+ go (n+2) (m+4)

196+ | otherwise -> ensure 3 $ do

197+ poke8 m $ (w `shiftR` 12) + 0xE0

198+ poke8 (m+1) $ ((w `shiftR` 6) .&. 0x3F) + 0x80

199+ poke8 (m+2) $ (w .&. 0x3F) + 0x80

200+ go (n+1) (m+3)

389201

390202-- | Decode text from little endian UTF-16 encoding.

391203decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text

@@ -466,14 +278,3 @@ encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))

466278foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8

467279 :: MutableByteArray# s -> Ptr CSize

468280 -> Ptr Word8 -> Ptr Word8 -> IO (Ptr Word8)

469−

470−foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_state

471− :: MutableByteArray# s -> Ptr CSize

472− -> Ptr (Ptr Word8) -> Ptr Word8

473− -> Ptr CodePoint -> Ptr DecoderState -> IO (Ptr Word8)

474−

475−foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1

476− :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()

477−

478−foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8

479− :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()

Data/Text/Encoding/Error.hs+7−16

@@ -1,15 +1,11 @@

11{-# LANGUAGE CPP, DeriveDataTypeable #-}

2−#if __GLASGOW_HASKELL__ >= 704

3−{-# LANGUAGE Safe #-}

4−#elif __GLASGOW_HASKELL__ >= 702

5−{-# LANGUAGE Trustworthy #-}

6−#endif

72-- |

83-- Module : Data.Text.Encoding.Error

94-- Copyright : (c) Bryan O'Sullivan 2009

105--

116-- License : BSD-style

12−-- Maintainer : bos@serpentine.com

7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

8+-- duncan@haskell.org

139-- Stability : experimental

1410-- Portability : GHC

1511--

@@ -39,8 +35,11 @@ module Data.Text.Encoding.Error

3935 , replace

4036 ) where

4137

42−import Control.DeepSeq (NFData (..))

38+#if __GLASGOW_HASKELL__ >= 610

4339import Control.Exception (Exception, throw)

40+#else

41+import Control.Exception.Extensible (Exception, throw)

42+#endif

4443import Data.Typeable (Typeable)

4544import Data.Word (Word8)

4645import Numeric (showHex)

@@ -68,7 +67,6 @@ type OnError a b = String -> Maybe a -> Maybe b

6867type OnDecodeError = OnError Word8 Char

6968

7069-- | A handler for an encoding error.

71−{-# DEPRECATED OnEncodeError "This exception is never used in practice, and will be removed." #-}

7270type OnEncodeError = OnError Char Word8

7371

7472-- | An exception type for representing Unicode encoding errors.

@@ -81,8 +79,6 @@ data UnicodeException =

8179 -- under the given encoding, or ran out of input in mid-encode.

8280 deriving (Eq, Typeable)

8381

84−{-# DEPRECATED EncodeError "This constructor is never used, and will be removed." #-}

85−

8682showUnicodeException :: UnicodeException -> String

8783showUnicodeException (DecodeError desc (Just w))

8884 = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)

@@ -92,16 +88,12 @@ showUnicodeException (EncodeError desc (Just c))

9288 = "Cannot encode character '\\x" ++ showHex (fromEnum c) ("': " ++ desc)

9389showUnicodeException (EncodeError desc Nothing)

9490 = "Cannot encode input: " ++ desc

95−

91+

9692instance Show UnicodeException where

9793 show = showUnicodeException

9894

9995instance Exception UnicodeException

10096

101−instance NFData UnicodeException where

102− rnf (DecodeError desc w) = rnf desc `seq` rnf w `seq` ()

103− rnf (EncodeError desc c) = rnf desc `seq` rnf c `seq` ()

104−

10597-- | Throw a 'UnicodeException' if decoding fails.

10698strictDecode :: OnDecodeError

10799strictDecode desc c = throw (DecodeError desc c)

@@ -112,7 +104,6 @@ lenientDecode :: OnDecodeError

112104lenientDecode _ _ = Just '\xfffd'

113105

114106-- | Throw a 'UnicodeException' if encoding fails.

115−{-# DEPRECATED strictEncode "This function always throws an exception, and will be removed." #-}

116107strictEncode :: OnEncodeError

117108strictEncode desc c = throw (EncodeError desc c)

118109

Data/Text/Internal/Encoding/Fusion.hs → Data/Text/Encoding/Fusion.hsrenamed+16−19

@@ -1,24 +1,21 @@

11{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}

33-- |

4−-- Module : Data.Text.Internal.Encoding.Fusion

4+-- Module : Data.Text.Encoding.Fusion

55-- Copyright : (c) Tom Harper 2008-2009,

66-- (c) Bryan O'Sullivan 2009,

77-- (c) Duncan Coutts 2009

88--

99-- License : BSD-style

10−-- Maintainer : bos@serpentine.com

10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

11+-- duncan@haskell.org

1112-- Stability : experimental

1213-- Portability : portable

1314--

14−-- /Warning/: this is an internal module, and does not have a stable

15−-- API or name. Functions in this module may not check or enforce

16−-- preconditions expected by public modules. Use at your own risk!

17−--

1815-- Fusible 'Stream'-oriented functions for converting between 'Text'

1916-- and several common encodings.

2017

21−module Data.Text.Internal.Encoding.Fusion

18+module Data.Text.Encoding.Fusion

2219 (

2320 -- * Streaming

2421 streamASCII

@@ -31,28 +28,28 @@ module Data.Text.Internal.Encoding.Fusion

3128 -- * Unstreaming

3229 , unstream

3330

34− , module Data.Text.Internal.Encoding.Fusion.Common

31+ , module Data.Text.Encoding.Fusion.Common

3532 ) where

3633

3734#if defined(ASSERTS)

3835import Control.Exception (assert)

3936#endif

4037import Data.ByteString.Internal (ByteString(..), mallocByteString, memcpy)

41−import Data.Text.Internal.Fusion (Step(..), Stream(..))

42−import Data.Text.Internal.Fusion.Size

38+import Data.Text.Fusion (Step(..), Stream(..))

39+import Data.Text.Fusion.Size

4340import Data.Text.Encoding.Error

44−import Data.Text.Internal.Encoding.Fusion.Common

45−import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)

46−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)

41+import Data.Text.Encoding.Fusion.Common

42+import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)

43+import Data.Text.UnsafeShift (shiftL, shiftR)

4744import Data.Word (Word8, Word16, Word32)

4845import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

4946import Foreign.Storable (pokeByteOff)

47+import System.IO.Unsafe (unsafePerformIO)

5048import qualified Data.ByteString as B

5149import qualified Data.ByteString.Unsafe as B

52−import qualified Data.Text.Internal.Encoding.Utf8 as U8

53−import qualified Data.Text.Internal.Encoding.Utf16 as U16

54−import qualified Data.Text.Internal.Encoding.Utf32 as U32

55−import Data.Text.Unsafe (unsafeDupablePerformIO)

50+import qualified Data.Text.Encoding.Utf8 as U8

51+import qualified Data.Text.Encoding.Utf16 as U16

52+import qualified Data.Text.Encoding.Utf32 as U32

5653

5754streamASCII :: ByteString -> Stream Char

5855streamASCII bs = Stream next 0 (maxSize l)

@@ -166,7 +163,7 @@ streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))

166163

167164-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.

168165unstream :: Stream Word8 -> ByteString

169−unstream (Stream next s0 len) = unsafeDupablePerformIO $ do

166+unstream (Stream next s0 len) = unsafePerformIO $ do

170167 let mlen = upperBound 4 len

171168 mallocByteString mlen >>= loop mlen 0 s0

172169 where

@@ -204,5 +201,5 @@ decodeError func kind onErr mb i =

204201 case onErr desc mb of

205202 Nothing -> Skip i

206203 Just c -> Yield c i

207− where desc = "Data.Text.Internal.Encoding.Fusion." ++ func ++ ": Invalid " ++

204+ where desc = "Data.Text.Encoding.Fusion." ++ func ++ ": Invalid " ++

208205 kind ++ " stream"

Data/Text/Internal/Encoding/Fusion/Common.hs → Data/Text/Encoding/Fusion/Common.hsrenamed+35−11

@@ -1,40 +1,64 @@

11{-# LANGUAGE BangPatterns #-}

33-- |

4−-- Module : Data.Text.Internal.Encoding.Fusion.Common

4+-- Module : Data.Text.Encoding.Fusion.Common

55-- Copyright : (c) Tom Harper 2008-2009,

66-- (c) Bryan O'Sullivan 2009,

77-- (c) Duncan Coutts 2009,

88-- (c) Jasper Van der Jeugt 2011

99--

1010-- License : BSD-style

11−-- Maintainer : bos@serpentine.com

11+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

12+-- duncan@haskell.org

1213-- Stability : experimental

1314-- Portability : portable

1415--

15−-- /Warning/: this is an internal module, and does not have a stable

16−-- API or name. Use at your own risk!

17−--

1816-- Fusible 'Stream'-oriented functions for converting between 'Text'

1917-- and several common encodings.

2018

21−module Data.Text.Internal.Encoding.Fusion.Common

19+module Data.Text.Encoding.Fusion.Common

2220 (

2321 -- * Restreaming

2422 -- Restreaming is the act of converting from one 'Stream'

2523 -- representation to another.

26− restreamUtf16LE

24+ restreamUtf8

25+ , restreamUtf16LE

2726 , restreamUtf16BE

2827 , restreamUtf32LE

2928 , restreamUtf32BE

3029 ) where

3130

3231import Data.Bits ((.&.))

33−import Data.Text.Internal.Fusion (Step(..), Stream(..))

34−import Data.Text.Internal.Fusion.Types (RS(..))

35−import Data.Text.Internal.Unsafe.Char (ord)

36−import Data.Text.Internal.Unsafe.Shift (shiftR)

32+import Data.Text.Fusion (Step(..), Stream(..))

33+import Data.Text.Fusion.Internal (RS(..))

34+import Data.Text.UnsafeChar (ord)

35+import Data.Text.UnsafeShift (shiftR)

3736import Data.Word (Word8)

37+import qualified Data.Text.Encoding.Utf8 as U8

38+

39+-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.

40+restreamUtf8 :: Stream Char -> Stream Word8

41+restreamUtf8 (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

42+ where

43+ next (RS0 s) = case next0 s of

44+ Done -> Done

45+ Skip s' -> Skip (RS0 s')

46+ Yield x s'

47+ | n <= 0x7F -> Yield c (RS0 s')

48+ | n <= 0x07FF -> Yield a2 (RS1 s' b2)

49+ | n <= 0xFFFF -> Yield a3 (RS2 s' b3 c3)

50+ | otherwise -> Yield a4 (RS3 s' b4 c4 d4)

51+ where

52+ n = ord x

53+ c = fromIntegral n

54+ (a2,b2) = U8.ord2 x

55+ (a3,b3,c3) = U8.ord3 x

56+ (a4,b4,c4,d4) = U8.ord4 x

57+ next (RS1 s x2) = Yield x2 (RS0 s)

58+ next (RS2 s x2 x3) = Yield x2 (RS1 s x3)

59+ next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)

60+ {-# INLINE next #-}

61+{-# INLINE restreamUtf8 #-}

3862

3963restreamUtf16BE :: Stream Char -> Stream Word8

4064restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

Data/Text/Internal/Encoding/Utf16.hs → Data/Text/Encoding/Utf16.hsrenamed+4−7

@@ -1,22 +1,19 @@

11{-# LANGUAGE MagicHash, BangPatterns #-}

33-- |

4−-- Module : Data.Text.Internal.Encoding.Utf16

4+-- Module : Data.Text.Encoding.Utf16

88--

99-- License : BSD-style

10−-- Maintainer : bos@serpentine.com

10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

11+-- duncan@haskell.org

1112-- Stability : experimental

1213-- Portability : GHC

1314--

14−-- /Warning/: this is an internal module, and does not have a stable

15−-- API or name. Functions in this module may not check or enforce

16−-- preconditions expected by public modules. Use at your own risk!

17−--

1815-- Basic UTF-16 validation and character manipulation.

19−module Data.Text.Internal.Encoding.Utf16

16+module Data.Text.Encoding.Utf16

2017 (

2118 chr2

2219 , validate1

Data/Text/Internal/Encoding/Utf32.hs → Data/Text/Encoding/Utf32.hsrenamed+4−7

@@ -1,20 +1,17 @@

11-- |

2−-- Module : Data.Text.Internal.Encoding.Utf32

2+-- Module : Data.Text.Encoding.Utf32

66--

77-- License : BSD-style

8−-- Maintainer : bos@serpentine.com

8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

9+-- duncan@haskell.org

910-- Stability : experimental

1011-- Portability : portable

1112--

12−-- /Warning/: this is an internal module, and does not have a stable

13−-- API or name. Functions in this module may not check or enforce

14−-- preconditions expected by public modules. Use at your own risk!

15−--

1613-- Basic UTF-32 validation.

17−module Data.Text.Internal.Encoding.Utf32

14+module Data.Text.Encoding.Utf32

1815 (

1916 validate

2017 ) where

Data/Text/Internal/Encoding/Utf8.hs → Data/Text/Encoding/Utf8.hsrenamed+7−14

@@ -1,22 +1,19 @@

11{-# LANGUAGE CPP, MagicHash, BangPatterns #-}

33-- |

4−-- Module : Data.Text.Internal.Encoding.Utf8

4+-- Module : Data.Text.Encoding.Utf8

88--

99-- License : BSD-style

10−-- Maintainer : bos@serpentine.com

10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

11+-- duncan@haskell.org

1112-- Stability : experimental

1213-- Portability : GHC

1314--

14−-- /Warning/: this is an internal module, and does not have a stable

15−-- API or name. Functions in this module may not check or enforce

16−-- preconditions expected by public modules. Use at your own risk!

17−--

1815-- Basic UTF-8 validation and character manipulation.

19−module Data.Text.Internal.Encoding.Utf8

16+module Data.Text.Encoding.Utf8

2017 (

2118 -- Decomposition

2219 ord2

@@ -33,16 +30,12 @@ module Data.Text.Internal.Encoding.Utf8

3330 , validate4

3431 ) where

3532

36−#if defined(TEST_SUITE)

37−# undef ASSERTS

38−#endif

39−

4033#if defined(ASSERTS)

4134import Control.Exception (assert)

4235#endif

4336import Data.Bits ((.&.))

44−import Data.Text.Internal.Unsafe.Char (ord)

45−import Data.Text.Internal.Unsafe.Shift (shiftR)

37+import Data.Text.UnsafeChar (ord)

38+import Data.Text.UnsafeShift (shiftR)

4639import GHC.Exts

4740import GHC.Word (Word8(..))

4841

@@ -153,7 +146,7 @@ validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4

153146validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool

154147{-# INLINE validate4 #-}

155148validate4 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3

156− where

149+ where

157150 validate4_1 = x1 == 0xF0 &&

158151 between x2 0x90 0xBF &&

159152 between x3 0x80 0xBF &&

Data/Text/Foreign.hs+4−27

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

55--

66-- License : BSD-style

7−-- Maintainer : bos@serpentine.com

7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

8+-- duncan@haskell.org

89-- Stability : experimental

910-- Portability : GHC

1011--

@@ -20,9 +21,6 @@ module Data.Text.Foreign

2021 , fromPtr

2122 , useAsPtr

2223 , asForeignPtr

23− -- ** Encoding as UTF-8

24− , peekCStringLen

25− , withCStringLen

2624 -- * Unsafe conversion code

2725 , lengthWord16

2826 , unsafeCopyToPtr

@@ -40,17 +38,14 @@ import Control.Monad.ST.Unsafe (unsafeIOToST)

4038#else

4139import Control.Monad.ST (unsafeIOToST)

4240#endif

43−import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen)

44−import Data.Text.Encoding (decodeUtf8, encodeUtf8)

4541import Data.Text.Internal (Text(..), empty)

4642import Data.Text.Unsafe (lengthWord16)

43+import qualified Data.Text.Array as A

4744import Data.Word (Word16)

48−import Foreign.C.String (CStringLen)

49−import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)

5045import Foreign.Marshal.Alloc (allocaBytes)

5146import Foreign.Ptr (Ptr, castPtr, plusPtr)

47+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)

5248import Foreign.Storable (peek, poke)

53−import qualified Data.Text.Array as A

5449

5550-- $interop

5651--

@@ -153,21 +148,3 @@ asForeignPtr t@(Text _arr _off len) = do

153148 fp <- mallocForeignPtrArray len

154149 withForeignPtr fp $ unsafeCopyToPtr t

155150 return (fp, I16 len)

156−

157−-- | /O(n)/ Decode a C string with explicit length, which is assumed

158−-- to have been encoded as UTF-8. If decoding fails, a

159−-- 'UnicodeException' is thrown.

160−peekCStringLen :: CStringLen -> IO Text

161−peekCStringLen cs = do

162− bs <- unsafePackCStringLen cs

163− return $! decodeUtf8 bs

164−

165−-- | Marshal a 'Text' into a C string encoded as UTF-8 in temporary

166−-- storage, with explicit length information. The encoded string may

167−-- contain NUL bytes, and is not followed by a trailing NUL byte.

168−--

169−-- The temporary storage is freed when the subcomputation terminates

170−-- (either normally or via an exception), so the pointer to the

171−-- temporary storage must /not/ be used after this function returns.

172−withCStringLen :: Text -> (CStringLen -> IO a) -> IO a

173−withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act

Data/Text/Internal/Fusion.hs → Data/Text/Fusion.hsrenamed+45−58

@@ -1,23 +1,20 @@

11{-# LANGUAGE BangPatterns, MagicHash #-}

33-- |

4−-- Module : Data.Text.Internal.Fusion

4+-- Module : Data.Text.Fusion

55-- Copyright : (c) Tom Harper 2008-2009,

66-- (c) Bryan O'Sullivan 2009-2010,

77-- (c) Duncan Coutts 2009

88--

99-- License : BSD-style

10−-- Maintainer : bos@serpentine.com

10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

11+-- duncan@haskell.org

1112-- Stability : experimental

1213-- Portability : GHC

1314--

14−-- /Warning/: this is an internal module, and does not have a stable

15−-- API or name. Functions in this module may not check or enforce

16−-- preconditions expected by public modules. Use at your own risk!

17−--

1815-- Text manipulation functions represented as fusible operations over

1916-- streams.

20−module Data.Text.Internal.Fusion

17+module Data.Text.Fusion

2118 (

2219 -- * Types

2320 Stream(..)

@@ -54,21 +51,21 @@ import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,

5451 fromIntegral, otherwise)

5552import Data.Bits ((.&.))

5653import Data.Text.Internal (Text(..))

57−import Data.Text.Internal.Private (runText)

58−import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)

59−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)

54+import Data.Text.UnsafeChar (ord, unsafeChr, unsafeWrite)

55+import Data.Text.UnsafeShift (shiftL, shiftR)

6056import qualified Data.Text.Array as A

61−import qualified Data.Text.Internal.Fusion.Common as S

62−import Data.Text.Internal.Fusion.Types

63−import Data.Text.Internal.Fusion.Size

57+import qualified Data.Text.Fusion.Common as S

58+import Data.Text.Fusion.Internal

59+import Data.Text.Fusion.Size

6460import qualified Data.Text.Internal as I

65−import qualified Data.Text.Internal.Encoding.Utf16 as U16

61+import qualified Data.Text.Encoding.Utf16 as U16

62+import qualified Prelude as P

6663

6764default(Int)

6865

6966-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.

7067stream :: Text -> Stream Char

71−stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)

68+stream (Text arr off len) = Stream next off (maxSize len)

7269 where

7370 !end = off+len

7471 next !i

@@ -83,7 +80,7 @@ stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)

8380-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate

8481-- backwards.

8582reverseStream :: Text -> Stream Char

86−reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)

83+reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)

8784 where

8885 {-# INLINE next #-}

8986 next !i

@@ -97,36 +94,26 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `sh

9794

9895-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.

9996unstream :: Stream Char -> Text

100−unstream (Stream next0 s0 len) = runText $ \done -> do

101− -- Before encoding each char we perform a buffer realloc check assuming

102− -- worst case encoding size of two 16-bit units for the char. Just add an

103− -- extra space to the buffer so that we do not end up reallocating even when

104− -- all the chars are encoded as single unit.

105− let mlen = upperBound 4 len + 1

106− arr0 <- A.new mlen

107− let outer !arr !maxi = encode

108− where

109− -- keep the common case loop as small as possible

110− encode !si !di =

111− case next0 si of

112− Done -> done arr di

113− Skip si' -> encode si' di

114− Yield c si'

115− -- simply check for the worst case

116− | maxi < di + 1 -> realloc si di

117− | otherwise -> do

118− n <- unsafeWrite arr di c

119− encode si' (di + n)

120−

121− -- keep uncommon case separate from the common case code

122− {-# NOINLINE realloc #-}

123− realloc !si !di = do

124− let newlen = (maxi + 1) * 2

125− arr' <- A.new newlen

126− A.copyM arr' 0 arr 0 di

127− outer arr' (newlen - 1) si di

128−

129− outer arr0 (mlen - 1) s0 0

97+unstream (Stream next0 s0 len) = I.textP (P.fst a) 0 (P.snd a)

98+ where

99+ a = A.run2 (A.new mlen >>= \arr -> outer arr mlen s0 0)

100+ where mlen = upperBound 4 len

101+ outer arr top = loop

102+ where

103+ loop !s !i =

104+ case next0 s of

105+ Done -> return (arr, i)

106+ Skip s' -> loop s' i

107+ Yield x s'

108+ | j >= top -> {-# SCC "unstream/resize" #-} do

109+ let top' = (top + 1) `shiftL` 1

110+ arr' <- A.new top'

111+ A.copyM arr' 0 arr 0 top

112+ outer arr' top' s i

113+ | otherwise -> do d <- unsafeWrite arr i x

114+ loop s' (i+d)

115+ where j | ord x < 0x10000 = i

116+ | otherwise = i + 1

130117{-# INLINE [0] unstream #-}

131118{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}

132119

@@ -142,7 +129,7 @@ length = S.lengthI

142129reverse :: Stream Char -> Text

143130reverse (Stream next s len0)

144131 | isEmpty len0 = I.empty

145− | otherwise = I.text arr off' len'

132+ | otherwise = I.textP arr off' len'

146133 where

147134 len0' = upperBound 4 (larger len0 4)

148135 (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')

@@ -176,15 +163,15 @@ reverse (Stream next s len0)

176163-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with

177164-- the input and result reversed.

178165reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

179−reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low

166+reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low

180167 where

181168 {-# INLINE next #-}

182− next (Scan1 z s) = Yield z (Scan2 z s)

183− next (Scan2 z s) = case next0 s of

184− Yield x s' -> let !x' = f x z

185− in Yield x' (Scan2 x' s')

186− Skip s' -> Skip (Scan2 z s')

187− Done -> Done

169+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)

170+ next (S2 :*: z :*: s) = case next0 s of

171+ Yield x s' -> let !x' = f x z

172+ in Yield x' (S2 :*: x' :*: s')

173+ Skip s' -> Skip (S2 :*: z :*: s')

174+ Done -> Done

188175{-# INLINE reverseScanr #-}

189176

190177-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed

@@ -220,7 +207,7 @@ countChar = S.countCharI

220207-- function to each element of a 'Text', passing an accumulating

221208-- parameter from left to right, and returns a final 'Text'.

222209mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)

223−mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)

210+mapAccumL f z0 (Stream next0 s0 len) = (nz,I.textP na 0 nl)

224211 where

225212 (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)

226213 where mlen = upperBound 4 len

@@ -236,9 +223,9 @@ mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)

236223 arr' <- A.new top'

237224 A.copyM arr' 0 arr 0 top

238225 outer arr' top' z s i

239− | otherwise -> do d <- unsafeWrite arr i c

226+ | otherwise -> do let (z',c) = f z x

227+ d <- unsafeWrite arr i c

240228 loop z' s' (i+d)

241− where (z',c) = f z x

242− j | ord c < 0x10000 = i

229+ where j | ord x < 0x10000 = i

243230 | otherwise = i + 1

244231{-# INLINE [0] mapAccumL #-}

Data/Text/Internal/Fusion/CaseMapping.hs → Data/Text/Fusion/CaseMapping.hsrenamed+6−392

@@ -1,17 +1,12 @@

11{-# LANGUAGE Rank2Types #-}

22-- AUTOMATICALLY GENERATED - DO NOT EDIT

3−-- Generated by scripts/CaseMapping.hs

4−-- CaseFolding-8.0.0.txt

5−-- Date: 2015-01-13, 18:16:36 GMT [MD]

6−-- SpecialCasing-8.0.0.txt

7−-- Date: 2014-12-16, 23:08:04 GMT [MD]

8−

9−module Data.Text.Internal.Fusion.CaseMapping where

3+-- Generated by scripts/SpecialCasing.hs

4+module Data.Text.Fusion.CaseMapping where

105import Data.Char

11−import Data.Text.Internal.Fusion.Types

6+import Data.Text.Fusion.Internal

127

138upperMapping :: forall s. Char -> s -> Step (CC s) Char

14−{-# NOINLINE upperMapping #-}

9+{-# INLINE upperMapping #-}

1510-- LATIN SMALL LETTER SHARP S

1611upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')

1712-- LATIN SMALL LIGATURE FF

@@ -218,111 +213,12 @@ upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')

218213upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')

219214upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')

220215lowerMapping :: forall s. Char -> s -> Step (CC s) Char

221−{-# NOINLINE lowerMapping #-}

216+{-# INLINE lowerMapping #-}

222217-- LATIN CAPITAL LETTER I WITH DOT ABOVE

223218lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')

224219lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')

225−titleMapping :: forall s. Char -> s -> Step (CC s) Char

226−{-# NOINLINE titleMapping #-}

227−-- LATIN SMALL LETTER SHARP S

228−titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')

229−-- LATIN SMALL LIGATURE FF

230−titleMapping '\xfb00' s = Yield '\x0046' (CC s '\x0066' '\x0000')

231−-- LATIN SMALL LIGATURE FI

232−titleMapping '\xfb01' s = Yield '\x0046' (CC s '\x0069' '\x0000')

233−-- LATIN SMALL LIGATURE FL

234−titleMapping '\xfb02' s = Yield '\x0046' (CC s '\x006c' '\x0000')

235−-- LATIN SMALL LIGATURE FFI

236−titleMapping '\xfb03' s = Yield '\x0046' (CC s '\x0066' '\x0069')

237−-- LATIN SMALL LIGATURE FFL

238−titleMapping '\xfb04' s = Yield '\x0046' (CC s '\x0066' '\x006c')

239−-- LATIN SMALL LIGATURE LONG S T

240−titleMapping '\xfb05' s = Yield '\x0053' (CC s '\x0074' '\x0000')

241−-- LATIN SMALL LIGATURE ST

242−titleMapping '\xfb06' s = Yield '\x0053' (CC s '\x0074' '\x0000')

243−-- ARMENIAN SMALL LIGATURE ECH YIWN

244−titleMapping '\x0587' s = Yield '\x0535' (CC s '\x0582' '\x0000')

245−-- ARMENIAN SMALL LIGATURE MEN NOW

246−titleMapping '\xfb13' s = Yield '\x0544' (CC s '\x0576' '\x0000')

247−-- ARMENIAN SMALL LIGATURE MEN ECH

248−titleMapping '\xfb14' s = Yield '\x0544' (CC s '\x0565' '\x0000')

249−-- ARMENIAN SMALL LIGATURE MEN INI

250−titleMapping '\xfb15' s = Yield '\x0544' (CC s '\x056b' '\x0000')

251−-- ARMENIAN SMALL LIGATURE VEW NOW

252−titleMapping '\xfb16' s = Yield '\x054e' (CC s '\x0576' '\x0000')

253−-- ARMENIAN SMALL LIGATURE MEN XEH

254−titleMapping '\xfb17' s = Yield '\x0544' (CC s '\x056d' '\x0000')

255−-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE

256−titleMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')

257−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS

258−titleMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')

259−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS

260−titleMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')

261−-- LATIN SMALL LETTER J WITH CARON

262−titleMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')

263−-- LATIN SMALL LETTER H WITH LINE BELOW

264−titleMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')

265−-- LATIN SMALL LETTER T WITH DIAERESIS

266−titleMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')

267−-- LATIN SMALL LETTER W WITH RING ABOVE

268−titleMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')

269−-- LATIN SMALL LETTER Y WITH RING ABOVE

270−titleMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')

271−-- LATIN SMALL LETTER A WITH RIGHT HALF RING

272−titleMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')

273−-- GREEK SMALL LETTER UPSILON WITH PSILI

274−titleMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')

275−-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA

276−titleMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')

277−-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA

278−titleMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')

279−-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI

280−titleMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')

281−-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI

282−titleMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')

283−-- GREEK SMALL LETTER ETA WITH PERISPOMENI

284−titleMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')

285−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA

286−titleMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')

287−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA

288−titleMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')

289−-- GREEK SMALL LETTER IOTA WITH PERISPOMENI

290−titleMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')

291−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI

292−titleMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')

293−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA

294−titleMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')

295−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA

296−titleMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')

297−-- GREEK SMALL LETTER RHO WITH PSILI

298−titleMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')

299−-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI

300−titleMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')

301−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI

302−titleMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')

303−-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI

304−titleMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')

305−-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI

306−titleMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0345' '\x0000')

307−-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI

308−titleMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0345' '\x0000')

309−-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI

310−titleMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0345' '\x0000')

311−-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI

312−titleMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0345' '\x0000')

313−-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI

314−titleMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0345' '\x0000')

315−-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI

316−titleMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0345' '\x0000')

317−-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI

318−titleMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0345')

319−-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI

320−titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')

321−-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI

322−titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')

323−titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')

324220foldMapping :: forall s. Char -> s -> Step (CC s) Char

325−{-# NOINLINE foldMapping #-}

221+{-# INLINE foldMapping #-}

326222-- MICRO SIGN

327223foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')

328224-- LATIN SMALL LETTER SHARP S

@@ -359,18 +255,6 @@ foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')

359255foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')

360256-- ARMENIAN SMALL LIGATURE ECH YIWN

361257foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')

362−-- CHEROKEE SMALL LETTER YE

363−foldMapping '\x13f8' s = Yield '\x13f0' (CC s '\x0000' '\x0000')

364−-- CHEROKEE SMALL LETTER YI

365−foldMapping '\x13f9' s = Yield '\x13f1' (CC s '\x0000' '\x0000')

366−-- CHEROKEE SMALL LETTER YO

367−foldMapping '\x13fa' s = Yield '\x13f2' (CC s '\x0000' '\x0000')

368−-- CHEROKEE SMALL LETTER YU

369−foldMapping '\x13fb' s = Yield '\x13f3' (CC s '\x0000' '\x0000')

370−-- CHEROKEE SMALL LETTER YV

371−foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')

372−-- CHEROKEE SMALL LETTER MV

373−foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')

374258-- LATIN SMALL LETTER H WITH LINE BELOW

375259foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')

376260-- LATIN SMALL LETTER T WITH DIAERESIS

@@ -545,174 +429,6 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')

545429foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')

546430-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

547431foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')

548−-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL

549−foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')

550−-- LATIN CAPITAL LETTER CHI

551−foldMapping '\xa7b3' s = Yield '\xab53' (CC s '\x0000' '\x0000')

552−-- LATIN CAPITAL LETTER BETA

553−foldMapping '\xa7b4' s = Yield '\xa7b5' (CC s '\x0000' '\x0000')

554−-- LATIN CAPITAL LETTER OMEGA

555−foldMapping '\xa7b6' s = Yield '\xa7b7' (CC s '\x0000' '\x0000')

556−-- CHEROKEE SMALL LETTER A

557−foldMapping '\xab70' s = Yield '\x13a0' (CC s '\x0000' '\x0000')

558−-- CHEROKEE SMALL LETTER E

559−foldMapping '\xab71' s = Yield '\x13a1' (CC s '\x0000' '\x0000')

560−-- CHEROKEE SMALL LETTER I

561−foldMapping '\xab72' s = Yield '\x13a2' (CC s '\x0000' '\x0000')

562−-- CHEROKEE SMALL LETTER O

563−foldMapping '\xab73' s = Yield '\x13a3' (CC s '\x0000' '\x0000')

564−-- CHEROKEE SMALL LETTER U

565−foldMapping '\xab74' s = Yield '\x13a4' (CC s '\x0000' '\x0000')

566−-- CHEROKEE SMALL LETTER V

567−foldMapping '\xab75' s = Yield '\x13a5' (CC s '\x0000' '\x0000')

568−-- CHEROKEE SMALL LETTER GA

569−foldMapping '\xab76' s = Yield '\x13a6' (CC s '\x0000' '\x0000')

570−-- CHEROKEE SMALL LETTER KA

571−foldMapping '\xab77' s = Yield '\x13a7' (CC s '\x0000' '\x0000')

572−-- CHEROKEE SMALL LETTER GE

573−foldMapping '\xab78' s = Yield '\x13a8' (CC s '\x0000' '\x0000')

574−-- CHEROKEE SMALL LETTER GI

575−foldMapping '\xab79' s = Yield '\x13a9' (CC s '\x0000' '\x0000')

576−-- CHEROKEE SMALL LETTER GO

577−foldMapping '\xab7a' s = Yield '\x13aa' (CC s '\x0000' '\x0000')

578−-- CHEROKEE SMALL LETTER GU

579−foldMapping '\xab7b' s = Yield '\x13ab' (CC s '\x0000' '\x0000')

580−-- CHEROKEE SMALL LETTER GV

581−foldMapping '\xab7c' s = Yield '\x13ac' (CC s '\x0000' '\x0000')

582−-- CHEROKEE SMALL LETTER HA

583−foldMapping '\xab7d' s = Yield '\x13ad' (CC s '\x0000' '\x0000')

584−-- CHEROKEE SMALL LETTER HE

585−foldMapping '\xab7e' s = Yield '\x13ae' (CC s '\x0000' '\x0000')

586−-- CHEROKEE SMALL LETTER HI

587−foldMapping '\xab7f' s = Yield '\x13af' (CC s '\x0000' '\x0000')

588−-- CHEROKEE SMALL LETTER HO

589−foldMapping '\xab80' s = Yield '\x13b0' (CC s '\x0000' '\x0000')

590−-- CHEROKEE SMALL LETTER HU

591−foldMapping '\xab81' s = Yield '\x13b1' (CC s '\x0000' '\x0000')

592−-- CHEROKEE SMALL LETTER HV

593−foldMapping '\xab82' s = Yield '\x13b2' (CC s '\x0000' '\x0000')

594−-- CHEROKEE SMALL LETTER LA

595−foldMapping '\xab83' s = Yield '\x13b3' (CC s '\x0000' '\x0000')

596−-- CHEROKEE SMALL LETTER LE

597−foldMapping '\xab84' s = Yield '\x13b4' (CC s '\x0000' '\x0000')

598−-- CHEROKEE SMALL LETTER LI

599−foldMapping '\xab85' s = Yield '\x13b5' (CC s '\x0000' '\x0000')

600−-- CHEROKEE SMALL LETTER LO

601−foldMapping '\xab86' s = Yield '\x13b6' (CC s '\x0000' '\x0000')

602−-- CHEROKEE SMALL LETTER LU

603−foldMapping '\xab87' s = Yield '\x13b7' (CC s '\x0000' '\x0000')

604−-- CHEROKEE SMALL LETTER LV

605−foldMapping '\xab88' s = Yield '\x13b8' (CC s '\x0000' '\x0000')

606−-- CHEROKEE SMALL LETTER MA

607−foldMapping '\xab89' s = Yield '\x13b9' (CC s '\x0000' '\x0000')

608−-- CHEROKEE SMALL LETTER ME

609−foldMapping '\xab8a' s = Yield '\x13ba' (CC s '\x0000' '\x0000')

610−-- CHEROKEE SMALL LETTER MI

611−foldMapping '\xab8b' s = Yield '\x13bb' (CC s '\x0000' '\x0000')

612−-- CHEROKEE SMALL LETTER MO

613−foldMapping '\xab8c' s = Yield '\x13bc' (CC s '\x0000' '\x0000')

614−-- CHEROKEE SMALL LETTER MU

615−foldMapping '\xab8d' s = Yield '\x13bd' (CC s '\x0000' '\x0000')

616−-- CHEROKEE SMALL LETTER NA

617−foldMapping '\xab8e' s = Yield '\x13be' (CC s '\x0000' '\x0000')

618−-- CHEROKEE SMALL LETTER HNA

619−foldMapping '\xab8f' s = Yield '\x13bf' (CC s '\x0000' '\x0000')

620−-- CHEROKEE SMALL LETTER NAH

621−foldMapping '\xab90' s = Yield '\x13c0' (CC s '\x0000' '\x0000')

622−-- CHEROKEE SMALL LETTER NE

623−foldMapping '\xab91' s = Yield '\x13c1' (CC s '\x0000' '\x0000')

624−-- CHEROKEE SMALL LETTER NI

625−foldMapping '\xab92' s = Yield '\x13c2' (CC s '\x0000' '\x0000')

626−-- CHEROKEE SMALL LETTER NO

627−foldMapping '\xab93' s = Yield '\x13c3' (CC s '\x0000' '\x0000')

628−-- CHEROKEE SMALL LETTER NU

629−foldMapping '\xab94' s = Yield '\x13c4' (CC s '\x0000' '\x0000')

630−-- CHEROKEE SMALL LETTER NV

631−foldMapping '\xab95' s = Yield '\x13c5' (CC s '\x0000' '\x0000')

632−-- CHEROKEE SMALL LETTER QUA

633−foldMapping '\xab96' s = Yield '\x13c6' (CC s '\x0000' '\x0000')

634−-- CHEROKEE SMALL LETTER QUE

635−foldMapping '\xab97' s = Yield '\x13c7' (CC s '\x0000' '\x0000')

636−-- CHEROKEE SMALL LETTER QUI

637−foldMapping '\xab98' s = Yield '\x13c8' (CC s '\x0000' '\x0000')

638−-- CHEROKEE SMALL LETTER QUO

639−foldMapping '\xab99' s = Yield '\x13c9' (CC s '\x0000' '\x0000')

640−-- CHEROKEE SMALL LETTER QUU

641−foldMapping '\xab9a' s = Yield '\x13ca' (CC s '\x0000' '\x0000')

642−-- CHEROKEE SMALL LETTER QUV

643−foldMapping '\xab9b' s = Yield '\x13cb' (CC s '\x0000' '\x0000')

644−-- CHEROKEE SMALL LETTER SA

645−foldMapping '\xab9c' s = Yield '\x13cc' (CC s '\x0000' '\x0000')

646−-- CHEROKEE SMALL LETTER S

647−foldMapping '\xab9d' s = Yield '\x13cd' (CC s '\x0000' '\x0000')

648−-- CHEROKEE SMALL LETTER SE

649−foldMapping '\xab9e' s = Yield '\x13ce' (CC s '\x0000' '\x0000')

650−-- CHEROKEE SMALL LETTER SI

651−foldMapping '\xab9f' s = Yield '\x13cf' (CC s '\x0000' '\x0000')

652−-- CHEROKEE SMALL LETTER SO

653−foldMapping '\xaba0' s = Yield '\x13d0' (CC s '\x0000' '\x0000')

654−-- CHEROKEE SMALL LETTER SU

655−foldMapping '\xaba1' s = Yield '\x13d1' (CC s '\x0000' '\x0000')

656−-- CHEROKEE SMALL LETTER SV

657−foldMapping '\xaba2' s = Yield '\x13d2' (CC s '\x0000' '\x0000')

658−-- CHEROKEE SMALL LETTER DA

659−foldMapping '\xaba3' s = Yield '\x13d3' (CC s '\x0000' '\x0000')

660−-- CHEROKEE SMALL LETTER TA

661−foldMapping '\xaba4' s = Yield '\x13d4' (CC s '\x0000' '\x0000')

662−-- CHEROKEE SMALL LETTER DE

663−foldMapping '\xaba5' s = Yield '\x13d5' (CC s '\x0000' '\x0000')

664−-- CHEROKEE SMALL LETTER TE

665−foldMapping '\xaba6' s = Yield '\x13d6' (CC s '\x0000' '\x0000')

666−-- CHEROKEE SMALL LETTER DI

667−foldMapping '\xaba7' s = Yield '\x13d7' (CC s '\x0000' '\x0000')

668−-- CHEROKEE SMALL LETTER TI

669−foldMapping '\xaba8' s = Yield '\x13d8' (CC s '\x0000' '\x0000')

670−-- CHEROKEE SMALL LETTER DO

671−foldMapping '\xaba9' s = Yield '\x13d9' (CC s '\x0000' '\x0000')

672−-- CHEROKEE SMALL LETTER DU

673−foldMapping '\xabaa' s = Yield '\x13da' (CC s '\x0000' '\x0000')

674−-- CHEROKEE SMALL LETTER DV

675−foldMapping '\xabab' s = Yield '\x13db' (CC s '\x0000' '\x0000')

676−-- CHEROKEE SMALL LETTER DLA

677−foldMapping '\xabac' s = Yield '\x13dc' (CC s '\x0000' '\x0000')

678−-- CHEROKEE SMALL LETTER TLA

679−foldMapping '\xabad' s = Yield '\x13dd' (CC s '\x0000' '\x0000')

680−-- CHEROKEE SMALL LETTER TLE

681−foldMapping '\xabae' s = Yield '\x13de' (CC s '\x0000' '\x0000')

682−-- CHEROKEE SMALL LETTER TLI

683−foldMapping '\xabaf' s = Yield '\x13df' (CC s '\x0000' '\x0000')

684−-- CHEROKEE SMALL LETTER TLO

685−foldMapping '\xabb0' s = Yield '\x13e0' (CC s '\x0000' '\x0000')

686−-- CHEROKEE SMALL LETTER TLU

687−foldMapping '\xabb1' s = Yield '\x13e1' (CC s '\x0000' '\x0000')

688−-- CHEROKEE SMALL LETTER TLV

689−foldMapping '\xabb2' s = Yield '\x13e2' (CC s '\x0000' '\x0000')

690−-- CHEROKEE SMALL LETTER TSA

691−foldMapping '\xabb3' s = Yield '\x13e3' (CC s '\x0000' '\x0000')

692−-- CHEROKEE SMALL LETTER TSE

693−foldMapping '\xabb4' s = Yield '\x13e4' (CC s '\x0000' '\x0000')

694−-- CHEROKEE SMALL LETTER TSI

695−foldMapping '\xabb5' s = Yield '\x13e5' (CC s '\x0000' '\x0000')

696−-- CHEROKEE SMALL LETTER TSO

697−foldMapping '\xabb6' s = Yield '\x13e6' (CC s '\x0000' '\x0000')

698−-- CHEROKEE SMALL LETTER TSU

699−foldMapping '\xabb7' s = Yield '\x13e7' (CC s '\x0000' '\x0000')

700−-- CHEROKEE SMALL LETTER TSV

701−foldMapping '\xabb8' s = Yield '\x13e8' (CC s '\x0000' '\x0000')

702−-- CHEROKEE SMALL LETTER WA

703−foldMapping '\xabb9' s = Yield '\x13e9' (CC s '\x0000' '\x0000')

704−-- CHEROKEE SMALL LETTER WE

705−foldMapping '\xabba' s = Yield '\x13ea' (CC s '\x0000' '\x0000')

706−-- CHEROKEE SMALL LETTER WI

707−foldMapping '\xabbb' s = Yield '\x13eb' (CC s '\x0000' '\x0000')

708−-- CHEROKEE SMALL LETTER WO

709−foldMapping '\xabbc' s = Yield '\x13ec' (CC s '\x0000' '\x0000')

710−-- CHEROKEE SMALL LETTER WU

711−foldMapping '\xabbd' s = Yield '\x13ed' (CC s '\x0000' '\x0000')

712−-- CHEROKEE SMALL LETTER WV

713−foldMapping '\xabbe' s = Yield '\x13ee' (CC s '\x0000' '\x0000')

714−-- CHEROKEE SMALL LETTER YA

715−foldMapping '\xabbf' s = Yield '\x13ef' (CC s '\x0000' '\x0000')

716432-- LATIN SMALL LIGATURE FF

717433foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')

718434-- LATIN SMALL LIGATURE FI

@@ -737,106 +453,4 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')

737453foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')

738454-- ARMENIAN SMALL LIGATURE MEN XEH

739455foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')

740−-- OLD HUNGARIAN CAPITAL LETTER A

741−foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')

742−-- OLD HUNGARIAN CAPITAL LETTER AA

743−foldMapping '\x10c81' s = Yield '\x10cc1' (CC s '\x0000' '\x0000')

744−-- OLD HUNGARIAN CAPITAL LETTER EB

745−foldMapping '\x10c82' s = Yield '\x10cc2' (CC s '\x0000' '\x0000')

746−-- OLD HUNGARIAN CAPITAL LETTER AMB

747−foldMapping '\x10c83' s = Yield '\x10cc3' (CC s '\x0000' '\x0000')

748−-- OLD HUNGARIAN CAPITAL LETTER EC

749−foldMapping '\x10c84' s = Yield '\x10cc4' (CC s '\x0000' '\x0000')

750−-- OLD HUNGARIAN CAPITAL LETTER ENC

751−foldMapping '\x10c85' s = Yield '\x10cc5' (CC s '\x0000' '\x0000')

752−-- OLD HUNGARIAN CAPITAL LETTER ECS

753−foldMapping '\x10c86' s = Yield '\x10cc6' (CC s '\x0000' '\x0000')

754−-- OLD HUNGARIAN CAPITAL LETTER ED

755−foldMapping '\x10c87' s = Yield '\x10cc7' (CC s '\x0000' '\x0000')

756−-- OLD HUNGARIAN CAPITAL LETTER AND

757−foldMapping '\x10c88' s = Yield '\x10cc8' (CC s '\x0000' '\x0000')

758−-- OLD HUNGARIAN CAPITAL LETTER E

759−foldMapping '\x10c89' s = Yield '\x10cc9' (CC s '\x0000' '\x0000')

760−-- OLD HUNGARIAN CAPITAL LETTER CLOSE E

761−foldMapping '\x10c8a' s = Yield '\x10cca' (CC s '\x0000' '\x0000')

762−-- OLD HUNGARIAN CAPITAL LETTER EE

763−foldMapping '\x10c8b' s = Yield '\x10ccb' (CC s '\x0000' '\x0000')

764−-- OLD HUNGARIAN CAPITAL LETTER EF

765−foldMapping '\x10c8c' s = Yield '\x10ccc' (CC s '\x0000' '\x0000')

766−-- OLD HUNGARIAN CAPITAL LETTER EG

767−foldMapping '\x10c8d' s = Yield '\x10ccd' (CC s '\x0000' '\x0000')

768−-- OLD HUNGARIAN CAPITAL LETTER EGY

769−foldMapping '\x10c8e' s = Yield '\x10cce' (CC s '\x0000' '\x0000')

770−-- OLD HUNGARIAN CAPITAL LETTER EH

771−foldMapping '\x10c8f' s = Yield '\x10ccf' (CC s '\x0000' '\x0000')

772−-- OLD HUNGARIAN CAPITAL LETTER I

773−foldMapping '\x10c90' s = Yield '\x10cd0' (CC s '\x0000' '\x0000')

774−-- OLD HUNGARIAN CAPITAL LETTER II

775−foldMapping '\x10c91' s = Yield '\x10cd1' (CC s '\x0000' '\x0000')

776−-- OLD HUNGARIAN CAPITAL LETTER EJ

777−foldMapping '\x10c92' s = Yield '\x10cd2' (CC s '\x0000' '\x0000')

778−-- OLD HUNGARIAN CAPITAL LETTER EK

779−foldMapping '\x10c93' s = Yield '\x10cd3' (CC s '\x0000' '\x0000')

780−-- OLD HUNGARIAN CAPITAL LETTER AK

781−foldMapping '\x10c94' s = Yield '\x10cd4' (CC s '\x0000' '\x0000')

782−-- OLD HUNGARIAN CAPITAL LETTER UNK

783−foldMapping '\x10c95' s = Yield '\x10cd5' (CC s '\x0000' '\x0000')

784−-- OLD HUNGARIAN CAPITAL LETTER EL

785−foldMapping '\x10c96' s = Yield '\x10cd6' (CC s '\x0000' '\x0000')

786−-- OLD HUNGARIAN CAPITAL LETTER ELY

787−foldMapping '\x10c97' s = Yield '\x10cd7' (CC s '\x0000' '\x0000')

788−-- OLD HUNGARIAN CAPITAL LETTER EM

789−foldMapping '\x10c98' s = Yield '\x10cd8' (CC s '\x0000' '\x0000')

790−-- OLD HUNGARIAN CAPITAL LETTER EN

791−foldMapping '\x10c99' s = Yield '\x10cd9' (CC s '\x0000' '\x0000')

792−-- OLD HUNGARIAN CAPITAL LETTER ENY

793−foldMapping '\x10c9a' s = Yield '\x10cda' (CC s '\x0000' '\x0000')

794−-- OLD HUNGARIAN CAPITAL LETTER O

795−foldMapping '\x10c9b' s = Yield '\x10cdb' (CC s '\x0000' '\x0000')

796−-- OLD HUNGARIAN CAPITAL LETTER OO

797−foldMapping '\x10c9c' s = Yield '\x10cdc' (CC s '\x0000' '\x0000')

798−-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG OE

799−foldMapping '\x10c9d' s = Yield '\x10cdd' (CC s '\x0000' '\x0000')

800−-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA OE

801−foldMapping '\x10c9e' s = Yield '\x10cde' (CC s '\x0000' '\x0000')

802−-- OLD HUNGARIAN CAPITAL LETTER OEE

803−foldMapping '\x10c9f' s = Yield '\x10cdf' (CC s '\x0000' '\x0000')

804−-- OLD HUNGARIAN CAPITAL LETTER EP

805−foldMapping '\x10ca0' s = Yield '\x10ce0' (CC s '\x0000' '\x0000')

806−-- OLD HUNGARIAN CAPITAL LETTER EMP

807−foldMapping '\x10ca1' s = Yield '\x10ce1' (CC s '\x0000' '\x0000')

808−-- OLD HUNGARIAN CAPITAL LETTER ER

809−foldMapping '\x10ca2' s = Yield '\x10ce2' (CC s '\x0000' '\x0000')

810−-- OLD HUNGARIAN CAPITAL LETTER SHORT ER

811−foldMapping '\x10ca3' s = Yield '\x10ce3' (CC s '\x0000' '\x0000')

812−-- OLD HUNGARIAN CAPITAL LETTER ES

813−foldMapping '\x10ca4' s = Yield '\x10ce4' (CC s '\x0000' '\x0000')

814−-- OLD HUNGARIAN CAPITAL LETTER ESZ

815−foldMapping '\x10ca5' s = Yield '\x10ce5' (CC s '\x0000' '\x0000')

816−-- OLD HUNGARIAN CAPITAL LETTER ET

817−foldMapping '\x10ca6' s = Yield '\x10ce6' (CC s '\x0000' '\x0000')

818−-- OLD HUNGARIAN CAPITAL LETTER ENT

819−foldMapping '\x10ca7' s = Yield '\x10ce7' (CC s '\x0000' '\x0000')

820−-- OLD HUNGARIAN CAPITAL LETTER ETY

821−foldMapping '\x10ca8' s = Yield '\x10ce8' (CC s '\x0000' '\x0000')

822−-- OLD HUNGARIAN CAPITAL LETTER ECH

823−foldMapping '\x10ca9' s = Yield '\x10ce9' (CC s '\x0000' '\x0000')

824−-- OLD HUNGARIAN CAPITAL LETTER U

825−foldMapping '\x10caa' s = Yield '\x10cea' (CC s '\x0000' '\x0000')

826−-- OLD HUNGARIAN CAPITAL LETTER UU

827−foldMapping '\x10cab' s = Yield '\x10ceb' (CC s '\x0000' '\x0000')

828−-- OLD HUNGARIAN CAPITAL LETTER NIKOLSBURG UE

829−foldMapping '\x10cac' s = Yield '\x10cec' (CC s '\x0000' '\x0000')

830−-- OLD HUNGARIAN CAPITAL LETTER RUDIMENTA UE

831−foldMapping '\x10cad' s = Yield '\x10ced' (CC s '\x0000' '\x0000')

832−-- OLD HUNGARIAN CAPITAL LETTER EV

833−foldMapping '\x10cae' s = Yield '\x10cee' (CC s '\x0000' '\x0000')

834−-- OLD HUNGARIAN CAPITAL LETTER EZ

835−foldMapping '\x10caf' s = Yield '\x10cef' (CC s '\x0000' '\x0000')

836−-- OLD HUNGARIAN CAPITAL LETTER EZS

837−foldMapping '\x10cb0' s = Yield '\x10cf0' (CC s '\x0000' '\x0000')

838−-- OLD HUNGARIAN CAPITAL LETTER ENT-SHAPED SIGN

839−foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')

840−-- OLD HUNGARIAN CAPITAL LETTER US

841−foldMapping '\x10cb2' s = Yield '\x10cf2' (CC s '\x0000' '\x0000')

842456foldMapping c s = Yield (toLower c) (CC s '\0' '\0')

Data/Text/Internal/Fusion/Common.hs → Data/Text/Fusion/Common.hsrenamed+89−153

@@ -1,26 +1,22 @@

1−{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}

1+{-# LANGUAGE BangPatterns, Rank2Types #-}

22-- |

3−-- Module : Data.Text.Internal.Fusion.Common

4−-- Copyright : (c) Bryan O'Sullivan 2009, 2012

3+-- Module : Data.Text.Fusion.Common

4+-- Copyright : (c) Bryan O'Sullivan 2009

55--

66-- License : BSD-style

7−-- Maintainer : bos@serpentine.com

7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

8+-- duncan@haskell.org

89-- Stability : experimental

910-- Portability : GHC

1011--

11−-- /Warning/: this is an internal module, and does not have a stable

12−-- API or name. Functions in this module may not check or enforce

13−-- preconditions expected by public modules. Use at your own risk!

14−--

1512-- Common stream fusion functionality for text.

1613

17−module Data.Text.Internal.Fusion.Common

14+module Data.Text.Fusion.Common

1815 (

1916 -- * Creation and elimination

2017 singleton

2118 , streamList

2219 , unstreamList

23− , streamCString#

2420

2521 -- * Basic interface

2622 , cons

@@ -45,7 +41,6 @@ module Data.Text.Internal.Fusion.Common

4541 -- $case

4642 , toCaseFold

4743 , toLower

48− , toTitle

4944 , toUpper

5045

5146 -- ** Justification

@@ -71,6 +66,9 @@ module Data.Text.Internal.Fusion.Common

7166 -- ** Scans

7267 , scanl

7368

69+ -- ** Accumulating maps

70+ -- , mapAccumL

71+

7472 -- ** Generation and unfolding

7573 , replicateCharI

7674 , replicateI

@@ -106,21 +104,16 @@ import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),

106104 (&&), fromIntegral, otherwise)

107105import qualified Data.List as L

108106import qualified Prelude as P

109−import Data.Bits (shiftL)

110−import Data.Char (isLetter)

111107import Data.Int (Int64)

112−import Data.Text.Internal.Fusion.Types

113−import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,

114− upperMapping)

115−import Data.Text.Internal.Fusion.Size

116−import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)

117−import GHC.Types (Char(..), Int(..))

108+import Data.Text.Fusion.Internal

109+import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, upperMapping)

110+import Data.Text.Fusion.Size

118111

119112singleton :: Char -> Stream Char

120113singleton c = Stream next False 1

121114 where next False = Yield c True

122115 next True = Done

123−{-# INLINE [0] singleton #-}

116+{-# INLINE singleton #-}

124117

125118streamList :: [a] -> Stream a

126119{-# INLINE [0] streamList #-}

@@ -138,35 +131,6 @@ unstreamList (Stream next s0 _len) = unfold s0

138131

139132{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}

140133

141−-- | Stream the UTF-8-like packed encoding used by GHC to represent

142−-- constant strings in generated code.

143−--

144−-- This encoding uses the byte sequence "\xc0\x80" to represent NUL,

145−-- and the string is NUL-terminated.

146−streamCString# :: Addr# -> Stream Char

147−streamCString# addr = Stream step 0 unknownSize

148− where

149− step !i

150− | b == 0 = Done

151− | b <= 0x7f = Yield (C# b#) (i+1)

152− | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1

153− in Yield c (i+2)

154− | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +

155− (next 1 `shiftL` 6) +

156− next 2

157− in Yield c (i+3)

158− | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +

159− (next 1 `shiftL` 12) +

160− (next 2 `shiftL` 6) +

161− next 3

162− in Yield c (i+4)

163− where b = I# (ord# b#)

164− next n = I# (ord# (at# (i+n))) - 0x80

165− !b# = at# i

166− at# (I# i#) = indexCharOffAddr# addr i#

167− chr (I# i#) = C# (chr# i#)

168−{-# INLINE [0] streamCString# #-}

169−

170134-- ----------------------------------------------------------------------------

171135-- * Basic stream functions

172136

@@ -175,7 +139,7 @@ data C s = C0 !s

175139

176140-- | /O(n)/ Adds a character to the front of a Stream Char.

177141cons :: Char -> Stream Char -> Stream Char

178−cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

142+cons w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

179143 where

180144 next (C1 s) = Yield w (C0 s)

181145 next (C0 s) = case next0 s of

@@ -184,9 +148,6 @@ cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

184148 Yield x s' -> Yield x (C0 s')

185149{-# INLINE [0] cons #-}

186150

187−data Snoc a = N

188− | J !a

189−

190151-- | /O(n)/ Adds a character to the end of a stream.

191152snoc :: Stream Char -> Char -> Stream Char

192153snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)

@@ -224,13 +185,9 @@ head (Stream next s0 _len) = loop_head s0

224185 loop_head !s = case next s of

225186 Yield x _ -> x

226187 Skip s' -> loop_head s'

227− Done -> head_empty

188+ Done -> streamError "head" "Empty stream"

228189{-# INLINE [0] head #-}

229190

230−head_empty :: a

231−head_empty = streamError "head" "Empty stream"

232−{-# NOINLINE head_empty #-}

233−

234191-- | /O(1)/ Returns the first character and remainder of a 'Stream

235192-- Char', or 'Nothing' if empty. Subject to array fusion.

236193uncons :: Stream Char -> Maybe (Char, Stream Char)

@@ -315,13 +272,12 @@ lengthI (Stream next s0 _len) = loop_length 0 s0

315272--

316273-- This function gives the same answer as comparing against the result

317274-- of 'lengthI', but can short circuit if the count of characters is

318−-- greater than the number or if the stream can't possibly be as long

319−-- as the number supplied, and hence be more efficient.

275+-- greater than the number, and hence be more efficient.

320276compareLengthI :: Integral a => Stream Char -> a -> Ordering

321−compareLengthI (Stream next s0 len) n =

322− case compareSize len (fromIntegral n) of

323− Just o -> o

277+compareLengthI (Stream next s0 len) n =

278+ case exactly len of

324279 Nothing -> loop_cmp 0 s0

280+ Just i -> compare (fromIntegral i) n

325281 where

326282 loop_cmp !z s = case next s of

327283 Done -> compare z n

@@ -439,54 +395,17 @@ toLower :: Stream Char -> Stream Char

439395toLower = caseConvert lowerMapping

440396{-# INLINE [0] toLower #-}

441397

442−-- | /O(n)/ Convert a string to title case, using simple case

443−-- conversion.

444−--

445−-- The first letter of the input is converted to title case, as is

446−-- every subsequent letter that immediately follows a non-letter.

447−-- Every letter that immediately follows another letter is converted

448−-- to lower case.

449−--

450−-- The result string may be longer than the input string. For example,

451−-- the Latin small ligature ﬂ (U+FB02) is converted to the

452−-- sequence Latin capital letter F (U+0046) followed by Latin small

453−-- letter l (U+006C).

454−--

455−-- /Note/: this function does not take language or culture specific

456−-- rules into account. For instance, in English, different style

457−-- guides disagree on whether the book name \"The Hill of the Red

458−-- Fox\" is correctly title cased—but this function will

459−-- capitalize /every/ word.

460−toTitle :: Stream Char -> Stream Char

461−toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len

462− where

463− next (CC (letter :*: s) '\0' _) =

464− case next0 s of

465− Done -> Done

466− Skip s' -> Skip (CC (letter :*: s') '\0' '\0')

467− Yield c s'

468− | letter' -> if letter

469− then lowerMapping c (letter' :*: s')

470− else titleMapping c (letter' :*: s')

471− | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')

472− where letter' = isLetter c

473− next (CC s a b) = Yield a (CC s b '\0')

474−{-# INLINE [0] toTitle #-}

475−

476−data Justify i s = Just1 !i !s

477− | Just2 !i !s

478−

479398justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

480399justifyLeftI k c (Stream next0 s0 len) =

481− Stream next (Just1 0 s0) (larger (fromIntegral k) len)

400+ Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)

482401 where

483− next (Just1 n s) =

402+ next (s :*: S1 :*: n) =

484403 case next0 s of

485− Done -> next (Just2 n s)

486− Skip s' -> Skip (Just1 n s')

487− Yield x s' -> Yield x (Just1 (n+1) s')

488− next (Just2 n s)

489− | n < k = Yield c (Just2 (n+1) s)

404+ Done -> next (s :*: S2 :*: n)

405+ Skip s' -> Skip (s' :*: S1 :*: n)

406+ Yield x s' -> Yield x (s' :*: S1 :*: n+1)

407+ next (s :*: S2 :*: n)

408+ | n < k = Yield c (s :*: S2 :*: n+1)

490409 | otherwise = Done

491410 {-# INLINE next #-}

492411{-# INLINE [0] justifyLeftI #-}

@@ -593,7 +512,7 @@ concatMap f = foldr (append . f) empty

593512{-# INLINE [0] concatMap #-}

594513

595514-- | /O(n)/ any @p @xs determines if any character in the stream

596−-- @xs@ satisfies the predicate @p@.

515+-- @xs@ satisifes the predicate @p@.

597516any :: (Char -> Bool) -> Stream Char -> Bool

598517any p (Stream next0 s0 _len) = loop_any s0

599518 where

@@ -605,7 +524,7 @@ any p (Stream next0 s0 _len) = loop_any s0

605524{-# INLINE [0] any #-}

606525

607526-- | /O(n)/ all @p @xs determines if all characters in the 'Text'

608−-- @xs@ satisfy the predicate @p@.

527+-- @xs@ satisify the predicate @p@.

609528all :: (Char -> Bool) -> Stream Char -> Bool

610529all p (Stream next0 s0 _len) = loop_all s0

611530 where

@@ -654,27 +573,50 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0

654573-- * Building streams

655574

656575scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

657−scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low

576+scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low

658577 where

659578 {-# INLINE next #-}

660− next (Scan1 z s) = Yield z (Scan2 z s)

661− next (Scan2 z s) = case next0 s of

662− Yield x s' -> let !x' = f z x

663− in Yield x' (Scan2 x' s')

664− Skip s' -> Skip (Scan2 z s')

665− Done -> Done

579+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)

580+ next (S2 :*: z :*: s) = case next0 s of

581+ Yield x s' -> let !x' = f z x

582+ in Yield x' (S2 :*: x' :*: s')

583+ Skip s' -> Skip (S2 :*: z :*: s')

584+ Done -> Done

666585{-# INLINE [0] scanl #-}

667586

587+-- -----------------------------------------------------------------------------

588+-- ** Accumulating maps

589+

590+{-

591+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a

592+-- function to each element of a stream, passing an accumulating

593+-- parameter from left to right, and returns a final stream.

594+--

595+-- /Note/: Unlike the version over lists, this function does not

596+-- return a final value for the accumulator, because the nature of

597+-- streams precludes it.

598+mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b

599+mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f

600+ where

601+ {-# INLINE next #-}

602+ next (s :*: z) = case next0 s of

603+ Yield x s' -> let (z',y) = f z x

604+ in Yield y (s' :*: z')

605+ Skip s' -> Skip (s' :*: z)

606+ Done -> Done

607+{-# INLINE [0] mapAccumL #-}

608+-}

609+

668610-- -----------------------------------------------------------------------------

669611-- ** Generating and unfolding streams

670612

671613replicateCharI :: Integral a => a -> Char -> Stream Char

672−replicateCharI !n !c

614+replicateCharI n c

673615 | n < 0 = empty

674616 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low

675617 where

676− next !i | i >= n = Done

677− | otherwise = Yield c (i + 1)

618+ next i | i >= n = Done

619+ | otherwise = Yield c (i + 1)

678620{-# INLINE [0] replicateCharI #-}

679621

680622data RI s = RI !s {-# UNPACK #-} !Int64

@@ -739,27 +681,24 @@ take n0 (Stream next0 s0 len) =

739681 Yield x s' -> Yield x ((n-1) :*: s')

740682{-# INLINE [0] take #-}

741683

742−data Drop a s = NS !s

743− | JS !a !s

744−

745684-- | /O(n)/ drop n, applied to a stream, returns the suffix of the

746685-- stream after the first @n@ characters, or the empty stream if @n@

747686-- is greater than the length of the stream.

748687drop :: Integral a => a -> Stream Char -> Stream Char

749688drop n0 (Stream next0 s0 len) =

750− Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))

689+ Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))

751690 where

752691 {-# INLINE next #-}

753− next (JS n s)

754− | n <= 0 = Skip (NS s)

692+ next (J n :*: s)

693+ | n <= 0 = Skip (N :*: s)

755694 | otherwise = case next0 s of

756695 Done -> Done

757− Skip s' -> Skip (JS n s')

758− Yield _ s' -> Skip (JS (n-1) s')

759− next (NS s) = case next0 s of

696+ Skip s' -> Skip (J n :*: s')

697+ Yield _ s' -> Skip (J (n-1) :*: s')

698+ next (N :*: s) = case next0 s of

760699 Done -> Done

761− Skip s' -> Skip (NS s')

762− Yield x s' -> Yield x (NS s')

700+ Skip s' -> Skip (N :*: s')

701+ Yield x s' -> Yield x (N :*: s')

763702{-# INLINE [0] drop #-}

764703

765704-- | takeWhile, applied to a predicate @p@ and a stream, returns the

@@ -777,18 +716,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

777716

778717-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

779718dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

780−dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high

719+dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high

781720 where

782721 {-# INLINE next #-}

783− next (L s) = case next0 s of

722+ next (S1 :*: s) = case next0 s of

784723 Done -> Done

785− Skip s' -> Skip (L s')

786− Yield x s' | p x -> Skip (L s')

787− | otherwise -> Yield x (R s')

788− next (R s) = case next0 s of

724+ Skip s' -> Skip (S1 :*: s')

725+ Yield x s' | p x -> Skip (S1 :*: s')

726+ | otherwise -> Yield x (S2 :*: s')

727+ next (S2 :*: s) = case next0 s of

789728 Done -> Done

790− Skip s' -> Skip (R s')

791− Yield x s' -> Yield x (R s')

729+ Skip s' -> Skip (S2 :*: s')

730+ Yield x s' -> Yield x (S2 :*: s')

792731{-# INLINE [0] dropWhile #-}

793732

794733-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns

@@ -804,6 +743,7 @@ isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

804743 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

805744 loop (next1 s1') (next2 s2')

806745{-# INLINE [0] isPrefixOf #-}

746+{-# SPECIALISE isPrefixOf :: Stream Char -> Stream Char -> Bool #-}

807747

808748-- ----------------------------------------------------------------------------

809749-- * Searching

@@ -895,25 +835,21 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0

895835-------------------------------------------------------------------------------

896836-- * Zipping

897837

898−-- | Strict triple.

899−data Zip a b m = Z1 !a !b

900− | Z2 !a !b !m

901−

902838-- | zipWith generalises 'zip' by zipping with the function given as

903839-- the first argument, instead of a tupling function.

904840zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b

905841zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =

906− Stream next (Z1 sa0 sb0) (smaller len1 len2)

842+ Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)

907843 where

908− next (Z1 sa sb) = case next0 sa of

909− Done -> Done

910− Skip sa' -> Skip (Z1 sa' sb)

911− Yield a sa' -> Skip (Z2 sa' sb a)

912−

913− next (Z2 sa' sb a) = case next1 sb of

914− Done -> Done

915− Skip sb' -> Skip (Z2 sa' sb' a)

916− Yield b sb' -> Yield (f a b) (Z1 sa' sb')

844+ next (sa :*: sb :*: N) = case next0 sa of

845+ Done -> Done

846+ Skip sa' -> Skip (sa' :*: sb :*: N)

847+ Yield a sa' -> Skip (sa' :*: sb :*: J a)

848+

849+ next (sa' :*: sb :*: J a) = case next1 sb of

850+ Done -> Done

851+ Skip sb' -> Skip (sa' :*: sb' :*: J a)

852+ Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)

917853{-# INLINE [0] zipWith #-}

918854

919855-- | /O(n)/ The 'countCharI' function returns the number of times the

@@ -929,7 +865,7 @@ countCharI a (Stream next s0 _len) = loop 0 s0

929865{-# INLINE [0] countCharI #-}

930866

931867streamError :: String -> String -> a

932−streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg

868+streamError func msg = P.error $ "Data.Text.Fusion.Common." ++ func ++ ": " ++ msg

933869

934870emptyError :: String -> a

935871emptyError func = internalError func "Empty input"

Data/Text/Internal/Fusion/Types.hs → Data/Text/Fusion/Internal.hsrenamed+20−16

@@ -1,56 +1,58 @@

11{-# LANGUAGE BangPatterns, ExistentialQuantification #-}

22-- |

3−-- Module : Data.Text.Internal.Fusion.Types

3+-- Module : Data.Text.Fusion.Internal

44-- Copyright : (c) Tom Harper 2008-2009,

55-- (c) Bryan O'Sullivan 2009,

66-- (c) Duncan Coutts 2009,

77-- (c) Jasper Van der Jeugt 2011

88--

99-- License : BSD-style

10−-- Maintainer : bos@serpentine.com

10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

11+-- duncan@haskell.org

1112-- Stability : experimental

1213-- Portability : GHC

1314--

14−-- /Warning/: this is an internal module, and does not have a stable

15−-- API or name. Functions in this module may not check or enforce

16−-- preconditions expected by public modules. Use at your own risk!

17−--

1815-- Core stream fusion functionality for text.

1916

20−module Data.Text.Internal.Fusion.Types

17+module Data.Text.Fusion.Internal

2118 (

2219 CC(..)

20+ , M(..)

21+ , M8

2322 , PairS(..)

24− , Scan(..)

2523 , RS(..)

2624 , Step(..)

2725 , Stream(..)

26+ , Switch(..)

2827 , empty

2928 ) where

3029

31−import Data.Text.Internal.Fusion.Size

30+import Data.Text.Fusion.Size

3231import Data.Word (Word8)

3332

3433-- | Specialised tuple for case conversion.

3534data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

3635

37−-- | Restreaming state.

36+-- | Specialised, strict Maybe-like type.

37+data M a = N

38+ | J !a

39+

40+type M8 = M Word8

41+

42+-- Restreaming state.

3843data RS s

3944 = RS0 !s

4045 | RS1 !s {-# UNPACK #-} !Word8

4146 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

4247 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

4348

44−-- | Strict pair.

49+infixl 2 :*:

4550data PairS a b = !a :*: !b

4651 -- deriving (Eq, Ord, Show)

47−infixl 2 :*:

4852

49−-- | An intermediate result in a scan.

50−data Scan s = Scan1 {-# UNPACK #-} !Char !s

51− | Scan2 {-# UNPACK #-} !Char !s

53+-- | Allow a function over a stream to switch between two states.

54+data Switch = S1 | S2

5255

53−-- | Intermediate result in a processing pipeline.

5456data Step s a = Done

5557 | Skip !s

5658 | Yield !a !s

@@ -99,6 +101,7 @@ eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

99101 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

100102 loop (next1 s1') (next2 s2')

101103{-# INLINE [0] eq #-}

104+{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}

102105

103106cmp :: (Ord a) => Stream a -> Stream a -> Ordering

104107cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

@@ -114,6 +117,7 @@ cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

114117 EQ -> loop (next1 s1') (next2 s2')

115118 other -> other

116119{-# INLINE [0] cmp #-}

120+{-# SPECIALISE cmp :: Stream Char -> Stream Char -> Ordering #-}

117121

118122-- | The empty stream.

119123empty :: Stream a

Data/Text/Fusion/Size.hsnew file+146

@@ -0,0 +1,146 @@

1+{-# LANGUAGE CPP #-}

2+{-# OPTIONS_GHC -fno-warn-missing-methods #-}

3+-- |

4+-- Module : Data.Text.Fusion.Internal

5+-- Copyright : (c) Roman Leshchinskiy 2008,

6+-- (c) Bryan O'Sullivan 2009

7+--

8+-- License : BSD-style

9+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

10+-- duncan@haskell.org

11+-- Stability : experimental

12+-- Portability : portable

13+--

14+-- Size hints.

15+

16+module Data.Text.Fusion.Size

17+ (

18+ Size

19+ , exactly

20+ , exactSize

21+ , maxSize

22+ , unknownSize

23+ , smaller

24+ , larger

25+ , upperBound

26+ , isEmpty

27+ ) where

28+

29+#if defined(ASSERTS)

30+import Control.Exception (assert)

31+#endif

32+

33+data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.

34+ | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.

35+ | Unknown -- ^ Unknown size.

36+ deriving (Eq, Show)

37+

38+exactly :: Size -> Maybe Int

39+exactly (Exact n) = Just n

40+exactly _ = Nothing

41+{-# INLINE exactly #-}

42+

43+exactSize :: Int -> Size

44+exactSize n =

45+#if defined(ASSERTS)

46+ assert (n >= 0)

47+#endif

48+ Exact n

49+{-# INLINE exactSize #-}

50+

51+maxSize :: Int -> Size

52+maxSize n =

53+#if defined(ASSERTS)

54+ assert (n >= 0)

55+#endif

56+ Max n

57+{-# INLINE maxSize #-}

58+

59+unknownSize :: Size

60+unknownSize = Unknown

61+{-# INLINE unknownSize #-}

62+

63+instance Num Size where

64+ (+) = addSize

65+ (-) = subtractSize

66+ (*) = mulSize

67+

68+ fromInteger = f where f = Exact . fromInteger

69+ {-# INLINE f #-}

70+

71+add :: Int -> Int -> Int

72+add m n | mn >= 0 = mn

73+ | otherwise = overflowError

74+ where mn = m + n

75+{-# INLINE add #-}

76+

77+addSize :: Size -> Size -> Size

78+addSize (Exact m) (Exact n) = Exact (add m n)

79+addSize (Exact m) (Max n) = Max (add m n)

80+addSize (Max m) (Exact n) = Max (add m n)

81+addSize (Max m) (Max n) = Max (add m n)

82+addSize _ _ = Unknown

83+{-# INLINE addSize #-}

84+

85+subtractSize :: Size -> Size -> Size

86+subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)

87+subtractSize (Exact m) (Max _) = Max m

88+subtractSize (Max m) (Exact n) = Max (max (m-n) 0)

89+subtractSize a@(Max _) (Max _) = a

90+subtractSize a@(Max _) Unknown = a

91+subtractSize _ _ = Unknown

92+{-# INLINE subtractSize #-}

93+

94+mul :: Int -> Int -> Int

95+mul m n

96+ | m <= maxBound `div` n = m * n

97+ | otherwise = overflowError

98+{-# INLINE mul #-}

99+

100+mulSize :: Size -> Size -> Size

101+mulSize (Exact m) (Exact n) = Exact (mul m n)

102+mulSize (Exact m) (Max n) = Max (mul m n)

103+mulSize (Max m) (Exact n) = Max (mul m n)

104+mulSize (Max m) (Max n) = Max (mul m n)

105+mulSize _ _ = Unknown

106+{-# INLINE mulSize #-}

107+

108+-- | Minimum of two size hints.

109+smaller :: Size -> Size -> Size

110+smaller (Exact m) (Exact n) = Exact (m `min` n)

111+smaller (Exact m) (Max n) = Max (m `min` n)

112+smaller (Exact m) Unknown = Max m

113+smaller (Max m) (Exact n) = Max (m `min` n)

114+smaller (Max m) (Max n) = Max (m `min` n)

115+smaller a@(Max _) Unknown = a

116+smaller Unknown (Exact n) = Max n

117+smaller Unknown (Max n) = Max n

118+smaller Unknown Unknown = Unknown

119+{-# INLINE smaller #-}

120+

121+-- | Maximum of two size hints.

122+larger :: Size -> Size -> Size

123+larger (Exact m) (Exact n) = Exact (m `max` n)

124+larger a@(Exact m) b@(Max n) | m >= n = a

125+ | otherwise = b

126+larger a@(Max m) b@(Exact n) | n >= m = b

127+ | otherwise = a

128+larger (Max m) (Max n) = Max (m `max` n)

129+larger _ _ = Unknown

130+{-# INLINE larger #-}

131+

132+-- | Compute the maximum size from a size hint, if possible.

133+upperBound :: Int -> Size -> Int

134+upperBound _ (Exact n) = n

135+upperBound _ (Max n) = n

136+upperBound k _ = k

137+{-# INLINE upperBound #-}

138+

139+isEmpty :: Size -> Bool

140+isEmpty (Exact n) = n <= 0

141+isEmpty (Max n) = n <= 0

142+isEmpty _ = False

143+{-# INLINE isEmpty #-}

144+

145+overflowError :: Int

146+overflowError = error "Data.Text.Fusion.Size: size overflow"

Data/Text/IO.hs+38−42

@@ -1,7 +1,4 @@

11{-# LANGUAGE BangPatterns, CPP, RecordWildCards, ScopedTypeVariables #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-}

4−#endif

52-- |

63-- Module : Data.Text.IO

@@ -19,7 +16,7 @@

1916module Data.Text.IO

2017 (

2118 -- * Performance

22− -- $performance

19+ -- $performance

2320

2421 -- * Locale support

2522 -- $locale

@@ -29,7 +26,6 @@ module Data.Text.IO

2926 , appendFile

3027 -- * Operations on handles

3128 , hGetContents

32− , hGetChunk

3329 , hGetLine

3430 , hPutStr

3531 , hPutStrLn

@@ -42,17 +38,21 @@ module Data.Text.IO

4238 ) where

4339

4440import Data.Text (Text)

45−import Prelude hiding (appendFile, getContents, getLine, interact,

41+import Prelude hiding (appendFile, catch, getContents, getLine, interact,

4642 putStr, putStrLn, readFile, writeFile)

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

4844 withFile)

49−import qualified Control.Exception as E

45+#if __GLASGOW_HASKELL__ <= 610

46+import qualified Data.ByteString.Char8 as B

47+import Data.Text.Encoding (decodeUtf8, encodeUtf8)

48+#else

49+import Control.Exception (catch, throwIO)

5050import Control.Monad (liftM2, when)

5151import Data.IORef (readIORef, writeIORef)

5252import qualified Data.Text as T

53−import Data.Text.Internal.Fusion (stream)

54−import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))

55−import Data.Text.Internal.IO (hGetLineWith, readChunk)

53+import Data.Text.Fusion (stream)

54+import Data.Text.Fusion.Internal (Step(..), Stream(..))

55+import Data.Text.IO.Internal (hGetLineWith, readChunk)

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

5757 RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,

5858 writeCharBuf)

@@ -64,6 +64,7 @@ import GHC.IO.Handle.Types (BufferList(..), BufferMode(..), Handle__(..),

6464 HandleType(..), Newline(..))

6565import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)

6666import System.IO.Error (isEOFError)

67+#endif

6768

6869-- $performance

6970-- #performance#

@@ -96,30 +97,6 @@ writeFile p = withFile p WriteMode . flip hPutStr

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

9798appendFile p = withFile p AppendMode . flip hPutStr

9899

99−catchError :: String -> Handle -> Handle__ -> IOError -> IO Text

100−catchError caller h Handle__{..} err

101− | isEOFError err = do

102− buf <- readIORef haCharBuffer

103− return $ if isEmptyBuffer buf

104− then T.empty

105− else T.singleton '\r'

106− | otherwise = E.throwIO (augmentIOError err caller h)

107−

108−-- | /Experimental./ Read a single chunk of strict text from a

109−-- 'Handle'. The size of the chunk depends on the amount of input

110−-- currently buffered.

111−--

112−-- This function blocks only if there is no data available, and EOF

113−-- has not yet been reached. Once EOF is reached, this function

114−-- returns an empty string instead of throwing an exception.

115−hGetChunk :: Handle -> IO Text

116−hGetChunk h = wantReadableHandle "hGetChunk" h readSingleChunk

117− where

118− readSingleChunk hh@Handle__{..} = do

119− buf <- readIORef haCharBuffer

120− t <- readChunk hh buf `E.catch` catchError "hGetChunk" h hh

121− return (hh, t)

122−

123100-- | Read the remaining contents of a 'Handle' as a string. The

124101-- 'Handle' is closed once the contents have been read, or if an

125102-- exception is thrown.

@@ -132,21 +109,31 @@ hGetChunk h = wantReadableHandle "hGetChunk" h readSingleChunk

132109-- result to construct its result. For files more than a half of

133110-- available RAM in size, this may result in memory exhaustion.

134111hGetContents :: Handle -> IO Text

112+#if __GLASGOW_HASKELL__ <= 610

113+hGetContents = fmap decodeUtf8 . B.hGetContents

114+#else

135115hGetContents h = do

136116 chooseGoodBuffering h

137117 wantReadableHandle "hGetContents" h readAll

138118 where

139119 readAll hh@Handle__{..} = do

140− let readChunks = do

120+ let catchError e

121+ | isEOFError e = do

122+ buf <- readIORef haCharBuffer

123+ return $ if isEmptyBuffer buf

124+ then T.empty

125+ else T.singleton '\r'

126+ | otherwise = throwIO (augmentIOError e "hGetContents" h)

127+ readChunks = do

141128 buf <- readIORef haCharBuffer

142− t <- readChunk hh buf `E.catch` catchError "hGetContents" h hh

129+ t <- readChunk hh buf `catch` catchError

143130 if T.null t

144131 then return [t]

145132 else (t:) `fmap` readChunks

146133 ts <- readChunks

147134 (hh', _) <- hClose_help hh

148135 return (hh'{haType=ClosedHandle}, T.concat ts)

149−

136+

150137-- | Use a more efficient buffer size if we're reading in

151138-- block-buffered mode with the default buffer size. When we can

152139-- determine the size of the handle we're reading, set the buffer size

@@ -157,22 +144,30 @@ chooseGoodBuffering h = do

157144 bufMode <- hGetBuffering h

158145 case bufMode of

159146 BlockBuffering Nothing -> do

160− d <- E.catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) ->

147+ d <- catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) ->

161148 if ioe_type e == InappropriateType

162149 then return 16384 -- faster than the 2KB default

163− else E.throwIO e

150+ else throwIO e

164151 when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d

165152 _ -> return ()

153+#endif

166154

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

168156hGetLine :: Handle -> IO Text

157+#if __GLASGOW_HASKELL__ <= 610

158+hGetLine = fmap decodeUtf8 . B.hGetLine

159+#else

169160hGetLine = hGetLineWith T.concat

161+#endif

170162

171163-- | Write a string to a handle.

172164hPutStr :: Handle -> Text -> IO ()

165+#if __GLASGOW_HASKELL__ <= 610

166+hPutStr h = B.hPutStr h . encodeUtf8

167+#else

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

174169hPutStr h t = do

175− (buffer_mode, nl) <-

170+ (buffer_mode, nl) <-

176171 wantWritableHandle "hPutStr" h $ \h_ -> do

177172 bmode <- getSpareBuffer h_

178173 return (bmode, haOutputNL h_)

@@ -254,7 +249,7 @@ writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0

254249

255250-- This function is completely lifted from GHC.IO.Handle.Text.

256251getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)

257−getSpareBuffer Handle__{haCharBuffer=ref,

252+getSpareBuffer Handle__{haCharBuffer=ref,

258253 haBuffers=spare_ref,

259254 haBufferMode=mode}

260255 = do

@@ -275,10 +270,11 @@ getSpareBuffer Handle__{haCharBuffer=ref,

275270-- This function is completely lifted from GHC.IO.Handle.Text.

276271commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool

277272 -> IO CharBuffer

278−commitBuffer hdl !raw !sz !count flush release =

273+commitBuffer hdl !raw !sz !count flush release =

279274 wantWritableHandle "commitAndReleaseBuffer" hdl $

280275 commitBuffer' raw sz count flush release

281276{-# INLINE commitBuffer #-}

277+#endif

282278

283279-- | Write a string to a handle, followed by a newline.

284280hPutStrLn :: Handle -> Text -> IO ()

Data/Text/Internal/IO.hs → Data/Text/IO/Internal.hsrenamed+14−13

@@ -1,6 +1,6 @@

11{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}

22-- |

3−-- Module : Data.Text.Internal.IO

3+-- Module : Data.Text.IO.Internal

66-- License : BSD-style

@@ -8,24 +8,23 @@

88-- Stability : experimental

99-- Portability : GHC

1010--

11−-- /Warning/: this is an internal module, and does not have a stable

12−-- API or name. Functions in this module may not check or enforce

13−-- preconditions expected by public modules. Use at your own risk!

14−--

1511-- Low-level support for text I\/O.

1612

17−module Data.Text.Internal.IO

13+module Data.Text.IO.Internal

1814 (

15+#if __GLASGOW_HASKELL__ >= 612

1916 hGetLineWith

2017 , readChunk

18+#endif

2119 ) where

2220

23−import qualified Control.Exception as E

21+#if __GLASGOW_HASKELL__ >= 612

22+import Control.Exception (catch)

2423import Data.IORef (readIORef, writeIORef)

2524import Data.Text (Text)

26−import Data.Text.Internal.Fusion (unstream)

27−import Data.Text.Internal.Fusion.Types (Step(..), Stream(..))

28−import Data.Text.Internal.Fusion.Size (exactSize, maxSize)

25+import Data.Text.Fusion (unstream)

26+import Data.Text.Fusion.Internal (Step(..), Stream(..))

27+import Data.Text.Fusion.Size (exactSize, maxSize)

2928import Data.Text.Unsafe (inlinePerformIO)

3029import Foreign.Storable (peekElemOff)

3130import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,

@@ -33,6 +32,7 @@ import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,

3332 withRawBuffer, writeCharBuf)

3433import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_)

3534import GHC.IO.Handle.Types (Handle__(..), Newline(..))

35+import Prelude hiding (catch)

3636import System.IO (Handle)

3737import System.IO.Error (isEOFError)

3838import qualified Data.Text as T

@@ -84,9 +84,9 @@ hGetLineLoop hh@Handle__{..} = go where

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

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

8686maybeFillReadBuffer handle_ buf

87− = E.catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->

88− if isEOFError e

89− then return Nothing

87+ = catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->

88+ if isEOFError e

89+ then return Nothing

9090 else ioError e

9191

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

@@ -164,3 +164,4 @@ readChunk hh@Handle__{..} buf = do

164164

165165sizeError :: String -> a

166166sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"

167+#endif

Data/Text/Internal.hs+17−102

@@ -1,5 +1,4 @@

1−{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}

2−{-# OPTIONS_HADDOCK not-home #-}

1+{-# LANGUAGE CPP, DeriveDataTypeable #-}

43-- |

54-- Module : Data.Text.Internal

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

98--

109-- License : BSD-style

11−-- Maintainer : bos@serpentine.com

10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

11+-- duncan@haskell.org

1212-- Stability : experimental

1313-- Portability : GHC

1414--

@@ -20,14 +20,9 @@

2020-- with the internals, as the functions here do just about nothing to

2121-- preserve data invariants. You have been warned!

2222

23−#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)

24−#include "MachDeps.h"

25−#endif

26−

2723module Data.Text.Internal

2824 (

2925 -- * Types

30− -- $internals

3126 Text(..)

3227 -- * Construction

3328 , text

@@ -36,13 +31,8 @@ module Data.Text.Internal

3631 , safe

3732 -- * Code that must be here for accessibility

3833 , empty

39− , empty_

4034 -- * Utilities

4135 , firstf

42− -- * Checked multiplication

43− , mul

44− , mul32

45− , mul64

4636 -- * Debugging

4737 , showText

4838 ) where

@@ -50,22 +40,21 @@ module Data.Text.Internal

5040#if defined(ASSERTS)

5141import Control.Exception (assert)

5242#endif

53−import Data.Bits

54−import Data.Int (Int32, Int64)

55−import Data.Text.Internal.Unsafe.Char (ord)

56−import Data.Typeable (Typeable)

43+import Data.Bits ((.&.))

5744import qualified Data.Text.Array as A

45+import Data.Text.UnsafeChar (ord)

46+import Data.Typeable (Typeable)

5847

5948-- | A space efficient, packed, unboxed Unicode text type.

6049data Text = Text

61− {-# UNPACK #-} !A.Array -- payload (Word16 elements)

62− {-# UNPACK #-} !Int -- offset (units of Word16, not Char)

63− {-# UNPACK #-} !Int -- length (units of Word16, not Char)

50+ {-# UNPACK #-} !A.Array -- payload

51+ {-# UNPACK #-} !Int -- offset

52+ {-# UNPACK #-} !Int -- length

6453 deriving (Typeable)

6554

6655-- | Smart constructor.

67−text_ :: A.Array -> Int -> Int -> Text

68−text_ arr off len =

56+text :: A.Array -> Int -> Int -> Text

57+text arr off len =

6958#if defined(ASSERTS)

7059 let c = A.unsafeIndex arr off

7160 alen = A.length arr

@@ -75,28 +64,19 @@ text_ arr off len =

7564 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $

7665#endif

7766 Text arr off len

78−{-# INLINE text_ #-}

67+{-# INLINE text #-}

7968

8069-- | /O(1)/ The empty 'Text'.

8170empty :: Text

8271empty = Text A.empty 0 0

8372{-# INLINE [1] empty #-}

8473

85−-- | A non-inlined version of 'empty'.

86−empty_ :: Text

87−empty_ = Text A.empty 0 0

88−{-# NOINLINE empty_ #-}

89−

9074-- | Construct a 'Text' without invisibly pinning its byte array in

9175-- memory if its length has dwindled to zero.

92−text :: A.Array -> Int -> Int -> Text

93−text arr off len | len == 0 = empty

94− | otherwise = text_ arr off len

95−{-# INLINE text #-}

96−

9776textP :: A.Array -> Int -> Int -> Text

98−{-# DEPRECATED textP "Use text instead" #-}

99−textP = text

77+textP arr off len | len == 0 = empty

78+ | otherwise = text arr off len

79+{-# INLINE textP #-}

10080

10181-- | A useful 'show'-like function for debugging purposes.

10282showText :: Text -> String

@@ -110,79 +90,14 @@ showText (Text arr off len) =

11090-- scalar values, but are unfortunately admitted as valid 'Char'

11191-- values by Haskell. They cannot be represented in a 'Text'. This

11292-- function remaps those code points to the Unicode replacement

113−-- character (U+FFFD, \'�\'), and leaves other code points

114−-- unchanged.

93+-- character \"�\", and leaves other code points unchanged.

11594safe :: Char -> Char

11695safe c

11796 | ord c .&. 0x1ff800 /= 0xd800 = c

11897 | otherwise = '\xfffd'

119−{-# INLINE [0] safe #-}

98+{-# INLINE safe #-}

12099

121100-- | Apply a function to the first element of an optional pair.

122101firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)

123102firstf f (Just (a, b)) = Just (f a, b)

124103firstf _ Nothing = Nothing

125−

126−-- | Checked multiplication. Calls 'error' if the result would

127−-- overflow.

128−mul :: Int -> Int -> Int

129−#if WORD_SIZE_IN_BITS == 64

130−mul a b = fromIntegral $ fromIntegral a `mul64` fromIntegral b

131−#else

132−mul a b = fromIntegral $ fromIntegral a `mul32` fromIntegral b

133−#endif

134−{-# INLINE mul #-}

135−infixl 7 `mul`

136−

137−-- | Checked multiplication. Calls 'error' if the result would

138−-- overflow.

139−mul64 :: Int64 -> Int64 -> Int64

140−mul64 a b

141− | a >= 0 && b >= 0 = mul64_ a b

142− | a >= 0 = -mul64_ a (-b)

143− | b >= 0 = -mul64_ (-a) b

144− | otherwise = mul64_ (-a) (-b)

145−{-# INLINE mul64 #-}

146−infixl 7 `mul64`

147−

148−mul64_ :: Int64 -> Int64 -> Int64

149−mul64_ a b

150− | ahi > 0 && bhi > 0 = error "overflow"

151− | top > 0x7fffffff = error "overflow"

152− | total < 0 = error "overflow"

153− | otherwise = total

154− where (# ahi, alo #) = (# a `shiftR` 32, a .&. 0xffffffff #)

155− (# bhi, blo #) = (# b `shiftR` 32, b .&. 0xffffffff #)

156− top = ahi * blo + alo * bhi

157− total = (top `shiftL` 32) + alo * blo

158−{-# INLINE mul64_ #-}

159−

160−-- | Checked multiplication. Calls 'error' if the result would

161−-- overflow.

162−mul32 :: Int32 -> Int32 -> Int32

163−mul32 a b = case fromIntegral a * fromIntegral b of

164− ab | ab < min32 || ab > max32 -> error "overflow"

165− | otherwise -> fromIntegral ab

166− where min32 = -0x80000000 :: Int64

167− max32 = 0x7fffffff

168−{-# INLINE mul32 #-}

169−infixl 7 `mul32`

170−

171−-- $internals

172−--

173−-- Internally, the 'Text' type is represented as an array of 'Word16'

174−-- UTF-16 code units. The offset and length fields in the constructor

175−-- are in these units, /not/ units of 'Char'.

176−--

177−-- Invariants that all functions must maintain:

178−--

179−-- * Since the 'Text' type uses UTF-16 internally, it cannot represent

180−-- characters in the reserved surrogate code point range U+D800 to

181−-- U+DFFF. To maintain this invariant, the 'safe' function maps

182−-- 'Char' values in this range to the replacement character (U+FFFD,

183−-- \'�\').

184−--

185−-- * A leading (or \"high\") surrogate code unit (0xD800–0xDBFF) must

186−-- always be followed by a trailing (or \"low\") surrogate code unit

187−-- (0xDC00-0xDFFF). A trailing surrogate code unit must always be

188−-- preceded by a leading surrogate code unit.

Data/Text/Internal/Builder.hsdeleted−329

@@ -1,329 +0,0 @@

1−{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}

2−{-# OPTIONS_HADDOCK not-home #-}

3−

4−-----------------------------------------------------------------------------

5−-- |

6−-- Module : Data.Text.Internal.Builder

9−-- License : BSD-style (see LICENSE)

10−--

11−-- Maintainer : Johan Tibell <johan.tibell@gmail.com>

12−-- Stability : experimental

13−-- Portability : portable to Hugs and GHC

14−--

15−-- /Warning/: this is an internal module, and does not have a stable

16−-- API or name. Functions in this module may not check or enforce

17−-- preconditions expected by public modules. Use at your own risk!

18−--

19−-- Efficient construction of lazy @Text@ values. The principal

20−-- operations on a @Builder@ are @singleton@, @fromText@, and

21−-- @fromLazyText@, which construct new builders, and 'mappend', which

22−-- concatenates two builders.

23−--

24−-- To get maximum performance when building lazy @Text@ values using a

25−-- builder, associate @mappend@ calls to the right. For example,

26−-- prefer

27−--

28−-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')

29−--

30−-- to

31−--

32−-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'

33−--

34−-- as the latter associates @mappend@ to the left.

35−--

36−-----------------------------------------------------------------------------

37−

38−module Data.Text.Internal.Builder

39− ( -- * Public API

40− -- ** The Builder type

41− Builder

42− , toLazyText

43− , toLazyTextWith

44−

45− -- ** Constructing Builders

46− , singleton

47− , fromText

48− , fromLazyText

49− , fromString

50−

51− -- ** Flushing the buffer state

52− , flush

53−

54− -- * Internal functions

55− , append'

56− , ensureFree

57− , writeN

58− ) where

59−

60−import Control.Monad.ST (ST, runST)

61−import Data.Monoid (Monoid(..))

62−#if MIN_VERSION_base(4,9,0)

63−import Data.Semigroup (Semigroup(..))

64−#endif

65−import Data.Text.Internal (Text(..))

66−import Data.Text.Internal.Lazy (smallChunkSize)

67−import Data.Text.Unsafe (inlineInterleaveST)

68−import Data.Text.Internal.Unsafe.Char (unsafeWrite)

69−import Prelude hiding (map, putChar)

70−

71−import qualified Data.String as String

72−import qualified Data.Text as S

73−import qualified Data.Text.Array as A

74−import qualified Data.Text.Lazy as L

75−

76−------------------------------------------------------------------------

77−

78−-- | A @Builder@ is an efficient way to build lazy @Text@ values.

79−-- There are several functions for constructing builders, but only one

80−-- to inspect them: to extract any data, you have to turn them into

81−-- lazy @Text@ values using @toLazyText@.

82−--

83−-- Internally, a builder constructs a lazy @Text@ by filling arrays

84−-- piece by piece. As each buffer is filled, it is \'popped\' off, to

85−-- become a new chunk of the resulting lazy @Text@. All this is

86−-- hidden from the user of the @Builder@.

87−newtype Builder = Builder {

88− -- Invariant (from Data.Text.Lazy):

89− -- The lists include no null Texts.

90− runBuilder :: forall s. (Buffer s -> ST s [S.Text])

91− -> Buffer s

92− -> ST s [S.Text]

93− }

94−

95−#if MIN_VERSION_base(4,9,0)

96−instance Semigroup Builder where

97− (<>) = append

98− {-# INLINE (<>) #-}

99−#endif

100−

101−instance Monoid Builder where

102− mempty = empty

103− {-# INLINE mempty #-}

104−#if MIN_VERSION_base(4,9,0)

105− mappend = (<>) -- future-proof definition

106−#else

107− mappend = append

108−#endif

109− {-# INLINE mappend #-}

110− mconcat = foldr mappend Data.Monoid.mempty

111− {-# INLINE mconcat #-}

112−

113−instance String.IsString Builder where

114− fromString = fromString

115− {-# INLINE fromString #-}

116−

117−instance Show Builder where

118− show = show . toLazyText

119−

120−instance Eq Builder where

121− a == b = toLazyText a == toLazyText b

122−

123−instance Ord Builder where

124− a <= b = toLazyText a <= toLazyText b

125−

126−------------------------------------------------------------------------

127−

128−-- | /O(1)./ The empty @Builder@, satisfying

129−--

130−-- * @'toLazyText' 'empty' = 'L.empty'@

131−--

132−empty :: Builder

133−empty = Builder (\ k buf -> k buf)

134−{-# INLINE empty #-}

135−

136−-- | /O(1)./ A @Builder@ taking a single character, satisfying

137−--

138−-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@

139−--

140−singleton :: Char -> Builder

141−singleton c = writeAtMost 2 $ \ marr o -> unsafeWrite marr o c

142−{-# INLINE singleton #-}

143−

144−------------------------------------------------------------------------

145−

146−-- | /O(1)./ The concatenation of two builders, an associative

147−-- operation with identity 'empty', satisfying

148−--

149−-- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@

150−--

151−append :: Builder -> Builder -> Builder

152−append (Builder f) (Builder g) = Builder (f . g)

153−{-# INLINE [0] append #-}

154−

155−-- TODO: Experiment to find the right threshold.

156−copyLimit :: Int

157−copyLimit = 128

158−

159−-- This function attempts to merge small @Text@ values instead of

160−-- treating each value as its own chunk. We may not always want this.

161−

162−-- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying

163−--

164−-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@

165−--

166−fromText :: S.Text -> Builder

167−fromText t@(Text arr off l)

168− | S.null t = empty

169− | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)

170− | otherwise = flush `append` mapBuilder (t :)

171−{-# INLINE [1] fromText #-}

172−

173−{-# RULES

174−"fromText/pack" forall s .

175− fromText (S.pack s) = fromString s

176− #-}

177−

178−-- | /O(1)./ A Builder taking a @String@, satisfying

179−--

180−-- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@

181−--

182−fromString :: String -> Builder

183−fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->

184− let loop !marr !o !u !l [] = k (Buffer marr o u l)

185− loop marr o u l s@(c:cs)

186− | l <= 1 = do

187− arr <- A.unsafeFreeze marr

188− let !t = Text arr o u

189− marr' <- A.new chunkSize

190− ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)

191− return $ t : ts

192− | otherwise = do

193− n <- unsafeWrite marr (o+u) c

194− loop marr o (u+n) (l-n) cs

195− in loop p0 o0 u0 l0 str

196− where

197− chunkSize = smallChunkSize

198−{-# INLINE fromString #-}

199−

200−-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying

201−--

202−-- * @'toLazyText' ('fromLazyText' t) = t@

203−--

204−fromLazyText :: L.Text -> Builder

205−fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)

206−{-# INLINE fromLazyText #-}

207−

208−------------------------------------------------------------------------

209−

210−-- Our internal buffer type

211−data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)

212− {-# UNPACK #-} !Int -- offset

213− {-# UNPACK #-} !Int -- used units

214− {-# UNPACK #-} !Int -- length left

215−

216−------------------------------------------------------------------------

217−

218−-- | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default

219−-- buffer size. The construction work takes place if and when the

220−-- relevant part of the lazy @Text@ is demanded.

221−toLazyText :: Builder -> L.Text

222−toLazyText = toLazyTextWith smallChunkSize

223−

224−-- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given

225−-- size for the initial buffer. The construction work takes place if

226−-- and when the relevant part of the lazy @Text@ is demanded.

227−--

228−-- If the initial buffer is too small to hold all data, subsequent

229−-- buffers will be the default buffer size.

230−toLazyTextWith :: Int -> Builder -> L.Text

231−toLazyTextWith chunkSize m = L.fromChunks (runST $

232− newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))

233−

234−-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,

235−-- yielding a new chunk in the result lazy @Text@.

236−flush :: Builder

237−flush = Builder $ \ k buf@(Buffer p o u l) ->

238− if u == 0

239− then k buf

240− else do arr <- A.unsafeFreeze p

241− let !b = Buffer p (o+u) 0 l

242− !t = Text arr o u

243− ts <- inlineInterleaveST (k b)

244− return $! t : ts

245−{-# INLINE [1] flush #-}

246−-- defer inlining so that flush/flush rule may fire.

247−

248−------------------------------------------------------------------------

249−

250−-- | Sequence an ST operation on the buffer

251−withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder

252−withBuffer f = Builder $ \k buf -> f buf >>= k

253−{-# INLINE withBuffer #-}

254−

255−-- | Get the size of the buffer

256−withSize :: (Int -> Builder) -> Builder

257−withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->

258− runBuilder (f l) k buf

259−{-# INLINE withSize #-}

260−

261−-- | Map the resulting list of texts.

262−mapBuilder :: ([S.Text] -> [S.Text]) -> Builder

263−mapBuilder f = Builder (fmap f .)

264−

265−------------------------------------------------------------------------

266−

267−-- | Ensure that there are at least @n@ many elements available.

268−ensureFree :: Int -> Builder

269−ensureFree !n = withSize $ \ l ->

270− if n <= l

271− then empty

272− else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))

273−{-# INLINE [0] ensureFree #-}

274−

275−writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder

276−writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)

277−{-# INLINE [0] writeAtMost #-}

278−

279−-- | Ensure that @n@ many elements are available, and then use @f@ to

280−-- write some elements into the memory.

281−writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder

282−writeN n f = writeAtMost n (\ p o -> f p o >> return n)

283−{-# INLINE writeN #-}

284−

285−writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)

286−writeBuffer f (Buffer p o u l) = do

287− n <- f p (o+u)

288− return $! Buffer p o (u+n) (l-n)

289−{-# INLINE writeBuffer #-}

290−

291−newBuffer :: Int -> ST s (Buffer s)

292−newBuffer size = do

293− arr <- A.new size

294− return $! Buffer arr 0 0 size

295−{-# INLINE newBuffer #-}

296−

297−------------------------------------------------------------------------

298−-- Some nice rules for Builder

299−

300−-- This function makes GHC understand that 'writeN' and 'ensureFree'

301−-- are *not* recursive in the precense of the rewrite rules below.

302−-- This is not needed with GHC 7+.

303−append' :: Builder -> Builder -> Builder

304−append' (Builder f) (Builder g) = Builder (f . g)

305−{-# INLINE append' #-}

306−

307−{-# RULES

308−

309−"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)

310− (g::forall s. A.MArray s -> Int -> ST s Int) ws.

311− append (writeAtMost a f) (append (writeAtMost b g) ws) =

312− append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->

313− g marr (o+n) >>= \ m ->

314− let s = n+m in s `seq` return s)) ws

315−

316−"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)

317− (g::forall s. A.MArray s -> Int -> ST s Int).

318− append (writeAtMost a f) (writeAtMost b g) =

319− writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->

320− g marr (o+n) >>= \ m ->

321− let s = n+m in s `seq` return s)

322−

323−"ensureFree/ensureFree" forall a b .

324− append (ensureFree a) (ensureFree b) = ensureFree (max a b)

325−

326−"flush/flush"

327− append flush flush = flush

328−

329− #-}

Data/Text/Internal/Builder/Int/Digits.hsdeleted−26

@@ -1,26 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−-- Module: Data.Text.Internal.Builder.Int.Digits

5−-- License: BSD-style

6−-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>

7−-- Stability: experimental

8−-- Portability: portable

9−--

10−-- /Warning/: this is an internal module, and does not have a stable

11−-- API or name. Functions in this module may not check or enforce

12−-- preconditions expected by public modules. Use at your own risk!

13−--

14−-- This module exists because the C preprocessor does things that we

15−-- shall not speak of when confronted with Haskell multiline strings.

16−

17−module Data.Text.Internal.Builder.Int.Digits (digits) where

18−

19−import Data.ByteString.Char8 (ByteString)

20−

21−digits :: ByteString

22−digits = "0001020304050607080910111213141516171819\

23− \2021222324252627282930313233343536373839\

24− \4041424344454647484950515253545556575859\

25− \6061626364656667686970717273747576777879\

26− \8081828384858687888990919293949596979899"

Data/Text/Internal/Builder/RealFloat/Functions.hsdeleted−57

@@ -1,57 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−

3−-- |

4−-- Module: Data.Text.Internal.Builder.RealFloat.Functions

5−-- Copyright: (c) The University of Glasgow 1994-2002

6−-- License: see libraries/base/LICENSE

7−--

8−-- /Warning/: this is an internal module, and does not have a stable

9−-- API or name. Functions in this module may not check or enforce

10−-- preconditions expected by public modules. Use at your own risk!

11−

12−module Data.Text.Internal.Builder.RealFloat.Functions

13− (

14− roundTo

15− ) where

16−

17−roundTo :: Int -> [Int] -> (Int,[Int])

18−

19−#if MIN_VERSION_base(4,6,0)

20−

21−roundTo d is =

22− case f d True is of

23− x@(0,_) -> x

24− (1,xs) -> (1, 1:xs)

25− _ -> error "roundTo: bad Value"

26− where

27− b2 = base `quot` 2

28−

29− f n _ [] = (0, replicate n 0)

30− f 0 e (x:xs) | x == b2 && e && all (== 0) xs = (0, []) -- Round to even when at exactly half the base

31− | otherwise = (if x >= b2 then 1 else 0, [])

32− f n _ (i:xs)

33− | i' == base = (1,0:ds)

34− | otherwise = (0,i':ds)

35− where

36− (c,ds) = f (n-1) (even i) xs

37− i' = c + i

38− base = 10

39−

40−#else

41−

42−roundTo d is =

43− case f d is of

44− x@(0,_) -> x

45− (1,xs) -> (1, 1:xs)

46− _ -> error "roundTo: bad Value"

47− where

48− f n [] = (0, replicate n 0)

49− f 0 (x:_) = (if x >= 5 then 1 else 0, [])

50− f n (i:xs)

51− | i' == 10 = (1,0:ds)

52− | otherwise = (0,i':ds)

53− where

54− (c,ds) = f (n-1) xs

55− i' = c + i

56−

57−#endif

Data/Text/Internal/Fusion/Size.hsdeleted−157

@@ -1,157 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# OPTIONS_GHC -fno-warn-missing-methods #-}

3−-- |

4−-- Module : Data.Text.Internal.Fusion.Internal

5−-- Copyright : (c) Roman Leshchinskiy 2008,

6−-- (c) Bryan O'Sullivan 2009

7−--

8−-- License : BSD-style

9−-- Maintainer : bos@serpentine.com

10−-- Stability : experimental

11−-- Portability : portable

12−--

13−-- /Warning/: this is an internal module, and does not have a stable

14−-- API or name. Functions in this module may not check or enforce

15−-- preconditions expected by public modules. Use at your own risk!

16−--

17−-- Size hints.

18−

19−module Data.Text.Internal.Fusion.Size

20− (

21− Size

22− , exactly

23− , exactSize

24− , maxSize

25− , betweenSize

26− , unknownSize

27− , smaller

28− , larger

29− , upperBound

30− , lowerBound

31− , compareSize

32− , isEmpty

33− ) where

34−

35−import Data.Text.Internal (mul)

36−#if defined(ASSERTS)

37−import Control.Exception (assert)

38−#endif

39−

40−data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.

41− | Unknown -- ^ Unknown size.

42− deriving (Eq, Show)

43−

44−exactly :: Size -> Maybe Int

45−exactly (Between na nb) | na == nb = Just na

46−exactly _ = Nothing

47−{-# INLINE exactly #-}

48−

49−exactSize :: Int -> Size

50−exactSize n =

51−#if defined(ASSERTS)

52− assert (n >= 0)

53−#endif

54− Between n n

55−{-# INLINE exactSize #-}

56−

57−maxSize :: Int -> Size

58−maxSize n =

59−#if defined(ASSERTS)

60− assert (n >= 0)

61−#endif

62− Between 0 n

63−{-# INLINE maxSize #-}

64−

65−betweenSize :: Int -> Int -> Size

66−betweenSize m n =

67−#if defined(ASSERTS)

68− assert (m >= 0)

69− assert (n >= m)

70−#endif

71− Between m n

72−{-# INLINE betweenSize #-}

73−

74−unknownSize :: Size

75−unknownSize = Unknown

76−{-# INLINE unknownSize #-}

77−

78−instance Num Size where

79− (+) = addSize

80− (-) = subtractSize

81− (*) = mulSize

82−

83− fromInteger = f where f = exactSize . fromInteger

84− {-# INLINE f #-}

85−

86−add :: Int -> Int -> Int

87−add m n | mn >= 0 = mn

88− | otherwise = overflowError

89− where mn = m + n

90−{-# INLINE add #-}

91−

92−addSize :: Size -> Size -> Size

93−addSize (Between ma mb) (Between na nb) = Between (add ma na) (add mb nb)

94−addSize _ _ = Unknown

95−{-# INLINE addSize #-}

96−

97−subtractSize :: Size -> Size -> Size

98−subtractSize (Between ma mb) (Between na nb) = Between (max (ma-nb) 0) (max (mb-na) 0)

99−subtractSize a@(Between 0 _) Unknown = a

100−subtractSize (Between _ mb) Unknown = Between 0 mb

101−subtractSize _ _ = Unknown

102−{-# INLINE subtractSize #-}

103−

104−mulSize :: Size -> Size -> Size

105−mulSize (Between ma mb) (Between na nb) = Between (mul ma na) (mul mb nb)

106−mulSize _ _ = Unknown

107−{-# INLINE mulSize #-}

108−

109−-- | Minimum of two size hints.

110−smaller :: Size -> Size -> Size

111−smaller a@(Between ma mb) b@(Between na nb)

112− | mb <= na = a

113− | nb <= ma = b

114− | otherwise = Between (ma `min` na) (mb `min` nb)

115−smaller a@(Between 0 _) Unknown = a

116−smaller (Between _ mb) Unknown = Between 0 mb

117−smaller Unknown b@(Between 0 _) = b

118−smaller Unknown (Between _ nb) = Between 0 nb

119−smaller Unknown Unknown = Unknown

120−{-# INLINE smaller #-}

121−

122−-- | Maximum of two size hints.

123−larger :: Size -> Size -> Size

124−larger a@(Between ma mb) b@(Between na nb)

125− | ma >= nb = a

126− | na >= mb = b

127− | otherwise = Between (ma `max` na) (mb `max` nb)

128−larger _ _ = Unknown

129−{-# INLINE larger #-}

130−

131−-- | Compute the maximum size from a size hint, if possible.

132−upperBound :: Int -> Size -> Int

133−upperBound _ (Between _ n) = n

134−upperBound k _ = k

135−{-# INLINE upperBound #-}

136−

137−-- | Compute the maximum size from a size hint, if possible.

138−lowerBound :: Int -> Size -> Int

139−lowerBound _ (Between n _) = n

140−lowerBound k _ = k

141−{-# INLINE lowerBound #-}

142−

143−compareSize :: Size -> Int -> Maybe Ordering

144−compareSize (Between ma mb) n

145− | mb < n = Just LT

146− | ma > n = Just GT

147− | ma == n && mb == n = Just EQ

148−compareSize _ _ = Nothing

149−

150−

151−isEmpty :: Size -> Bool

152−isEmpty (Between _ n) = n <= 0

153−isEmpty _ = False

154−{-# INLINE isEmpty #-}

155−

156−overflowError :: Int

157−overflowError = error "Data.Text.Internal.Fusion.Size: size overflow"

Data/Text/Internal/Lazy.hsdeleted−119

@@ -1,119 +0,0 @@

1−{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}

2−{-# OPTIONS_HADDOCK not-home #-}

3−

4−-- |

5−-- Module : Data.Text.Internal.Lazy

7−--

8−-- License : BSD-style

9−-- Maintainer : bos@serpentine.com

10−-- Stability : experimental

11−-- Portability : GHC

12−--

13−-- /Warning/: this is an internal module, and does not have a stable

14−-- API or name. Functions in this module may not check or enforce

15−-- preconditions expected by public modules. Use at your own risk!

16−--

17−-- A module containing private 'Text' internals. This exposes the

18−-- 'Text' representation and low level construction functions.

19−-- Modules which extend the 'Text' system may need to use this module.

20−

21−module Data.Text.Internal.Lazy

22− (

23− Text(..)

24− , chunk

25− , empty

26− , foldrChunks

27− , foldlChunks

28− -- * Data type invariant and abstraction functions

29−

30− -- $invariant

31− , strictInvariant

32− , lazyInvariant

33− , showStructure

34−

35− -- * Chunk allocation sizes

36− , defaultChunkSize

37− , smallChunkSize

38− , chunkOverhead

39− ) where

40−

41−import Data.Text ()

42−import Data.Text.Internal.Unsafe.Shift (shiftL)

43−import Data.Typeable (Typeable)

44−import Foreign.Storable (sizeOf)

45−import qualified Data.Text.Internal as T

46−

47−data Text = Empty

48− | Chunk {-# UNPACK #-} !T.Text Text

49− deriving (Typeable)

50−

51−-- $invariant

52−--

53−-- The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or

54−-- consists of non-null 'T.Text's. All functions must preserve this,

55−-- and the QC properties must check this.

56−

57−-- | Check the invariant strictly.

58−strictInvariant :: Text -> Bool

59−strictInvariant Empty = True

60−strictInvariant x@(Chunk (T.Text _ _ len) cs)

61− | len > 0 = strictInvariant cs

62− | otherwise = error $ "Data.Text.Lazy: invariant violation: "

63− ++ showStructure x

64−

65−-- | Check the invariant lazily.

66−lazyInvariant :: Text -> Text

67−lazyInvariant Empty = Empty

68−lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)

69− | len > 0 = Chunk c (lazyInvariant cs)

70− | otherwise = error $ "Data.Text.Lazy: invariant violation: "

71− ++ showStructure x

72−

73−-- | Display the internal structure of a lazy 'Text'.

74−showStructure :: Text -> String

75−showStructure Empty = "Empty"

76−showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"

77−showStructure (Chunk t ts) =

78− "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"

79−

80−-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.

81−chunk :: T.Text -> Text -> Text

82−{-# INLINE chunk #-}

83−chunk t@(T.Text _ _ len) ts | len == 0 = ts

84− | otherwise = Chunk t ts

85−

86−-- | Smart constructor for 'Empty'.

87−empty :: Text

88−{-# INLINE [0] empty #-}

89−empty = Empty

90−

91−-- | Consume the chunks of a lazy 'Text' with a natural right fold.

92−foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a

93−foldrChunks f z = go

94− where go Empty = z

95− go (Chunk c cs) = f c (go cs)

96−{-# INLINE foldrChunks #-}

97−

98−-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,

99−-- accumulating left fold.

100−foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a

101−foldlChunks f z = go z

102− where go !a Empty = a

103− go !a (Chunk c cs) = go (f a c) cs

104−{-# INLINE foldlChunks #-}

105−

106−-- | Currently set to 16 KiB, less the memory management overhead.

107−defaultChunkSize :: Int

108−defaultChunkSize = 16384 - chunkOverhead

109−{-# INLINE defaultChunkSize #-}

110−

111−-- | Currently set to 128 bytes, less the memory management overhead.

112−smallChunkSize :: Int

113−smallChunkSize = 128 - chunkOverhead

114−{-# INLINE smallChunkSize #-}

115−

116−-- | The memory management overhead. Currently this is tuned for GHC only.

117−chunkOverhead :: Int

118−chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1

119−{-# INLINE chunkOverhead #-}

Data/Text/Internal/Private.hsdeleted−37

@@ -1,37 +0,0 @@

1−{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}

2−

3−-- |

4−-- Module : Data.Text.Internal.Private

6−--

7−-- License : BSD-style

8−-- Maintainer : bos@serpentine.com

9−-- Stability : experimental

10−-- Portability : GHC

11−

12−module Data.Text.Internal.Private

13− (

14− runText

15− , span_

16− ) where

17−

18−import Control.Monad.ST (ST, runST)

19−import Data.Text.Internal (Text(..), text)

20−import Data.Text.Unsafe (Iter(..), iter)

21−import qualified Data.Text.Array as A

22−

23−span_ :: (Char -> Bool) -> Text -> (# Text, Text #)

24−span_ p t@(Text arr off len) = (# hd,tl #)

25− where hd = text arr off k

26− tl = text arr (off+k) (len-k)

27− !k = loop 0

28− loop !i | i < len && p c = loop (i+d)

29− | otherwise = i

30− where Iter c d = iter t i

31−{-# INLINE span_ #-}

32−

33−runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text

34−runText act = runST (act $ \ !marr !len -> do

35− arr <- A.unsafeFreeze marr

36− return $! text arr 0 len)

37−{-# INLINE runText #-}

Data/Text/Internal/Read.hsdeleted−62

@@ -1,62 +0,0 @@

1−-- |

2−-- Module : Data.Text.Internal.Read

4−--

5−-- License : BSD-style

6−-- Maintainer : bos@serpentine.com

7−-- Stability : experimental

8−-- Portability : GHC

9−--

10−-- Common internal functions for reading textual data.

11−module Data.Text.Internal.Read

12− (

13− IReader

14− , IParser(..)

15− , T(..)

16− , digitToInt

17− , hexDigitToInt

18− , perhaps

19− ) where

20−

21−import Control.Applicative as App (Applicative(..))

22−import Control.Arrow (first)

23−import Control.Monad (ap)

24−import Data.Char (ord)

25−

26−type IReader t a = t -> Either String (a,t)

27−

28−newtype IParser t a = P {

29− runP :: IReader t a

30− }

31−

32−instance Functor (IParser t) where

33− fmap f m = P $ fmap (first f) . runP m

34−

35−instance Applicative (IParser t) where

36− pure a = P $ \t -> Right (a,t)

37− {-# INLINE pure #-}

38− (<*>) = ap

39−

40−instance Monad (IParser t) where

41− return = App.pure

42− m >>= k = P $ \t -> case runP m t of

43− Left err -> Left err

44− Right (a,t') -> runP (k a) t'

45− {-# INLINE (>>=) #-}

46− fail msg = P $ \_ -> Left msg

47−

48−data T = T !Integer !Int

49−

50−perhaps :: a -> IParser t a -> IParser t a

51−perhaps def m = P $ \t -> case runP m t of

52− Left _ -> Right (def,t)

53− r@(Right _) -> r

54−

55−hexDigitToInt :: Char -> Int

56−hexDigitToInt c

57− | c >= '0' && c <= '9' = ord c - ord '0'

58− | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)

59− | otherwise = ord c - (ord 'A' - 10)

60−

61−digitToInt :: Char -> Int

62−digitToInt c = ord c - ord '0'

Data/Text/Lazy.hs+58−275

@@ -1,18 +1,12 @@

11{-# OPTIONS_GHC -fno-warn-orphans #-}

2−{-# LANGUAGE BangPatterns, MagicHash, CPP #-}

3−#if __GLASGOW_HASKELL__ >= 702

4−{-# LANGUAGE Trustworthy #-}

5−#endif

6−#if __GLASGOW_HASKELL__ >= 708

7−{-# LANGUAGE TypeFamilies #-}

8−#endif

9−

2+{-# LANGUAGE BangPatterns, CPP #-}

103-- |

114-- Module : Data.Text.Lazy

136--

147-- License : BSD-style

15−-- Maintainer : bos@serpentine.com

8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

9+-- duncan@haskell.org

1610-- Stability : experimental

1711-- Portability : GHC

1812--

@@ -89,7 +83,6 @@ module Data.Text.Lazy

8983 , toCaseFold

9084 , toLower

9185 , toUpper

92− , toTitle

9386

9487 -- ** Justification

9588 , justifyLeft

@@ -125,10 +118,7 @@ module Data.Text.Lazy

125118 , mapAccumR

126119

127120 -- ** Generation and unfolding

128− , repeat

129121 , replicate

130− , cycle

131− , iterate

132122 , unfoldr

133123 , unfoldrN

134124

@@ -136,11 +126,8 @@ module Data.Text.Lazy

136126

137127 -- ** Breaking strings

138128 , take

139− , takeEnd

140129 , drop

141− , dropEnd

142130 , takeWhile

143− , takeWhileEnd

144131 , dropWhile

145132 , dropWhileEnd

146133 , dropAround

@@ -187,7 +174,7 @@ module Data.Text.Lazy

187174 , partition

188175

189176 -- , findSubstring

190−

177+

191178 -- * Indexing

192179 , index

193180 , count

@@ -203,7 +190,7 @@ module Data.Text.Lazy

203190import Prelude (Char, Bool(..), Maybe(..), String,

204191 Eq(..), Ord(..), Ordering(..), Read(..), Show(..),

205192 (&&), (||), (+), (-), (.), ($), (++),

206− error, flip, fmap, fromIntegral, not, otherwise, quot)

193+ div, error, flip, fmap, fromIntegral, not, otherwise)

207194import qualified Prelude as P

208195#if defined(HAVE_DEEPSEQ)

209196import Control.DeepSeq (NFData(..))

@@ -211,39 +198,25 @@ import Control.DeepSeq (NFData(..))

211198import Data.Int (Int64)

212199import qualified Data.List as L

213200import Data.Char (isSpace)

214−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,

215− Constr, mkConstr, DataType, mkDataType, Fixity(Prefix))

216−import Data.Binary (Binary(get, put))

217−import Data.Monoid (Monoid(..))

218−#if MIN_VERSION_base(4,9,0)

219−import Data.Semigroup (Semigroup(..))

201+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))

202+#if __GLASGOW_HASKELL__ >= 612

203+import Data.Data (mkNoRepType)

204+#else

205+import Data.Data (mkNorepType)

220206#endif

207+import Data.Monoid (Monoid(..))

221208import Data.String (IsString(..))

222209import qualified Data.Text as T

223210import qualified Data.Text.Internal as T

224−import qualified Data.Text.Internal.Fusion.Common as S

211+import qualified Data.Text.Fusion.Common as S

225212import qualified Data.Text.Unsafe as T

226−import qualified Data.Text.Internal.Lazy.Fusion as S

227−import Data.Text.Internal.Fusion.Types (PairS(..))

228−import Data.Text.Internal.Lazy.Fusion (stream, unstream)

229−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,

230− foldrChunks, smallChunkSize)

231−import Data.Text.Internal (firstf, safe, text)

232−import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8)

233−import qualified Data.Text.Internal.Functions as F

234−import Data.Text.Internal.Lazy.Search (indices)

235−#if __GLASGOW_HASKELL__ >= 702

236−import qualified GHC.CString as GHC

237−#else

238−import qualified GHC.Base as GHC

239−#endif

240−#if __GLASGOW_HASKELL__ >= 708

241−import qualified GHC.Exts as Exts

242−#endif

243−import GHC.Prim (Addr#)

244−#if MIN_VERSION_base(4,7,0)

245−import Text.Printf (PrintfArg, formatArg, formatString)

246−#endif

213+import qualified Data.Text.Lazy.Fusion as S

214+import Data.Text.Fusion.Internal (PairS(..))

215+import Data.Text.Lazy.Fusion (stream, unstream)

216+import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldlChunks, foldrChunks)

217+import Data.Text.Internal (firstf, safe, textP)

218+import qualified Data.Text.Util as U

219+import Data.Text.Lazy.Search (indices)

247220

248221-- $fusion

249222--

@@ -341,72 +314,30 @@ instance Show Text where

341314instance Read Text where

342315 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]

343316

344−#if MIN_VERSION_base(4,9,0)

345−-- Semigroup orphan instances for older GHCs are provided by

346−-- 'semigroups` package

347−

348−instance Semigroup Text where

349− (<>) = append

350−#endif

351−

352317instance Monoid Text where

353318 mempty = empty

354−#if MIN_VERSION_base(4,9,0)

355− mappend = (<>) -- future-proof definition

356−#else

357319 mappend = append

358−#endif

359320 mconcat = concat

360321

361322instance IsString Text where

362323 fromString = pack

363324

364−#if __GLASGOW_HASKELL__ >= 708

365−instance Exts.IsList Text where

366− type Item Text = Char

367− fromList = pack

368− toList = unpack

369−#endif

370−

371325#if defined(HAVE_DEEPSEQ)

372326instance NFData Text where

373327 rnf Empty = ()

374328 rnf (Chunk _ ts) = rnf ts

375329#endif

376330

377−instance Binary Text where

378− put t = put (encodeUtf8 t)

379− get = do

380− bs <- get

381− case decodeUtf8' bs of

382− P.Left exn -> P.fail (P.show exn)

383− P.Right a -> P.return a

384−

385−-- | This instance preserves data abstraction at the cost of inefficiency.

386−-- We omit reflection services for the sake of data abstraction.

387−--

388−-- This instance was created by copying the updated behavior of

389−-- @"Data.Text".@'Data.Text.Text'

390331instance Data Text where

391332 gfoldl f z txt = z pack `f` (unpack txt)

392− toConstr _ = packConstr

393− gunfold k z c = case constrIndex c of

394− 1 -> k (z pack)

395− _ -> error "Data.Text.Lazy.Text.gunfold"

396− dataTypeOf _ = textDataType

397−

398−#if MIN_VERSION_base(4,7,0)

399−-- | Only defined for @base-4.7.0.0@ and later

400−instance PrintfArg Text where

401− formatArg txt = formatString $ unpack txt

333+ toConstr _ = error "Data.Text.Lazy.Text.toConstr"

334+ gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"

335+#if __GLASGOW_HASKELL__ >= 612

336+ dataTypeOf _ = mkNoRepType "Data.Text.Lazy.Text"

337+#else

338+ dataTypeOf _ = mkNorepType "Data.Text.Lazy.Text"

402339#endif

403340

404−packConstr :: Constr

405−packConstr = mkConstr textDataType "pack" [] Prefix

406−

407−textDataType :: DataType

408−textDataType = mkDataType "Data.Text.Lazy.Text" [packConstr]

409−

410341-- | /O(n)/ Convert a 'String' into a 'Text'.

411342--

412343-- Subject to fusion. Performs replacement on invalid scalar values.

@@ -420,27 +351,6 @@ unpack :: Text -> String

420351unpack t = S.unstreamList (stream t)

421352{-# INLINE [1] unpack #-}

422353

423−-- | /O(n)/ Convert a literal string into a Text.

424−unpackCString# :: Addr# -> Text

425−unpackCString# addr# = unstream (S.streamCString# addr#)

426−{-# NOINLINE unpackCString# #-}

427−

428−{-# RULES "TEXT literal" forall a.

429− unstream (S.streamList (L.map safe (GHC.unpackCString# a)))

430− = unpackCString# a #-}

431−

432−{-# RULES "TEXT literal UTF8" forall a.

433− unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))

434− = unpackCString# a #-}

435−

436−{-# RULES "LAZY TEXT empty literal"

437− unstream (S.streamList (L.map safe []))

438− = Empty #-}

439−

440−{-# RULES "LAZY TEXT empty literal" forall a.

441− unstream (S.streamList (L.map safe [a]))

442− = Chunk (T.singleton a) Empty #-}

443−

444354-- | /O(1)/ Convert a character into a Text. Subject to fusion.

445355-- Performs replacement on invalid scalar values.

446356singleton :: Char -> Text

@@ -545,7 +455,7 @@ tail Empty = emptyError "tail"

545455 unstream (S.tail (stream t)) = tail t

546456 #-}

547457

548−-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must

458+-- | /O(1)/ Returns all but the last character of a 'Text', which must

549459-- be non-empty. Subject to fusion.

550460init :: Text -> Text

551461init (Chunk t0 ts0) = go t0 ts0

@@ -581,7 +491,7 @@ isSingleton :: Text -> Bool

581491isSingleton = S.isSingleton . stream

582492{-# INLINE isSingleton #-}

583493

584−-- | /O(n\/c)/ Returns the last character of a 'Text', which must be

494+-- | /O(1)/ Returns the last character of a 'Text', which must be

585495-- non-empty. Subject to fusion.

586496last :: Text -> Char

587497last Empty = emptyError "last"

@@ -636,7 +546,7 @@ map f t = unstream (S.map (safe . f) (stream t))

636546-- 'Text's and concatenates the list after interspersing the first

637547-- argument between each element of the list.

638548intercalate :: Text -> [Text] -> Text

639−intercalate t = concat . (F.intersperse t)

549+intercalate t = concat . (U.intersperse t)

640550{-# INLINE intercalate #-}

641551

642552-- | /O(n)/ The 'intersperse' function takes a character and places it

@@ -696,7 +606,7 @@ center k c t

696606 | otherwise = replicateChar l c `append` t `append` replicateChar r c

697607 where len = length t

698608 d = k - len

699− r = d `quot` 2

609+ r = d `div` 2

700610 l = d - r

701611{-# INLINE center #-}

702612

@@ -715,36 +625,13 @@ reverse = rev Empty

715625 where rev a Empty = a

716626 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts

717627

718−-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in

719−-- @haystack@ with @replacement@.

720−--

721−-- This function behaves as though it was defined as follows:

722−--

723−-- @

724−-- replace needle replacement haystack =

725−-- 'intercalate' replacement ('splitOn' needle haystack)

726−-- @

727−--

728−-- As this suggests, each occurrence is replaced exactly once. So if

729−-- @needle@ occurs in @replacement@, that occurrence will /not/ itself

730−-- be replaced recursively:

731−--

732−-- > replace "oo" "foo" "oo" == "foo"

733−--

734−-- In cases where several instances of @needle@ overlap, only the

735−-- first one will be replaced:

736−--

737−-- > replace "ofo" "bar" "ofofo" == "barfo"

628+-- | /O(m+n)/ Replace every occurrence of one substring with another.

738629--

739630-- In (unlikely) bad cases, this function's time complexity degrades

740631-- towards /O(n*m)/.

741−replace :: Text

742− -- ^ @needle@ to search for. If this string is empty, an

743− -- error will occur.

744− -> Text

745− -- ^ @replacement@ to replace @needle@ with.

746− -> Text

747− -- ^ @haystack@ in which to search.

632+replace :: Text -- ^ Text to search for

633+ -> Text -- ^ Replacement text

634+ -> Text -- ^ Input text

748635 -> Text

749636replace s d = intercalate d . splitOn s

750637{-# INLINE replace #-}

@@ -761,10 +648,9 @@ replace s d = intercalate d . splitOn s

761648-- functions may map one input character to two or three output

762649-- characters.

763650

764−-- | /O(n)/ Convert a string to folded case. Subject to fusion.

765−--

766−-- This function is mainly useful for performing caseless (or case

767−-- insensitive) string comparisons.

651+-- | /O(n)/ Convert a string to folded case. This function is mainly

652+-- useful for performing caseless (or case insensitive) string

653+-- comparisons.

768654--

769655-- A string @x@ is a caseless match for a string @y@ if and only if:

770656--

@@ -781,49 +667,22 @@ toCaseFold t = unstream (S.toCaseFold (stream t))

781667{-# INLINE [0] toCaseFold #-}

782668

783669-- | /O(n)/ Convert a string to lower case, using simple case

784−-- conversion. Subject to fusion.

785−--

786−-- The result string may be longer than the input string. For

787−-- instance, the Latin capital letter I with dot above (U+0130) maps

788−-- to the sequence Latin small letter i (U+0069) followed by combining

789−-- dot above (U+0307).

670+-- conversion. The result string may be longer than the input string.

671+-- For instance, the Latin capital letter I with dot above (U+0130)

672+-- maps to the sequence Latin small letter i (U+0069) followed by

673+-- combining dot above (U+0307).

790674toLower :: Text -> Text

791675toLower t = unstream (S.toLower (stream t))

792676{-# INLINE toLower #-}

793677

794678-- | /O(n)/ Convert a string to upper case, using simple case

795−-- conversion. Subject to fusion.

796−--

797−-- The result string may be longer than the input string. For

798−-- instance, the German eszett (U+00DF) maps to the two-letter

679+-- conversion. The result string may be longer than the input string.

680+-- For instance, the German eszett (U+00DF) maps to the two-letter

799681-- sequence SS.

800682toUpper :: Text -> Text

801683toUpper t = unstream (S.toUpper (stream t))

802684{-# INLINE toUpper #-}

803685

804−

805−-- | /O(n)/ Convert a string to title case, using simple case

806−-- conversion. Subject to fusion.

807−--

808−-- The first letter of the input is converted to title case, as is

809−-- every subsequent letter that immediately follows a non-letter.

810−-- Every letter that immediately follows another letter is converted

811−-- to lower case.

812−--

813−-- The result string may be longer than the input string. For example,

814−-- the Latin small ligature ﬂ (U+FB02) is converted to the

815−-- sequence Latin capital letter F (U+0046) followed by Latin small

816−-- letter l (U+006C).

817−--

818−-- /Note/: this function does not take language or culture specific

819−-- rules into account. For instance, in English, different style

820−-- guides disagree on whether the book name \"The Hill of the Red

821−-- Fox\" is correctly title cased—but this function will

822−-- capitalize /every/ word.

823−toTitle :: Text -> Text

824−toTitle t = unstream (S.toTitle (stream t))

825−{-# INLINE toTitle #-}

826−

827686-- | /O(n)/ 'foldl', applied to a binary operator, a starting value

828687-- (typically the left-identity of the operator), and a 'Text',

829688-- reduces the 'Text' using the binary operator, from left to right.

@@ -881,13 +740,13 @@ concatMap f = concat . foldr ((:) . f) []

881740{-# INLINE concatMap #-}

882741

883742-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the

884−-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.

743+-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.

885744any :: (Char -> Bool) -> Text -> Bool

886745any p t = S.any p (stream t)

887746{-# INLINE any #-}

888747

889748-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the

890−-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.

749+-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.

891750all :: (Char -> Bool) -> Text -> Bool

892751all p t = S.all p (stream t)

893752{-# INLINE all #-}

@@ -970,12 +829,6 @@ mapAccumR f = go

970829 go z Empty = (z, Empty)

971830{-# INLINE mapAccumR #-}

972831

973−-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every

974−-- element.

975−repeat :: Char -> Text

976−repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t

977− in t

978−

979832-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input

980833-- @t@ repeated @n@ times.

981834replicate :: Int64 -> Text -> Text

@@ -985,22 +838,7 @@ replicate n t

985838 | otherwise = concat (rep 0)

986839 where rep !i | i >= n = []

987840 | otherwise = t : rep (i+1)

988−{-# INLINE [1] replicate #-}

989−

990−-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or

991−-- equivalently, the infinite repetition of the original 'Text'.

992−cycle :: Text -> Text

993−cycle Empty = emptyError "cycle"

994−cycle t = let t' = foldrChunks Chunk t' t

995− in t'

996−

997−-- | @'iterate' f x@ returns an infinite 'Text' of repeated applications

998−-- of @f@ to @x@:

999−--

1000−-- > iterate f x == [x, f x, f (f x), ...]

1001−iterate :: (Char -> Char) -> Char -> Text

1002−iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))

1003− in t c

841+{-# INLINE replicate #-}

1004842

1005843-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the

1006844-- value of every element. Subject to fusion.

@@ -1055,22 +893,6 @@ take i t0 = take' i t0

1055893 unstream (S.take n (stream t)) = take n t

1056894 #-}

1057895

1058−-- | /O(n)/ 'takeEnd' @n@ @t@ returns the suffix remaining after

1059−-- taking @n@ characters from the end of @t@.

1060−--

1061−-- Examples:

1062−--

1063−-- > takeEnd 3 "foobar" == "bar"

1064−takeEnd :: Int64 -> Text -> Text

1065−takeEnd n t0

1066− | n <= 0 = empty

1067− | otherwise = takeChunk n empty . L.reverse . toChunks $ t0

1068− where takeChunk _ acc [] = acc

1069− takeChunk i acc (t:ts)

1070− | i <= l = chunk (T.takeEnd (fromIntegral i) t) acc

1071− | otherwise = takeChunk (i-l) (Chunk t acc) ts

1072− where l = fromIntegral (T.length t)

1073−

1074896-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the

1075897-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@

1076898-- is greater than the length of the 'Text'. Subject to fusion.

@@ -1080,7 +902,7 @@ drop i t0

1080902 | otherwise = drop' i t0

1081903 where drop' 0 ts = ts

1082904 drop' _ Empty = Empty

1083− drop' n (Chunk t ts)

905+ drop' n (Chunk t ts)

1084906 | n < len = Chunk (T.drop (fromIntegral n) t) ts

1085907 | otherwise = drop' (n - len) ts

1086908 where len = fromIntegral (T.length t)

@@ -1093,23 +915,6 @@ drop i t0

1093915 unstream (S.drop n (stream t)) = drop n t

1094916 #-}

1095917

1096−-- | /O(n)/ 'dropEnd' @n@ @t@ returns the prefix remaining after

1097−-- dropping @n@ characters from the end of @t@.

1098−--

1099−-- Examples:

1100−--

1101−-- > dropEnd 3 "foobar" == "foo"

1102−dropEnd :: Int64 -> Text -> Text

1103−dropEnd n t0

1104− | n <= 0 = t0

1105− | otherwise = dropChunk n . L.reverse . toChunks $ t0

1106− where dropChunk _ [] = empty

1107− dropChunk m (t:ts)

1108− | m >= l = dropChunk (m-l) ts

1109− | otherwise = fromChunks . L.reverse $

1110− T.dropEnd (fromIntegral m) t : ts

1111− where l = fromIntegral (T.length t)

1112−

1113918-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'

1114919-- values dropped, or the empty 'Text' if @n@ is greater than the

1115920-- number of 'Word16' values present.

@@ -1120,7 +925,7 @@ dropWords i t0

1120925 where drop' 0 ts = ts

1121926 drop' _ Empty = Empty

1122927 drop' n (Chunk (T.Text arr off len) ts)

1123− | n < len' = chunk (text arr (off+n') (len-n')) ts

928+ | n < len' = chunk (textP arr (off+n') (len-n')) ts

1124929 | otherwise = drop' (n - len') ts

1125930 where len' = fromIntegral len

1126931 n' = fromIntegral n

@@ -1144,20 +949,6 @@ takeWhile p t0 = takeWhile' t0

1144949"LAZY TEXT takeWhile -> unfused" [1] forall p t.

1145950 unstream (S.takeWhile p (stream t)) = takeWhile p t

1146951 #-}

1147−-- | /O(n)/ 'takeWhileEnd', applied to a predicate @p@ and a 'Text',

1148−-- returns the longest suffix (possibly empty) of elements that

1149−-- satisfy @p@.

1150−-- Examples:

1151−--

1152−-- > takeWhileEnd (=='o') "foo" == "oo"

1153−takeWhileEnd :: (Char -> Bool) -> Text -> Text

1154−takeWhileEnd p = takeChunk empty . L.reverse . toChunks

1155− where takeChunk acc [] = acc

1156− takeChunk acc (t:ts) = if T.length t' < T.length t

1157− then (Chunk t' acc)

1158− else takeChunk (Chunk t' acc) ts

1159− where t' = T.takeWhileEnd p t

1160−{-# INLINE takeWhileEnd #-}

1161952

1162953-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after

1163954-- 'takeWhile' @p@ @t@. Subject to fusion.

@@ -1176,11 +967,9 @@ dropWhile p t0 = dropWhile' t0

1176967"LAZY TEXT dropWhile -> unfused" [1] forall p t.

1177968 unstream (S.dropWhile p (stream t)) = dropWhile p t

1178969 #-}

1179−

1180970-- | /O(n)/ 'dropWhileEnd' @p@ @t@ returns the prefix remaining after

1181−-- dropping characters that satisfy the predicate @p@ from the end of

971+-- dropping characters that fail the predicate @p@ from the end of

1182972-- @t@.

1183−--

1184973-- Examples:

1185974--

1186975-- > dropWhileEnd (=='.') "foo..." == "foo"

@@ -1197,7 +986,7 @@ dropWhileEnd p = go

1197986{-# INLINE dropWhileEnd #-}

1198987

1199988-- | /O(n)/ 'dropAround' @p@ @t@ returns the substring remaining after

1200−-- dropping characters that satisfy the predicate @p@ from both the

989+-- dropping characters that fail the predicate @p@ from both the

1201990-- beginning and end of @t@. Subject to fusion.

1202991dropAround :: (Char -> Bool) -> Text -> Text

1203992dropAround p = dropWhile p . dropWhileEnd p

@@ -1247,8 +1036,8 @@ splitAtWord _ Empty = empty :*: empty

12471036splitAtWord x (Chunk c@(T.Text arr off len) cs)

12481037 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs

12491038 in Chunk c h :*: t

1250− | otherwise = chunk (text arr off y) empty :*:

1251− chunk (text arr (off+y) (len-y)) cs

1039+ | otherwise = chunk (textP arr off y) empty :*:

1040+ chunk (textP arr (off+y) (len-y)) cs

12521041 where y = fromIntegral x

12531042

12541043-- | /O(n+m)/ Find the first instance of @needle@ (which must be

@@ -1392,34 +1181,28 @@ tails ts@(Chunk t ts')

13921181-- copies to create substrings; they just construct new 'Text's that

13931182-- are slices of the original.

13941183

1395−-- | /O(m+n)/ Break a 'Text' into pieces separated by the first 'Text'

1396−-- argument (which cannot be an empty string), consuming the

1397−-- delimiter. An empty delimiter is invalid, and will cause an error

1398−-- to be raised.

1184+-- | /O(m+n)/ Break a 'Text' into pieces separated by the first

1185+-- 'Text' argument, consuming the delimiter. An empty delimiter is

1186+-- invalid, and will cause an error to be raised.

13991187--

14001188-- Examples:

14011189--

14021190-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]

14031191-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]

14041192-- > splitOn "x" "x" == ["",""]

1405−--

1193+--

14061194-- and

14071195--

14081196-- > intercalate s . splitOn s == id

14091197-- > splitOn (singleton c) == split (==c)

14101198--

1411−-- (Note: the string @s@ to split on above cannot be empty.)

1412−--

14131199-- This function is strict in its first argument, and lazy in its

14141200-- second.

14151201--

14161202-- In (unlikely) bad cases, this function's time complexity degrades

14171203-- towards /O(n*m)/.

1418−splitOn :: Text

1419− -- ^ String to split on. If this string is empty, an error

1420− -- will occur.

1421− -> Text

1422− -- ^ Input text.

1204+splitOn :: Text -- ^ Text to split on

1205+ -> Text -- ^ Input text

14231206 -> [Text]

14241207splitOn pat src

14251208 | null pat = emptyError "splitOn"

Data/Text/Lazy/Builder.hs+272−18

@@ -1,15 +1,11 @@

11{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-}

4−#endif

63-----------------------------------------------------------------------------

74-- |

85-- Module : Data.Text.Lazy.Builder

11−-- License : BSD-style (see LICENSE)

12−--

7+-- License : BSD3-style (see LICENSE)

8+--

139-- Maintainer : Johan Tibell <johan.tibell@gmail.com>

1410-- Stability : experimental

1511-- Portability : portable to Hugs and GHC

@@ -19,9 +15,7 @@

1915-- @fromLazyText@, which construct new builders, and 'mappend', which

2016-- concatenates two builders.

2117--

22−-- To get maximum performance when building lazy @Text@ values using a

23−-- builder, associate @mappend@ calls to the right. For example,

24−-- prefer

18+-- To get maximum performance when building lazy @Text@ values using a builder, associate @mappend@ calls to the right. For example, prefer

2519--

2620-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')

2721--

@@ -29,14 +23,8 @@

2923--

3024-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'

3125--

32−-- as the latter associates @mappend@ to the left. Or, equivalently,

33−-- prefer

34−--

35−-- > singleton 'a' <> singleton 'b' <> singleton 'c'

26+-- as the latter associates @mappend@ to the left.

3627--

37−-- since the '<>' from recent versions of 'Data.Monoid' associates

38−-- to the right.

39−

4028-----------------------------------------------------------------------------

4129

4230module Data.Text.Lazy.Builder

@@ -55,4 +43,270 @@ module Data.Text.Lazy.Builder

5543 , flush

5644 ) where

5745

58−import Data.Text.Internal.Builder

46+import Control.Monad.ST (ST, runST)

47+import Data.Bits ((.&.))

48+import Data.Monoid (Monoid(..))

49+import Data.Text.Internal (Text(..))

50+import Data.Text.Lazy.Internal (smallChunkSize)

51+import Data.Text.Unsafe (inlineInterleaveST)

52+import Data.Text.UnsafeChar (ord, unsafeWrite)

53+import Data.Text.UnsafeShift (shiftR)

54+import Prelude hiding (map, putChar)

55+

56+import qualified Data.String as String

57+import qualified Data.Text as S

58+import qualified Data.Text.Array as A

59+import qualified Data.Text.Lazy as L

60+

61+------------------------------------------------------------------------

62+

63+-- | A @Builder@ is an efficient way to build lazy @Text@ values.

64+-- There are several functions for constructing builders, but only one

65+-- to inspect them: to extract any data, you have to turn them into

66+-- lazy @Text@ values using @toLazyText@.

67+--

68+-- Internally, a builder constructs a lazy @Text@ by filling arrays

69+-- piece by piece. As each buffer is filled, it is \'popped\' off, to

70+-- become a new chunk of the resulting lazy @Text@. All this is

71+-- hidden from the user of the @Builder@.

72+newtype Builder = Builder {

73+ -- Invariant (from Data.Text.Lazy):

74+ -- The lists include no null Texts.

75+ runBuilder :: forall s. (Buffer s -> ST s [S.Text])

76+ -> Buffer s

77+ -> ST s [S.Text]

78+ }

79+

80+instance Monoid Builder where

81+ mempty = empty

82+ {-# INLINE mempty #-}

83+ mappend = append

84+ {-# INLINE mappend #-}

85+ mconcat = foldr mappend mempty

86+ {-# INLINE mconcat #-}

87+

88+instance String.IsString Builder where

89+ fromString = fromString

90+ {-# INLINE fromString #-}

91+

92+instance Show Builder where

93+ show = show . toLazyText

94+

95+instance Eq Builder where

96+ a == b = toLazyText a == toLazyText b

97+

98+instance Ord Builder where

99+ a <= b = toLazyText a <= toLazyText b

100+

101+------------------------------------------------------------------------

102+

103+-- | /O(1)./ The empty @Builder@, satisfying

104+--

105+-- * @'toLazyText' 'empty' = 'L.empty'@

106+--

107+empty :: Builder

108+empty = Builder (\ k buf -> k buf)

109+{-# INLINE empty #-}

110+

111+-- | /O(1)./ A @Builder@ taking a single character, satisfying

112+--

113+-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@

114+--

115+singleton :: Char -> Builder

116+singleton c = writeAtMost 2 $ \ marr o ->

117+ if n < 0x10000

118+ then A.unsafeWrite marr o (fromIntegral n) >> return 1

119+ else do

120+ A.unsafeWrite marr o lo

121+ A.unsafeWrite marr (o+1) hi

122+ return 2

123+ where n = ord c

124+ m = n - 0x10000

125+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800

126+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00

127+{-# INLINE singleton #-}

128+

129+------------------------------------------------------------------------

130+

131+-- | /O(1)./ The concatenation of two builders, an associative

132+-- operation with identity 'empty', satisfying

133+--

134+-- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@

135+--

136+append :: Builder -> Builder -> Builder

137+append (Builder f) (Builder g) = Builder (f . g)

138+{-# INLINE [0] append #-}

139+

140+-- TODO: Experiment to find the right threshold.

141+copyLimit :: Int

142+copyLimit = 128

143+

144+-- This function attempts to merge small @Text@ values instead of

145+-- treating each value as its own chunk. We may not always want this.

146+

147+-- | /O(1)./ A @Builder@ taking a 'S.Text', satisfying

148+--

149+-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@

150+--

151+fromText :: S.Text -> Builder

152+fromText t@(Text arr off l)

153+ | S.null t = empty

154+ | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)

155+ | otherwise = flush `append` mapBuilder (t :)

156+{-# INLINE [1] fromText #-}

157+

158+{-# RULES

159+"fromText/pack" forall s .

160+ fromText (S.pack s) = fromString s

161+ #-}

162+

163+-- | /O(1)./ A Builder taking a @String@, satisfying

164+--

165+-- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@

166+--

167+fromString :: String -> Builder

168+fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->

169+ let loop !marr !o !u !l [] = k (Buffer marr o u l)

170+ loop marr o u l s@(c:cs)

171+ | l <= 1 = do

172+ arr <- A.unsafeFreeze marr

173+ let !t = Text arr o u

174+ marr' <- A.new chunkSize

175+ ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)

176+ return $ t : ts

177+ | otherwise = do

178+ n <- unsafeWrite marr (o+u) c

179+ loop marr o (u+n) (l-n) cs

180+ in loop p0 o0 u0 l0 str

181+ where

182+ chunkSize = smallChunkSize

183+{-# INLINE fromString #-}

184+

185+-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying

186+--

187+-- * @'toLazyText' ('fromLazyText' t) = t@

188+--

189+fromLazyText :: L.Text -> Builder

190+fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)

191+{-# INLINE fromLazyText #-}

192+

193+------------------------------------------------------------------------

194+

195+-- Our internal buffer type

196+data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)

197+ {-# UNPACK #-} !Int -- offset

198+ {-# UNPACK #-} !Int -- used units

199+ {-# UNPACK #-} !Int -- length left

200+

201+------------------------------------------------------------------------

202+

203+-- | /O(n)./ Extract a lazy @Text@ from a @Builder@ with a default

204+-- buffer size. The construction work takes place if and when the

205+-- relevant part of the lazy @Text@ is demanded.

206+toLazyText :: Builder -> L.Text

207+toLazyText = toLazyTextWith smallChunkSize

208+

209+-- | /O(n)./ Extract a lazy @Text@ from a @Builder@, using the given

210+-- size for the initial buffer. The construction work takes place if

211+-- and when the relevant part of the lazy @Text@ is demanded.

212+--

213+-- If the initial buffer is too small to hold all data, subsequent

214+-- buffers will be the default buffer size.

215+toLazyTextWith :: Int -> Builder -> L.Text

216+toLazyTextWith chunkSize m = L.fromChunks (runST $

217+ newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return [])))

218+

219+-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,

220+-- yielding a new chunk in the result lazy @Text@.

221+flush :: Builder

222+flush = Builder $ \ k buf@(Buffer p o u l) ->

223+ if u == 0

224+ then k buf

225+ else do arr <- A.unsafeFreeze p

226+ let !b = Buffer p (o+u) 0 l

227+ !t = Text arr o u

228+ ts <- inlineInterleaveST (k b)

229+ return $! t : ts

230+

231+------------------------------------------------------------------------

232+

233+-- | Sequence an ST operation on the buffer

234+withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder

235+withBuffer f = Builder $ \k buf -> f buf >>= k

236+{-# INLINE withBuffer #-}

237+

238+-- | Get the size of the buffer

239+withSize :: (Int -> Builder) -> Builder

240+withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->

241+ runBuilder (f l) k buf

242+{-# INLINE withSize #-}

243+

244+-- | Map the resulting list of texts.

245+mapBuilder :: ([S.Text] -> [S.Text]) -> Builder

246+mapBuilder f = Builder (fmap f .)

247+

248+------------------------------------------------------------------------

249+

250+-- | Ensure that there are at least @n@ many elements available.

251+ensureFree :: Int -> Builder

252+ensureFree !n = withSize $ \ l ->

253+ if n <= l

254+ then empty

255+ else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))

256+{-# INLINE [0] ensureFree #-}

257+

258+writeAtMost :: Int -> (forall s. A.MArray s -> Int -> ST s Int) -> Builder

259+writeAtMost n f = ensureFree n `append'` withBuffer (writeBuffer f)

260+{-# INLINE [0] writeAtMost #-}

261+

262+-- | Ensure that @n@ many elements are available, and then use @f@ to

263+-- write some elements into the memory.

264+writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder

265+writeN n f = writeAtMost n (\ p o -> f p o >> return n)

266+{-# INLINE writeN #-}

267+

268+writeBuffer :: (A.MArray s -> Int -> ST s Int) -> Buffer s -> ST s (Buffer s)

269+writeBuffer f (Buffer p o u l) = do

270+ n <- f p (o+u)

271+ return $! Buffer p o (u+n) (l-n)

272+{-# INLINE writeBuffer #-}

273+

274+newBuffer :: Int -> ST s (Buffer s)

275+newBuffer size = do

276+ arr <- A.new size

277+ return $! Buffer arr 0 0 size

278+{-# INLINE newBuffer #-}

279+

280+------------------------------------------------------------------------

281+-- Some nice rules for Builder

282+

283+-- This function makes GHC understand that 'writeN' and 'ensureFree'

284+-- are *not* recursive in the precense of the rewrite rules below.

285+-- This is not needed with GHC 7+.

286+append' :: Builder -> Builder -> Builder

287+append' (Builder f) (Builder g) = Builder (f . g)

288+{-# INLINE append' #-}

289+

290+{-# RULES

291+

292+"append/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)

293+ (g::forall s. A.MArray s -> Int -> ST s Int) ws.

294+ append (writeAtMost a f) (append (writeAtMost b g) ws) =

295+ append (writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->

296+ g marr (o+n) >>= \ m ->

297+ let s = n+m in s `seq` return s)) ws

298+

299+"writeAtMost/writeAtMost" forall a b (f::forall s. A.MArray s -> Int -> ST s Int)

300+ (g::forall s. A.MArray s -> Int -> ST s Int).

301+ append (writeAtMost a f) (writeAtMost b g) =

302+ writeAtMost (a+b) (\marr o -> f marr o >>= \ n ->

303+ g marr (o+n) >>= \ m ->

304+ let s = n+m in s `seq` return s)

305+

306+"ensureFree/ensureFree" forall a b .

307+ append (ensureFree a) (ensureFree b) = ensureFree (max a b)

308+

309+"flush/flush"

310+ append flush flush = flush

311+

312+ #-}

Data/Text/Internal/Builder/Functions.hs → Data/Text/Lazy/Builder/Functions.hsrenamed+3−8

@@ -1,7 +1,7 @@

11{-# LANGUAGE MagicHash #-}

33-- |

4−-- Module : Data.Text.Internal.Builder.Functions

4+-- Module : Data.Text.Lazy.Builder.Functions

66--

77-- License : BSD-style

@@ -9,13 +9,9 @@

99-- Stability : experimental

1010-- Portability : GHC

1111--

12−-- /Warning/: this is an internal module, and does not have a stable

13−-- API or name. Functions in this module may not check or enforce

14−-- preconditions expected by public modules. Use at your own risk!

15−--

1612-- Useful functions and combinators.

1713

18−module Data.Text.Internal.Builder.Functions

14+module Data.Text.Lazy.Builder.Functions

1915 (

2016 (<>)

2117 , i2d

@@ -23,8 +19,7 @@ module Data.Text.Internal.Builder.Functions

2319

2420import Data.Monoid (mappend)

2521import Data.Text.Lazy.Builder (Builder)

26−import GHC.Base (chr#,ord#,(+#),Int(I#),Char(C#))

27−import Prelude ()

22+import GHC.Base

2823

2924-- | Unsafe conversion for decimal digits.

3025{-# INLINE i2d #-}

Data/Text/Lazy/Builder/Int.hs+37−147

@@ -1,13 +1,8 @@

1−{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,

2− UnboxedTuples #-}

3−#if __GLASGOW_HASKELL__ >= 702

4−{-# LANGUAGE Trustworthy #-}

5−#endif

1+{-# LANGUAGE BangPatterns, CPP, MagicHash, UnboxedTuples #-}

73-- Module: Data.Text.Lazy.Builder.Int

10−-- License: BSD-style

5+-- License: BSD3

116-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>

127-- Stability: experimental

138-- Portability: portable

@@ -22,142 +17,45 @@ module Data.Text.Lazy.Builder.Int

2217

2318import Data.Int (Int8, Int16, Int32, Int64)

2419import Data.Monoid (mempty)

25−import qualified Data.ByteString.Unsafe as B

26−import Data.Text.Internal.Builder.Functions ((<>), i2d)

27−import Data.Text.Internal.Builder

28−import Data.Text.Internal.Builder.Int.Digits (digits)

29−import Data.Text.Array

20+import Data.Text.Lazy.Builder.Functions ((<>), i2d)

21+import Data.Text.Lazy.Builder

3022import Data.Word (Word, Word8, Word16, Word32, Word64)

3123import GHC.Base (quotInt, remInt)

3224import GHC.Num (quotRemInteger)

3325import GHC.Types (Int(..))

34−import Control.Monad.ST

3526

3627#ifdef __GLASGOW_HASKELL__

37−# if defined(INTEGER_GMP)

38−import GHC.Integer.GMP.Internals (Integer(S#))

39−# elif defined(INTEGER_SIMPLE)

40−import GHC.Integer

28+# if __GLASGOW_HASKELL__ < 611

29+import GHC.Integer.Internals

4130# else

42−# error "You need to use either GMP or integer-simple."

31+import GHC.Integer.GMP.Internals

4332# endif

4433#endif

4534

46−#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)

35+#ifdef INTEGER_GMP

4736# define PAIR(a,b) (# a,b #)

4837#else

4938# define PAIR(a,b) (a,b)

5039#endif

5140

5241decimal :: Integral a => a -> Builder

53−{-# RULES "decimal/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}

54−{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}

55−{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}

56−{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}

57−{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}

58−{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}

59−{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}

60−{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}

61−{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}

62−{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}

42+{-# SPECIALIZE decimal :: Int -> Builder #-}

43+{-# SPECIALIZE decimal :: Int8 -> Builder #-}

44+{-# SPECIALIZE decimal :: Int16 -> Builder #-}

45+{-# SPECIALIZE decimal :: Int32 -> Builder #-}

46+{-# SPECIALIZE decimal :: Int64 -> Builder #-}

47+{-# SPECIALIZE decimal :: Word -> Builder #-}

48+{-# SPECIALIZE decimal :: Word8 -> Builder #-}

49+{-# SPECIALIZE decimal :: Word16 -> Builder #-}

50+{-# SPECIALIZE decimal :: Word32 -> Builder #-}

51+{-# SPECIALIZE decimal :: Word64 -> Builder #-}

6352{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}

64−decimal i = decimal' (<= -128) i

65−{-# NOINLINE decimal #-}

66−

67−boundedDecimal :: (Integral a, Bounded a) => a -> Builder

68−{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}

69−{-# SPECIALIZE boundedDecimal :: Int8 -> Builder #-}

70−{-# SPECIALIZE boundedDecimal :: Int16 -> Builder #-}

71−{-# SPECIALIZE boundedDecimal :: Int32 -> Builder #-}

72−{-# SPECIALIZE boundedDecimal :: Int64 -> Builder #-}

73−boundedDecimal i = decimal' (== minBound) i

74−

75−decimal' :: (Integral a) => (a -> Bool) -> a -> Builder

76−{-# INLINE decimal' #-}

77−decimal' p i

78− | i < 0 = if p i

79− then let (q, r) = i `quotRem` 10

80− qq = -q

81− !n = countDigits qq

82− in writeN (n + 2) $ \marr off -> do

83− unsafeWrite marr off minus

84− posDecimal marr (off+1) n qq

85− unsafeWrite marr (off+n+1) (i2w (-r))

86− else let j = -i

87− !n = countDigits j

88− in writeN (n + 1) $ \marr off ->

89− unsafeWrite marr off minus >> posDecimal marr (off+1) n j

90− | otherwise = positive i

91−

92−positive :: (Integral a) => a -> Builder

93−{-# SPECIALIZE positive :: Int -> Builder #-}

94−{-# SPECIALIZE positive :: Int8 -> Builder #-}

95−{-# SPECIALIZE positive :: Int16 -> Builder #-}

96−{-# SPECIALIZE positive :: Int32 -> Builder #-}

97−{-# SPECIALIZE positive :: Int64 -> Builder #-}

98−{-# SPECIALIZE positive :: Word -> Builder #-}

99−{-# SPECIALIZE positive :: Word8 -> Builder #-}

100−{-# SPECIALIZE positive :: Word16 -> Builder #-}

101−{-# SPECIALIZE positive :: Word32 -> Builder #-}

102−{-# SPECIALIZE positive :: Word64 -> Builder #-}

103−positive i

104− | i < 10 = writeN 1 $ \marr off -> unsafeWrite marr off (i2w i)

105− | otherwise = let !n = countDigits i

106− in writeN n $ \marr off -> posDecimal marr off n i

107−

108−posDecimal :: (Integral a) =>

109− forall s. MArray s -> Int -> Int -> a -> ST s ()

110−{-# INLINE posDecimal #-}

111−posDecimal marr off0 ds v0 = go (off0 + ds - 1) v0

112− where go off v

113− | v >= 100 = do

114− let (q, r) = v `quotRem` 100

115− write2 off r

116− go (off - 2) q

117− | v < 10 = unsafeWrite marr off (i2w v)

118− | otherwise = write2 off v

119− write2 off i0 = do

120− let i = fromIntegral i0; j = i + i

121− unsafeWrite marr off $ get (j + 1)

122− unsafeWrite marr (off - 1) $ get j

123− get = fromIntegral . B.unsafeIndex digits

124−

125−minus, zero :: Word16

126−{-# INLINE minus #-}

127−{-# INLINE zero #-}

128−minus = 45

129−zero = 48

130−

131−i2w :: (Integral a) => a -> Word16

132−{-# INLINE i2w #-}

133−i2w v = zero + fromIntegral v

134−

135−countDigits :: (Integral a) => a -> Int

136−{-# INLINE countDigits #-}

137−countDigits v0

138− | fromIntegral v64 == v0 = go 1 v64

139− | otherwise = goBig 1 (fromIntegral v0)

140− where v64 = fromIntegral v0

141− goBig !k (v :: Integer)

142− | v > big = goBig (k + 19) (v `quot` big)

143− | otherwise = go k (fromIntegral v)

144− big = 10000000000000000000

145− go !k (v :: Word64)

146− | v < 10 = k

147− | v < 100 = k + 1

148− | v < 1000 = k + 2

149− | v < 1000000000000 =

150− k + if v < 100000000

151− then if v < 1000000

152− then if v < 10000

153− then 3

154− else 4 + fin v 100000

155− else 6 + fin v 10000000

156− else if v < 10000000000

157− then 8 + fin v 1000000000

158− else 10 + fin v 100000000000

159− | otherwise = go (k + 12) (v `quot` 1000000000000)

160− fin v n = if v >= n then 1 else 0

53+decimal i

54+ | i < 0 = singleton '-' <> go (-i)

55+ | otherwise = go i

56+ where

57+ go n | n < 10 = digit n

58+ | otherwise = go (n `quot` 10) <> digit (n `rem` 10)

16159

16260hexadecimal :: Integral a => a -> Builder

16361{-# SPECIALIZE hexadecimal :: Int -> Builder #-}

@@ -170,23 +68,17 @@ hexadecimal :: Integral a => a -> Builder

17068{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}

17169{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}

17270{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}

173−{-# RULES "hexadecimal/Integer"

174− hexadecimal = hexInteger :: Integer -> Builder #-}

71+{-# RULES "hexadecimal/Integer" hexadecimal = integer 16 :: Integer -> Builder #-}

17572hexadecimal i

176− | i < 0 = error hexErrMsg

73+ | i < 0 = singleton '-' <> go (-i)

17774 | otherwise = go i

17875 where

17976 go n | n < 16 = hexDigit n

18077 | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)

181−{-# NOINLINE[0] hexadecimal #-}

182−

183−hexInteger :: Integer -> Builder

184−hexInteger i

185− | i < 0 = error hexErrMsg

186− | otherwise = integer 16 i

18778

188−hexErrMsg :: String

189−hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"

79+digit :: Integral a => a -> Builder

80+digit n = singleton $! i2d (fromIntegral n)

81+{-# INLINE digit #-}

19082

19183hexDigit :: Integral a => a -> Builder

19284hexDigit n

@@ -194,13 +86,15 @@ hexDigit n

19486 | otherwise = singleton $! toEnum (fromIntegral n + 87)

19587{-# INLINE hexDigit #-}

19688

89+int :: Int -> Builder

90+int = decimal

91+{-# INLINE int #-}

92+

19793data T = T !Integer !Int

19894

19995integer :: Int -> Integer -> Builder

200−#ifdef INTEGER_GMP

20196integer 10 (S# i#) = decimal (I# i#)

20297integer 16 (S# i#) = hexadecimal (I# i#)

203−#endif

20498integer base i

20599 | i < 0 = singleton '-' <> go (-i)

206100 | otherwise = go i

@@ -247,16 +141,12 @@ integer base i

247141 PAIR(x,y) -> pblock q <> pblock r <> putB ns

248142 where q = fromInteger x

249143 r = fromInteger y

250− putB _ = Data.Monoid.mempty

251−

252− int :: Int -> Builder

253− int x | base == 10 = decimal x

254− | otherwise = hexadecimal x

144+ putB _ = mempty

255145

256146 pblock = loop maxDigits

257147 where

258148 loop !d !n

259− | d == 1 = hexDigit n

260− | otherwise = loop (d-1) q <> hexDigit r

149+ | d == 1 = digit n

150+ | otherwise = loop (d-1) q <> digit r

261151 where q = n `quotInt` base

262152 r = n `remInt` base

Data/Text/Lazy/Builder/RealFloat.hs+3−6

@@ -1,7 +1,4 @@

1−{-# LANGUAGE CPP, OverloadedStrings #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-}

4−#endif

1+{-# LANGUAGE OverloadedStrings #-}

63-- |

74-- Module: Data.Text.Lazy.Builder.RealFloat

@@ -19,9 +16,9 @@ module Data.Text.Lazy.Builder.RealFloat

1916

2017import Data.Array.Base (unsafeAt)

2118import Data.Array.IArray

22−import Data.Text.Internal.Builder.Functions ((<>), i2d)

19+import Data.Text.Lazy.Builder.Functions ((<>), i2d)

2320import Data.Text.Lazy.Builder.Int (decimal)

24−import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)

21+import Data.Text.Lazy.Builder.RealFloat.Functions (roundTo)

2522import Data.Text.Lazy.Builder

2623import qualified Data.Text as T

2724

Data/Text/Lazy/Builder/RealFloat/Functions.hsnew file+25

@@ -0,0 +1,25 @@

1+-- |

2+-- Module: Data.Text.Lazy.Builder.RealFloat.Functions

3+-- Copyright: (c) The University of Glasgow 1994-2002

4+-- License: see libraries/base/LICENSE

6+module Data.Text.Lazy.Builder.RealFloat.Functions

7+ (

8+ roundTo

9+ ) where

10+

11+roundTo :: Int -> [Int] -> (Int,[Int])

12+roundTo d is =

13+ case f d is of

14+ x@(0,_) -> x

15+ (1,xs) -> (1, 1:xs)

16+ _ -> error "roundTo: bad Value"

17+ where

18+ f n [] = (0, replicate n 0)

19+ f 0 (x:_) = (if x >= 5 then 1 else 0, [])

20+ f n (i:xs)

21+ | i' == 10 = (1,0:ds)

22+ | otherwise = (0,i':ds)

23+ where

24+ (c,ds) = f (n-1) xs

25+ i' = c + i

Data/Text/Lazy/Encoding.hs+47−57

@@ -1,13 +1,11 @@

1−{-# LANGUAGE BangPatterns,CPP #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-}

4−#endif

1+{-# LANGUAGE BangPatterns #-}

52-- |

63-- Module : Data.Text.Lazy.Encoding

85--

96-- License : BSD-style

10−-- Maintainer : bos@serpentine.com

7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

8+-- duncan@haskell.org

119-- Stability : experimental

1210-- Portability : portable

1311--

@@ -22,7 +20,6 @@ module Data.Text.Lazy.Encoding

2220 -- * Decoding ByteStrings to Text

2321 -- $strict

2422 decodeASCII

25− , decodeLatin1

2623 , decodeUtf8

2724 , decodeUtf16LE

2825 , decodeUtf16BE

@@ -45,29 +42,21 @@ module Data.Text.Lazy.Encoding

4542 , encodeUtf16BE

4643 , encodeUtf32LE

4744 , encodeUtf32BE

48−

49− -- * Encoding Text using ByteString Builders

50− , encodeUtf8Builder

51− , encodeUtf8BuilderEscaped

5245 ) where

5346

5447import Control.Exception (evaluate, try)

55−import Data.Monoid (Monoid(..))

48+import Data.Bits ((.&.))

5649import Data.Text.Encoding.Error (OnDecodeError, UnicodeException, strictDecode)

57−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)

58−import Data.Word (Word8)

50+import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldrChunks)

51+import System.IO.Unsafe (unsafePerformIO)

5952import qualified Data.ByteString as S

60−import qualified Data.ByteString.Builder as B

61−import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)

62−import qualified Data.ByteString.Builder.Prim as BP

6353import qualified Data.ByteString.Lazy as B

6454import qualified Data.ByteString.Lazy.Internal as B

65−import qualified Data.ByteString.Unsafe as B

55+import qualified Data.ByteString.Unsafe as S

6656import qualified Data.Text as T

6757import qualified Data.Text.Encoding as TE

68−import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E

69−import qualified Data.Text.Internal.Lazy.Fusion as F

70−import Data.Text.Unsafe (unsafeDupablePerformIO)

58+import qualified Data.Text.Lazy.Encoding.Fusion as E

59+import qualified Data.Text.Lazy.Fusion as F

7160

7261-- $strict

7362--

@@ -84,30 +73,49 @@ import Data.Text.Unsafe (unsafeDupablePerformIO)

8473

8574-- | /Deprecated/. Decode a 'ByteString' containing 7-bit ASCII

8675-- encoded text.

76+--

77+-- This function is deprecated. Use 'decodeUtf8' instead.

8778decodeASCII :: B.ByteString -> Text

8879decodeASCII = decodeUtf8

8980{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}

9081

91−-- | Decode a 'ByteString' containing Latin-1 (aka ISO-8859-1) encoded text.

92−decodeLatin1 :: B.ByteString -> Text

93−decodeLatin1 = foldr (chunk . TE.decodeLatin1) empty . B.toChunks

94−

9582-- | Decode a 'ByteString' containing UTF-8 encoded text.

9683decodeUtf8With :: OnDecodeError -> B.ByteString -> Text

97−decodeUtf8With onErr (B.Chunk b0 bs0) =

98− case TE.streamDecodeUtf8With onErr b0 of

99− TE.Some t l f -> chunk t (go f l bs0)

84+decodeUtf8With onErr bs0 = fast bs0

10085 where

101− go f0 _ (B.Chunk b bs) =

102− case f0 b of

103− TE.Some t l f -> chunk t (go f l bs)

104− go _ l _

105− | S.null l = empty

106− | otherwise = case onErr desc (Just (B.unsafeHead l)) of

107− Nothing -> empty

108− Just c -> Chunk (T.singleton c) Empty

86+ decode = TE.decodeUtf8With onErr

87+ fast (B.Chunk p ps) | isComplete p = chunk (decode p) (fast ps)

88+ | otherwise = chunk (decode h) (slow t ps)

89+ where (h,t) = S.splitAt pivot p

90+ pivot | at 1 = len-1

91+ | at 2 = len-2

92+ | otherwise = len-3

93+ len = S.length p

94+ at n = len >= n && S.unsafeIndex p (len-n) .&. 0xc0 == 0xc0

95+ fast B.Empty = empty

96+ slow i bs = {-# SCC "decodeUtf8With'/slow" #-}

97+ case B.uncons bs of

98+ Just (w,bs') | isComplete i' -> chunk (decode i') (fast bs')

99+ | otherwise -> slow i' bs'

100+ where i' = S.snoc i w

101+ Nothing -> case S.uncons i of

102+ Just (j,i') ->

103+ case onErr desc (Just j) of

104+ Nothing -> slow i' bs

105+ Just c -> Chunk (T.singleton c) (slow i' bs)

106+ Nothing ->

107+ case onErr desc Nothing of

108+ Nothing -> empty

109+ Just c -> Chunk (T.singleton c) empty

110+ isComplete bs = {-# SCC "decodeUtf8With'/isComplete" #-}

111+ ix 1 .&. 0x80 == 0 ||

112+ (len >= 2 && ix 2 .&. 0xe0 == 0xc0) ||

113+ (len >= 3 && ix 3 .&. 0xf0 == 0xe0) ||

114+ (len >= 4 && ix 4 .&. 0xf8 == 0xf0)

115+ where len = S.length bs

116+ ix n = S.unsafeIndex bs (len-n)

109117 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"

110−decodeUtf8With _ _ = empty

118+{-# INLINE[0] decodeUtf8With #-}

111119

112120-- | Decode a 'ByteString' containing UTF-8 encoded text that is known

113121-- to be valid.

@@ -133,7 +141,7 @@ decodeUtf8 = decodeUtf8With strictDecode

133141-- input before it can return a result. If you need lazy (streaming)

134142-- decoding, use 'decodeUtf8With' in lenient mode.

135143decodeUtf8' :: B.ByteString -> Either UnicodeException Text

136−decodeUtf8' bs = unsafeDupablePerformIO $ do

144+decodeUtf8' bs = unsafePerformIO $ do

137145 let t = decodeUtf8 bs

138146 try (evaluate (rnf t `seq` t))

139147 where

@@ -142,26 +150,8 @@ decodeUtf8' bs = unsafeDupablePerformIO $ do

142150{-# INLINE decodeUtf8' #-}

143151

144152encodeUtf8 :: Text -> B.ByteString

145−encodeUtf8 Empty = B.empty

146−encodeUtf8 lt@(Chunk t _) =

147− B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt

148− where

149− -- To improve our small string performance, we use a strategy that

150− -- allocates a buffer that is guaranteed to be large enough for the

151− -- encoding of the first chunk, but not larger than the default

152− -- B.smallChunkSize. We clamp the firstChunkSize to ensure that we don't

153− -- generate too large buffers which hamper streaming.

154− firstChunkSize = min B.smallChunkSize (4 * (T.length t + 1))

155− strategy = B.safeStrategy firstChunkSize B.defaultChunkSize

156−

157−encodeUtf8Builder :: Text -> B.Builder

158−encodeUtf8Builder =

159− foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty

160−

161−{-# INLINE encodeUtf8BuilderEscaped #-}

162−encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder

163−encodeUtf8BuilderEscaped prim =

164− foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty

153+encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)

154+encodeUtf8 Empty = B.Empty

165155

166156-- | Decode text from little endian UTF-16 encoding.

167157decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text

Data/Text/Internal/Lazy/Encoding/Fusion.hs → Data/Text/Lazy/Encoding/Fusion.hsrenamed+14−17

@@ -5,18 +5,15 @@

66--

77-- License : BSD-style

8−-- Maintainer : bos@serpentine.com

8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

9+-- duncan@haskell.org

910-- Stability : experimental

1011-- Portability : portable

1112--

12−-- /Warning/: this is an internal module, and does not have a stable

13−-- API or name. Functions in this module may not check or enforce

14−-- preconditions expected by public modules. Use at your own risk!

15−--

1613-- Fusible 'Stream'-oriented functions for converting between lazy

1714-- 'Text' and several common encodings.

1815

19−module Data.Text.Internal.Lazy.Encoding.Fusion

16+module Data.Text.Lazy.Encoding.Fusion

2017 (

2118 -- * Streaming

2219 -- streamASCII

@@ -29,23 +26,23 @@ module Data.Text.Internal.Lazy.Encoding.Fusion

2926 -- * Unstreaming

3027 , unstream

3128

32− , module Data.Text.Internal.Encoding.Fusion.Common

29+ , module Data.Text.Encoding.Fusion.Common

3330 ) where

3431

3532import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)

3633import qualified Data.ByteString as B

3734import qualified Data.ByteString.Unsafe as B

38−import Data.Text.Internal.Encoding.Fusion.Common

35+import Data.Text.Encoding.Fusion.Common

3936import Data.Text.Encoding.Error

40−import Data.Text.Internal.Fusion (Step(..), Stream(..))

41−import Data.Text.Internal.Fusion.Size

42−import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)

43−import Data.Text.Internal.Unsafe.Shift (shiftL)

37+import Data.Text.Fusion (Step(..), Stream(..))

38+import Data.Text.Fusion.Size

39+import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)

40+import Data.Text.UnsafeShift (shiftL)

4441import Data.Word (Word8, Word16, Word32)

45−import qualified Data.Text.Internal.Encoding.Utf8 as U8

46−import qualified Data.Text.Internal.Encoding.Utf16 as U16

47−import qualified Data.Text.Internal.Encoding.Utf32 as U32

48−import Data.Text.Unsafe (unsafeDupablePerformIO)

42+import qualified Data.Text.Encoding.Utf8 as U8

43+import qualified Data.Text.Encoding.Utf16 as U16

44+import qualified Data.Text.Encoding.Utf32 as U32

45+import System.IO.Unsafe (unsafePerformIO)

4946import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

5047import Foreign.Storable (pokeByteOff)

5148import Data.ByteString.Internal (mallocByteString, memcpy)

@@ -275,7 +272,7 @@ streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

275272-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.

276273unstreamChunks :: Int -> Stream Word8 -> ByteString

277274unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)

278− where chunk s1 len1 = unsafeDupablePerformIO $ do

275+ where chunk s1 len1 = unsafePerformIO $ do

279276 let len = max 4 (min len1 chunkSize)

280277 mallocByteString len >>= loop len 0 s1

281278 where

Data/Text/Internal/Lazy/Fusion.hs → Data/Text/Lazy/Fusion.hsrenamed+31−38

@@ -4,17 +4,14 @@

55--

66-- License : BSD-style

7−-- Maintainer : bos@serpentine.com

7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

8+-- duncan@haskell.org

89-- Stability : experimental

910-- Portability : GHC

1011--

11−-- /Warning/: this is an internal module, and does not have a stable

12−-- API or name. Functions in this module may not check or enforce

13−-- preconditions expected by public modules. Use at your own risk!

14−--

1512-- Core stream fusion functionality for text.

1613

17−module Data.Text.Internal.Lazy.Fusion

14+module Data.Text.Lazy.Fusion

1815 (

1916 stream

2017 , unstream

@@ -26,15 +23,14 @@ module Data.Text.Internal.Lazy.Fusion

2623 ) where

2724

2825import Prelude hiding (length)

29−import qualified Data.Text.Internal.Fusion.Common as S

30−import Control.Monad.ST (runST)

31−import Data.Text.Internal.Fusion.Types

32−import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)

33−import Data.Text.Internal.Lazy

26+import qualified Data.Text.Fusion.Common as S

27+import Data.Text.Fusion.Internal

28+import Data.Text.Fusion.Size (isEmpty, unknownSize)

29+import Data.Text.Lazy.Internal

3430import qualified Data.Text.Internal as I

3531import qualified Data.Text.Array as A

36−import Data.Text.Internal.Unsafe.Char (unsafeWrite)

37−import Data.Text.Internal.Unsafe.Shift (shiftL)

32+import Data.Text.UnsafeChar (unsafeWrite)

33+import Data.Text.UnsafeShift (shiftL)

3834import Data.Text.Unsafe (Iter(..), iter)

3935import Data.Int (Int64)

4036

@@ -54,36 +50,33 @@ stream text = Stream next (text :*: 0) unknownSize

5450-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given

5551-- chunk size.

5652unstreamChunks :: Int -> Stream Char -> Text

57−unstreamChunks !chunkSize (Stream next s0 len0)

53+unstreamChunks chunkSize (Stream next s0 len0)

5854 | isEmpty len0 = Empty

5955 | otherwise = outer s0

6056 where

61− outer so = {-# SCC "unstreamChunks/outer" #-}

62− case next so of

57+ outer s = {-# SCC "unstreamChunks/outer" #-}

58+ case next s of

6359 Done -> Empty

6460 Skip s' -> outer s'

65− Yield x s' -> runST $ do

66− a <- A.new unknownLength

67− unsafeWrite a 0 x >>= inner a unknownLength s'

68− where unknownLength = 4

69− where

70− inner marr !len s !i

71− | i + 1 >= chunkSize = finish marr i s

72− | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do

73− let newLen = min (len `shiftL` 1) chunkSize

74− marr' <- A.new newLen

75− A.copyM marr' 0 marr 0 len

76− inner marr' newLen s i

77− | otherwise =

78− {-# SCC "unstreamChunks/inner" #-}

79− case next s of

80− Done -> finish marr i s

81− Skip s' -> inner marr len s' i

82− Yield x s' -> do d <- unsafeWrite marr i x

83− inner marr len s' (i+d)

84− finish marr len s' = do

85− arr <- A.unsafeFreeze marr

86− return (I.Text arr 0 len `Chunk` outer s')

61+ Yield x s' -> I.Text arr 0 len `chunk` outer s''

62+ where (arr,(s'',len)) = A.run2 fill

63+ fill = do a <- A.new unknownLength

64+ unsafeWrite a 0 x >>= inner a unknownLength s'

65+ unknownLength = 4

66+ inner marr len s !i

67+ | i + 1 >= chunkSize = return (marr, (s,i))

68+ | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do

69+ let newLen = min (len `shiftL` 1) chunkSize

70+ marr' <- A.new newLen

71+ A.copyM marr' 0 marr 0 len

72+ inner marr' newLen s i

73+ | otherwise =

74+ {-# SCC "unstreamChunks/inner" #-}

75+ case next s of

76+ Done -> return (marr,(s,i))

77+ Skip s' -> inner marr len s' i

78+ Yield x s' -> do d <- unsafeWrite marr i x

79+ inner marr len s' (i+d)

8780{-# INLINE [0] unstreamChunks #-}

8881

8982-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using

Data/Text/Lazy/IO.hs+22−11

@@ -1,7 +1,4 @@

11{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-}

4−#endif

52-- |

63-- Module : Data.Text.Lazy.IO

@@ -19,7 +16,7 @@

1916module Data.Text.Lazy.IO

2017 (

2118 -- * Performance

22− -- $performance

19+ -- $performance

2320

2421 -- * Locale support

2522 -- $locale

@@ -41,17 +38,22 @@ module Data.Text.Lazy.IO

4138 ) where

4239

4340import Data.Text.Lazy (Text)

44−import Prelude hiding (appendFile, getContents, getLine, interact,

41+import Prelude hiding (appendFile, catch, getContents, getLine, interact,

4542 putStr, putStrLn, readFile, writeFile)

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

4744 withFile)

4845import qualified Data.Text.IO as T

4946import qualified Data.Text.Lazy as L

50−import qualified Control.Exception as E

47+#if __GLASGOW_HASKELL__ <= 610

48+import Data.Text.Lazy.Encoding (decodeUtf8)

49+import qualified Data.ByteString.Char8 as S8

50+import qualified Data.ByteString.Lazy.Char8 as L8

51+#else

52+import Control.Exception (catch, throwIO)

5153import Control.Monad (when)

5254import Data.IORef (readIORef)

53−import Data.Text.Internal.IO (hGetLineWith, readChunk)

54−import Data.Text.Internal.Lazy (chunk, empty)

55+import Data.Text.IO.Internal (hGetLineWith, readChunk)

56+import Data.Text.Lazy.Internal (chunk, empty)

5557import GHC.IO.Buffer (isEmptyBuffer)

5658import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)

5759import GHC.IO.Handle.Internals (augmentIOError, hClose_help,

@@ -60,6 +62,7 @@ import GHC.IO.Handle.Types (Handle__(..), HandleType(..))

6062import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)

6163import System.IO.Error (isEOFError)

6264import System.IO.Unsafe (unsafeInterleaveIO)

65+#endif

6366

6467-- $performance

6568--

@@ -93,6 +96,9 @@ appendFile p = withFile p AppendMode . flip hPutStr

9396-- | Lazily read the remaining contents of a 'Handle'. The 'Handle'

9497-- will be closed after the read completes, or on error.

9598hGetContents :: Handle -> IO Text

99+#if __GLASGOW_HASKELL__ <= 610

100+hGetContents = fmap decodeUtf8 . L8.hGetContents

101+#else

96102hGetContents h = do

97103 chooseGoodBuffering h

98104 wantReadableHandle "hGetContents" h $ \hh -> do

@@ -113,7 +119,7 @@ lazyRead h = unsafeInterleaveIO $

113119 case haType hh of

114120 ClosedHandle -> return (hh, L.empty)

115121 SemiClosedHandle -> lazyReadBuffered h hh

116− _ -> ioException

122+ _ -> ioException

117123 (IOError (Just h) IllegalOperation "hGetContents"

118124 "illegal handle type" Nothing Nothing)

119125

@@ -122,17 +128,22 @@ lazyReadBuffered h hh@Handle__{..} = do

122128 buf <- readIORef haCharBuffer

123129 (do t <- readChunk hh buf

124130 ts <- lazyRead h

125− return (hh, chunk t ts)) `E.catch` \e -> do

131+ return (hh, chunk t ts)) `catch` \e -> do

126132 (hh', _) <- hClose_help hh

127133 if isEOFError e

128134 then return $ if isEmptyBuffer buf

129135 then (hh', empty)

130136 else (hh', L.singleton '\r')

131− else E.throwIO (augmentIOError e "hGetContents" h)

137+ else throwIO (augmentIOError e "hGetContents" h)

138+#endif

132139

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

134141hGetLine :: Handle -> IO Text

142+#if __GLASGOW_HASKELL__ <= 610

143+hGetLine = fmap (decodeUtf8 . L8.fromChunks . (:[])) . S8.hGetLine

144+#else

135145hGetLine = hGetLineWith L.fromChunks

146+#endif

136147

137148-- | Write a string to a handle.

138149hPutStr :: Handle -> Text -> IO ()

Data/Text/Lazy/Internal.hs+105−7

@@ -1,20 +1,118 @@

11{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}

22-- |

33-- Module : Data.Text.Lazy.Internal

55--

66-- License : BSD-style

7−-- Maintainer : bos@serpentine.com

7+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

8+-- duncan@haskell.org

89-- Stability : experimental

910-- Portability : GHC

11+--

12+-- A module containing private 'Text' internals. This exposes the

13+-- 'Text' representation and low level construction functions.

14+-- Modules which extend the 'Text' system may need to use this module.

1015--

11−-- This module has been renamed to 'Data.Text.Internal.Lazy'. This

12−-- name for the module will be removed in the next major release.

16+-- You should not use this module unless you are determined to monkey

17+-- with the internals, as the functions here do just about nothing to

18+-- preserve data invariants. You have been warned!

1319

1420module Data.Text.Lazy.Internal

15− {-# DEPRECATED "Use Data.Text.Internal.Lazy instead" #-}

1621 (

17− module Data.Text.Internal.Lazy

22+ Text(..)

23+ , chunk

24+ , empty

25+ , foldrChunks

26+ , foldlChunks

27+ -- * Data type invariant and abstraction functions

28+

29+ -- $invariant

30+ , strictInvariant

31+ , lazyInvariant

32+ , showStructure

33+

34+ -- * Chunk allocation sizes

35+ , defaultChunkSize

36+ , smallChunkSize

37+ , chunkOverhead

1838 ) where

1939

20−import Data.Text.Internal.Lazy

40+import Data.Text ()

41+import Data.Text.UnsafeShift (shiftL)

42+import Data.Typeable (Typeable)

43+import Foreign.Storable (sizeOf)

44+import qualified Data.Text.Internal as T

45+

46+data Text = Empty

47+ | Chunk {-# UNPACK #-} !T.Text Text

48+ deriving (Typeable)

49+

50+-- $invariant

51+--

52+-- The data type invariant for lazy 'Text': Every 'Text' is either 'Empty' or

53+-- consists of non-null 'T.Text's. All functions must preserve this,

54+-- and the QC properties must check this.

55+

56+-- | Check the invariant strictly.

57+strictInvariant :: Text -> Bool

58+strictInvariant Empty = True

59+strictInvariant x@(Chunk (T.Text _ _ len) cs)

60+ | len > 0 = strictInvariant cs

61+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "

62+ ++ showStructure x

63+

64+-- | Check the invariant lazily.

65+lazyInvariant :: Text -> Text

66+lazyInvariant Empty = Empty

67+lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)

68+ | len > 0 = Chunk c (lazyInvariant cs)

69+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "

70+ ++ showStructure x

71+

72+-- | Display the internal structure of a lazy 'Text'.

73+showStructure :: Text -> String

74+showStructure Empty = "Empty"

75+showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"

76+showStructure (Chunk t ts) =

77+ "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"

78+

79+-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.

80+chunk :: T.Text -> Text -> Text

81+{-# INLINE chunk #-}

82+chunk t@(T.Text _ _ len) ts | len == 0 = ts

83+ | otherwise = Chunk t ts

84+

85+-- | Smart constructor for 'Empty'.

86+empty :: Text

87+{-# INLINE [0] empty #-}

88+empty = Empty

89+

90+-- | Consume the chunks of a lazy 'Text' with a natural right fold.

91+foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a

92+foldrChunks f z = go

93+ where go Empty = z

94+ go (Chunk c cs) = f c (go cs)

95+{-# INLINE foldrChunks #-}

96+

97+-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,

98+-- accumulating left fold.

99+foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a

100+foldlChunks f z = go z

101+ where go !a Empty = a

102+ go !a (Chunk c cs) = go (f a c) cs

103+{-# INLINE foldlChunks #-}

104+

105+-- | Currently set to 16 KiB, less the memory management overhead.

106+defaultChunkSize :: Int

107+defaultChunkSize = 16384 - chunkOverhead

108+{-# INLINE defaultChunkSize #-}

109+

110+-- | Currently set to 128 bytes, less the memory management overhead.

111+smallChunkSize :: Int

112+smallChunkSize = 128 - chunkOverhead

113+{-# INLINE smallChunkSize #-}

114+

115+-- | The memory management overhead. Currently this is tuned for GHC only.

116+chunkOverhead :: Int

117+chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1

118+{-# INLINE chunkOverhead #-}

Data/Text/Lazy/Read.hs+33−11

@@ -1,9 +1,4 @@

1−{-# LANGUAGE OverloadedStrings, CPP #-}

2−#if __GLASGOW_HASKELL__ >= 704

3−{-# LANGUAGE Safe #-}

4−#elif __GLASGOW_HASKELL__ >= 702

5−{-# LANGUAGE Trustworthy #-}

6−#endif

1+{-# LANGUAGE OverloadedStrings #-}

83-- |

94-- Module : Data.Text.Lazy.Read

@@ -26,17 +21,15 @@ module Data.Text.Lazy.Read

2621 ) where

2722

2823import Control.Monad (liftM)

29−import Data.Char (isDigit, isHexDigit)

24+import Data.Char (isDigit, isHexDigit, ord)

3025import Data.Int (Int8, Int16, Int32, Int64)

3126import Data.Ratio ((%))

32−import Data.Text.Internal.Read

3327import Data.Text.Lazy as T

3428import Data.Word (Word, Word8, Word16, Word32, Word64)

3529

3630-- | Read some text. If the read succeeds, return its value and the

3731-- remaining text, otherwise an error message.

38−type Reader a = IReader Text a

39−type Parser = IParser Text

32+type Reader a = Text -> Either String (a,Text)

4033

4134-- | Read a decimal integer. The input must begin with at least one

4235-- decimal digit, and is consumed until a non-digit or end of string

@@ -56,7 +49,7 @@ decimal :: Integral a => Reader a

5649{-# SPECIALIZE decimal :: Reader Int32 #-}

5750{-# SPECIALIZE decimal :: Reader Int64 #-}

5851{-# SPECIALIZE decimal :: Reader Integer #-}

59−{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}

52+{-# SPECIALIZE decimal :: Reader Word #-}

6053{-# SPECIALIZE decimal :: Reader Word8 #-}

6154{-# SPECIALIZE decimal :: Reader Word16 #-}

6255{-# SPECIALIZE decimal :: Reader Word32 #-}

@@ -105,6 +98,15 @@ hex txt

10598 where (h,t) = T.span isHexDigit txt

10699 go n d = (n * 16 + fromIntegral (hexDigitToInt d))

107100

101+hexDigitToInt :: Char -> Int

102+hexDigitToInt c

103+ | c >= '0' && c <= '9' = ord c - ord '0'

104+ | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)

105+ | otherwise = ord c - (ord 'A' - 10)

106+

107+digitToInt :: Char -> Int

108+digitToInt c = ord c - ord '0'

109+

108110-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and

109111-- apply it to the result of applying the given reader.

110112signed :: Num a => Reader a -> Reader a

@@ -164,11 +166,31 @@ signa p = do

164166 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')

165167 if sign == '+' then p else negate `liftM` p

166168

169+newtype Parser a = P {

170+ runP :: Reader a

171+ }

172+

173+instance Monad Parser where

174+ return a = P $ \t -> Right (a,t)

175+ {-# INLINE return #-}

176+ m >>= k = P $ \t -> case runP m t of

177+ Left err -> Left err

178+ Right (a,t') -> runP (k a) t'

179+ {-# INLINE (>>=) #-}

180+ fail msg = P $ \_ -> Left msg

181+

182+perhaps :: a -> Parser a -> Parser a

183+perhaps def m = P $ \t -> case runP m t of

184+ Left _ -> Right (def,t)

185+ r@(Right _) -> r

186+

167187char :: (Char -> Bool) -> Parser Char

168188char p = P $ \t -> case T.uncons t of

169189 Just (c,t') | p c -> Right (c,t')

170190 _ -> Left "character does not match"

171191

192+data T = T !Integer !Int

193+

172194floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a

173195{-# INLINE floaty #-}

174196floaty f = runP $ do

Data/Text/Internal/Lazy/Search.hs → Data/Text/Lazy/Search.hsrenamed+6−9

@@ -5,19 +5,16 @@

66--

77-- License : BSD-style

8−-- Maintainer : bos@serpentine.com

8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

9+-- duncan@haskell.org

910-- Stability : experimental

1011-- Portability : GHC

1112--

12−-- /Warning/: this is an internal module, and does not have a stable

13−-- API or name. Functions in this module may not check or enforce

14−-- preconditions expected by public modules. Use at your own risk!

15−--

1613-- Fast substring search for lazy 'Text', based on work by Boyer,

1714-- Moore, Horspool, Sunday, and Lundh. Adapted from the strict

1815-- implementation.

1916

20−module Data.Text.Internal.Lazy.Search

17+module Data.Text.Lazy.Search

2118 (

2219 indices

2320 ) where

@@ -26,10 +23,10 @@ import qualified Data.Text.Array as A

2623import Data.Int (Int64)

2724import Data.Word (Word16, Word64)

2825import qualified Data.Text.Internal as T

29−import Data.Text.Internal.Fusion.Types (PairS(..))

30−import Data.Text.Internal.Lazy (Text(..), foldlChunks)

26+import Data.Text.Fusion.Internal (PairS(..))

27+import Data.Text.Lazy.Internal (Text(..), foldlChunks)

3128import Data.Bits ((.|.), (.&.))

32−import Data.Text.Internal.Unsafe.Shift (shiftL)

29+import Data.Text.UnsafeShift (shiftL)

3330

3431-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

3532-- @needle@ within @haystack@.

Data/Text/Private.hsnew file+28

@@ -0,0 +1,28 @@

1+{-# LANGUAGE BangPatterns, UnboxedTuples #-}

3+-- |

4+-- Module : Data.Text.Private

6+--

7+-- License : BSD-style

8+-- Maintainer : bos@serpentine.com

9+-- Stability : experimental

10+-- Portability : GHC

11+

12+module Data.Text.Private

13+ (

14+ span_

15+ ) where

16+

17+import Data.Text.Internal (Text(..), textP)

18+import Data.Text.Unsafe (Iter(..), iter)

19+

20+span_ :: (Char -> Bool) -> Text -> (# Text, Text #)

21+span_ p t@(Text arr off len) = (# hd,tl #)

22+ where hd = textP arr off k

23+ tl = textP arr (off+k) (len-k)

24+ !k = loop 0

25+ loop !i | i < len && p c = loop (i+d)

26+ | otherwise = i

27+ where Iter c d = iter t i

28+{-# INLINE span_ #-}

Data/Text/Read.hs+34−10

@@ -1,7 +1,4 @@

1−{-# LANGUAGE OverloadedStrings, UnboxedTuples, CPP #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-}

4−#endif

1+{-# LANGUAGE OverloadedStrings, UnboxedTuples #-}

63-- |

74-- Module : Data.Text.Read

@@ -24,18 +21,16 @@ module Data.Text.Read

2421 ) where

2522

2623import Control.Monad (liftM)

27−import Data.Char (isDigit, isHexDigit)

24+import Data.Char (isDigit, isHexDigit, ord)

2825import Data.Int (Int8, Int16, Int32, Int64)

2926import Data.Ratio ((%))

3027import Data.Text as T

31−import Data.Text.Internal.Private (span_)

32−import Data.Text.Internal.Read

28+import Data.Text.Private (span_)

3329import Data.Word (Word, Word8, Word16, Word32, Word64)

3430

3531-- | Read some text. If the read succeeds, return its value and the

3632-- remaining text, otherwise an error message.

37−type Reader a = IReader Text a

38−type Parser a = IParser Text a

33+type Reader a = Text -> Either String (a,Text)

3934

4035-- | Read a decimal integer. The input must begin with at least one

4136-- decimal digit, and is consumed until a non-digit or end of string

@@ -55,7 +50,7 @@ decimal :: Integral a => Reader a

5550{-# SPECIALIZE decimal :: Reader Int32 #-}

5651{-# SPECIALIZE decimal :: Reader Int64 #-}

5752{-# SPECIALIZE decimal :: Reader Integer #-}

58−{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}

53+{-# SPECIALIZE decimal :: Reader Word #-}

5954{-# SPECIALIZE decimal :: Reader Word8 #-}

6055{-# SPECIALIZE decimal :: Reader Word16 #-}

6156{-# SPECIALIZE decimal :: Reader Word32 #-}

@@ -113,6 +108,15 @@ hex txt

113108 where (# h,t #) = span_ isHexDigit txt

114109 go n d = (n * 16 + fromIntegral (hexDigitToInt d))

115110

111+hexDigitToInt :: Char -> Int

112+hexDigitToInt c

113+ | c >= '0' && c <= '9' = ord c - ord '0'

114+ | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10)

115+ | otherwise = ord c - (ord 'A' - 10)

116+

117+digitToInt :: Char -> Int

118+digitToInt c = ord c - ord '0'

119+

116120-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and

117121-- apply it to the result of applying the given reader.

118122signed :: Num a => Reader a -> Reader a

@@ -172,11 +176,31 @@ signa p = do

172176 sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')

173177 if sign == '+' then p else negate `liftM` p

174178

179+newtype Parser a = P {

180+ runP :: Reader a

181+ }

182+

183+instance Monad Parser where

184+ return a = P $ \t -> Right (a,t)

185+ {-# INLINE return #-}

186+ m >>= k = P $ \t -> case runP m t of

187+ Left err -> Left err

188+ Right (a,t') -> runP (k a) t'

189+ {-# INLINE (>>=) #-}

190+ fail msg = P $ \_ -> Left msg

191+

192+perhaps :: a -> Parser a -> Parser a

193+perhaps def m = P $ \t -> case runP m t of

194+ Left _ -> Right (def,t)

195+ r@(Right _) -> r

196+

175197char :: (Char -> Bool) -> Parser Char

176198char p = P $ \t -> case T.uncons t of

177199 Just (c,t') | p c -> Right (c,t')

178200 _ -> Left "character does not match"

179201

202+data T = T !Integer !Int

203+

180204floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a

181205{-# INLINE floaty #-}

182206floaty f = runP $ do

Data/Text/Internal/Search.hs → Data/Text/Search.hsrenamed+11−12

@@ -1,11 +1,12 @@

11{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}

33-- |

4−-- Module : Data.Text.Internal.Search

4+-- Module : Data.Text.Search

55-- Copyright : (c) Bryan O'Sullivan 2009

66--

77-- License : BSD-style

8−-- Maintainer : bos@serpentine.com

8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

9+-- duncan@haskell.org

910-- Stability : experimental

1011-- Portability : GHC

1112--

@@ -13,7 +14,7 @@

1314-- Horspool, Sunday, and Lundh.

1415--

1516-- References:

16−--

17+--

1718-- * R. S. Boyer, J. S. Moore: A Fast String Searching Algorithm.

1819-- Communications of the ACM, 20, 10, 762-772 (1977)

1920--

@@ -26,7 +27,7 @@

2627-- * F. Lundh: The Fast Search Algorithm.

2728-- <http://effbot.org/zone/stringlib.htm> (2006)

2829

29−module Data.Text.Internal.Search

30+module Data.Text.Search

3031 (

3132 indices

3233 ) where

@@ -34,15 +35,13 @@ module Data.Text.Internal.Search

3435import qualified Data.Text.Array as A

3536import Data.Word (Word64)

3637import Data.Text.Internal (Text(..))

38+import Data.Text.Fusion.Internal (PairS(..))

3739import Data.Bits ((.|.), (.&.))

38−import Data.Text.Internal.Unsafe.Shift (shiftL)

39−

40−data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int

40+import Data.Text.UnsafeShift (shiftL)

4141

4242-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

4343-- @needle@ within @haystack@. The offsets returned represent

44−-- uncorrected indices in the low-level \"needle\" array, to which its

45−-- offset must be added.

44+-- locations in the low-level array.

4645--

4746-- In (unlikely) bad cases, this algorithm's complexity degrades

4847-- towards /O(n*m)/.

@@ -61,8 +60,9 @@ indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)

6160 hindex k = A.unsafeIndex harr (hoff+k)

6261 hindex' k | k == hlen = 0

6362 | otherwise = A.unsafeIndex harr (hoff+k)

63+ (mask :: Word64) :*: skip = buildTable 0 0 (nlen-2)

6464 buildTable !i !msk !skp

65− | i >= nlast = (msk .|. swizzle z) :* skp

65+ | i >= nlast = (msk .|. swizzle z) :*: skp

6666 | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'

6767 where c = nindex i

6868 skp' | c == z = nlen - i - 2

@@ -80,8 +80,7 @@ indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)

8080 delta | nextInPattern = nlen + 1

8181 | c == z = skip + 1

8282 | otherwise = 1

83− where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0

84− !(mask :* skip) = buildTable 0 0 (nlen-2)

83+ nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0

8584 scanOne c = loop 0

8685 where loop !i | i >= hlen = []

8786 | hindex i == c = i : loop (i+1)

Data/Text/Show.hsdeleted−89

@@ -1,89 +0,0 @@

1−{-# LANGUAGE CPP, MagicHash #-}

2−{-# OPTIONS_GHC -fno-warn-orphans #-}

3−#if __GLASGOW_HASKELL__ >= 702

4−{-# LANGUAGE Trustworthy #-}

5−#endif

6−

7−-- |

8−-- Module : Data.Text.Show

10−--

11−-- License : BSD-style

12−-- Maintainer : bos@serpentine.com

13−-- Stability : experimental

14−-- Portability : GHC

15−

16−module Data.Text.Show

17− (

18− singleton

19− , unpack

20− , unpackCString#

21− ) where

22−

23−import Control.Monad.ST (ST)

24−import Data.Text.Internal (Text(..), empty_, safe)

25−import Data.Text.Internal.Fusion (stream, unstream)

26−import Data.Text.Internal.Unsafe.Char (unsafeWrite)

27−import GHC.Prim (Addr#)

28−import qualified Data.Text.Array as A

29−import qualified Data.Text.Internal.Fusion.Common as S

30−

31−#if __GLASGOW_HASKELL__ >= 702

32−import qualified GHC.CString as GHC

33−#else

34−import qualified GHC.Base as GHC

35−#endif

36−

37−instance Show Text where

38− showsPrec p ps r = showsPrec p (unpack ps) r

39−

40−-- | /O(n)/ Convert a 'Text' into a 'String'. Subject to fusion.

41−unpack :: Text -> String

42−unpack = S.unstreamList . stream

43−{-# INLINE [1] unpack #-}

44−

45−-- | /O(n)/ Convert a literal string into a 'Text'. Subject to

46−-- fusion.

47−--

48−-- This is exposed solely for people writing GHC rewrite rules.

49−unpackCString# :: Addr# -> Text

50−unpackCString# addr# = unstream (S.streamCString# addr#)

51−{-# NOINLINE unpackCString# #-}

52−

53−{-# RULES "TEXT literal" [1] forall a.

54− unstream (S.map safe (S.streamList (GHC.unpackCString# a)))

55− = unpackCString# a #-}

56−

57−{-# RULES "TEXT literal UTF8" [1] forall a.

58− unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))

59− = unpackCString# a #-}

60−

61−{-# RULES "TEXT empty literal" [1]

62− unstream (S.map safe (S.streamList []))

63− = empty_ #-}

64−

65−{-# RULES "TEXT singleton literal" [1] forall a.

66− unstream (S.map safe (S.streamList [a]))

67− = singleton_ a #-}

68−

69−-- | /O(1)/ Convert a character into a Text. Subject to fusion.

70−-- Performs replacement on invalid scalar values.

71−singleton :: Char -> Text

72−singleton = unstream . S.singleton . safe

73−{-# INLINE [1] singleton #-}

74−

75−{-# RULES "TEXT singleton" forall a.

76− unstream (S.singleton (safe a))

77− = singleton_ a #-}

78−

79−-- This is intended to reduce inlining bloat.

80−singleton_ :: Char -> Text

81−singleton_ c = Text (A.run x) 0 len

82− where x :: ST s (A.MArray s)

83− x = do arr <- A.new len

84− _ <- unsafeWrite arr 0 d

85− return arr

86− len | d < '\x10000' = 1

87− | otherwise = 2

88− d = safe c

89−{-# NOINLINE singleton_ #-}

Data/Text/Unsafe.hs+7−19

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

33-- Module : Data.Text.Unsafe

55-- License : BSD-style

6−-- Maintainer : bos@serpentine.com

6+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

7+-- duncan@haskell.org

78-- Stability : experimental

89-- Portability : portable

910--

@@ -13,28 +14,25 @@ module Data.Text.Unsafe

1314 (

1415 inlineInterleaveST

1516 , inlinePerformIO

16− , unsafeDupablePerformIO

1717 , Iter(..)

1818 , iter

1919 , iter_

2020 , reverseIter

21− , reverseIter_

2221 , unsafeHead

2322 , unsafeTail

2423 , lengthWord16

2524 , takeWord16

2625 , dropWord16

2726 ) where

28−

27+

2928#if defined(ASSERTS)

3029import Control.Exception (assert)

3130#endif

32−import Data.Text.Internal.Encoding.Utf16 (chr2)

31+import Data.Text.Encoding.Utf16 (chr2)

3332import Data.Text.Internal (Text(..))

34−import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)

35−import Data.Text.Internal.Unsafe.Char (unsafeChr)

33+import Data.Text.Unsafe.Base (inlineInterleaveST, inlinePerformIO)

34+import Data.Text.UnsafeChar (unsafeChr)

3635import qualified Data.Text.Array as A

37−import GHC.IO (unsafeDupablePerformIO)

3836

3937-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'

4038-- omits the check for the empty case, so there is an obligation on

@@ -47,7 +45,7 @@ unsafeHead (Text arr off _len)

4745 n = A.unsafeIndex arr (off+1)

4846{-# INLINE unsafeHead #-}

4947

50−-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'

48+-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeHead'

5149-- omits the check for the empty case, so there is an obligation on

5250-- the programmer to provide a proof that the 'Text' is non-empty.

5351unsafeTail :: Text -> Text

@@ -95,16 +93,6 @@ reverseIter (Text arr off _len) i

9593 k = j - 1

9694{-# INLINE reverseIter #-}

9795

98−-- | /O(1)/ Iterate one step backwards through a UTF-16 array,

99−-- returning the delta to add (i.e. a negative number) to give the

100−-- next offset to iterate at.

101−reverseIter_ :: Text -> Int -> Int

102−reverseIter_ (Text arr off _len) i

103− | m < 0xDC00 || m > 0xDFFF = -1

104− | otherwise = -2

105− where m = A.unsafeIndex arr (off+i)

106−{-# INLINE reverseIter_ #-}

107−

10896-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This

10997-- is useful for sizing a target array appropriately before using

11098-- 'unsafeCopyToPtr'.

Data/Text/Internal/Unsafe.hs → Data/Text/Unsafe/Base.hsrenamed+11−12

@@ -1,29 +1,28 @@

11{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}

2−{-# OPTIONS_HADDOCK not-home #-}

3−

42-- |

5−-- Module : Data.Text.Internal.Unsafe

3+-- Module : Data.Text.Unsafe.Base

75-- License : BSD-style

8−-- Maintainer : bos@serpentine.com

6+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

7+-- duncan@haskell.org

98-- Stability : experimental

109-- Portability : portable

1110--

12−-- /Warning/: this is an internal module, and does not have a stable

13−-- API or name. Functions in this module may not check or enforce

14−-- preconditions expected by public modules. Use at your own risk!

15−--

16−-- A module containing /unsafe/ operations, for /very very careful/ use

17−-- in /heavily tested/ code.

18−module Data.Text.Internal.Unsafe

11+-- A module containing unsafe operations, for very very careful use in

12+-- heavily tested code.

13+module Data.Text.Unsafe.Base

1914 (

2015 inlineInterleaveST

2116 , inlinePerformIO

2217 ) where

23−

18+

2419import GHC.ST (ST(..))

2520#if defined(__GLASGOW_HASKELL__)

21+# if __GLASGOW_HASKELL__ >= 611

2622import GHC.IO (IO(IO))

23+# else

24+import GHC.IOBase (IO(IO))

25+# endif

2726import GHC.Base (realWorld#)

2827#endif

2928

Data/Text/Internal/Unsafe/Char.hs → Data/Text/UnsafeChar.hsrenamed+5−8

@@ -1,22 +1,19 @@

11{-# LANGUAGE CPP, MagicHash #-}

33-- |

4−-- Module : Data.Text.Internal.Unsafe.Char

4+-- Module : Data.Text.UnsafeChar

88--

99-- License : BSD-style

10−-- Maintainer : bos@serpentine.com

10+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

11+-- duncan@haskell.org

1112-- Stability : experimental

1213-- Portability : GHC

1314--

14−-- /Warning/: this is an internal module, and does not have a stable

15−-- API or name. Functions in this module may not check or enforce

16−-- preconditions expected by public modules. Use at your own risk!

17−--

1815-- Fast character manipulation functions.

19−module Data.Text.Internal.Unsafe.Char

16+module Data.Text.UnsafeChar

2017 (

2118 ord

2219 , unsafeChr

@@ -31,7 +28,7 @@ import Control.Exception (assert)

3128#endif

3229import Control.Monad.ST (ST)

3330import Data.Bits ((.&.))

34−import Data.Text.Internal.Unsafe.Shift (shiftR)

31+import Data.Text.UnsafeShift (shiftR)

3532import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)

3633import GHC.Word (Word8(..), Word16(..), Word32(..))

3734import qualified Data.Text.Array as A

Data/Text/Internal/Unsafe/Shift.hs → Data/Text/UnsafeShift.hsrenamed+4−7

@@ -1,21 +1,18 @@

11{-# LANGUAGE MagicHash #-}

33-- |

4−-- Module : Data.Text.Internal.Unsafe.Shift

4+-- Module : Data.Text.UnsafeShift

55-- Copyright : (c) Bryan O'Sullivan 2009

66--

77-- License : BSD-style

8−-- Maintainer : bos@serpentine.com

8+-- Maintainer : bos@serpentine.com, rtomharper@googlemail.com,

9+-- duncan@haskell.org

910-- Stability : experimental

1011-- Portability : GHC

1112--

12−-- /Warning/: this is an internal module, and does not have a stable

13−-- API or name. Functions in this module may not check or enforce

14−-- preconditions expected by public modules. Use at your own risk!

15−--

1613-- Fast, unchecked bit shifting functions.

1714

18−module Data.Text.Internal.Unsafe.Shift

15+module Data.Text.UnsafeShift

1916 (

2017 UnsafeShift(..)

2118 ) where

Data/Text/Internal/Functions.hs → Data/Text/Util.hsrenamed+2−6

@@ -1,7 +1,7 @@

11{-# LANGUAGE CPP, DeriveDataTypeable #-}

33-- |

4−-- Module : Data.Text.Internal.Functions

4+-- Module : Data.Text.Util

55-- Copyright : 2010 Bryan O'Sullivan

66--

77-- License : BSD-style

@@ -9,13 +9,9 @@

99-- Stability : experimental

1010-- Portability : GHC

1111--

12−-- /Warning/: this is an internal module, and does not have a stable

13−-- API or name. Functions in this module may not check or enforce

14−-- preconditions expected by public modules. Use at your own risk!

15−--

1612-- Useful functions.

1713

18−module Data.Text.Internal.Functions

14+module Data.Text.Util

1915 (

2016 intersperse

2117 ) where

benchmarks/haskell/Benchmarks/Builder.hsdeleted−75

@@ -1,75 +0,0 @@

1−-- | Testing the internal builder monoid

2−--

3−-- Tested in this benchmark:

4−--

5−-- * Concatenating many small strings using a builder

6−--

7−{-# LANGUAGE OverloadedStrings #-}

8−module Benchmarks.Builder

9− ( benchmark

10− ) where

11−

12−import Criterion (Benchmark, bgroup, bench, nf)

13−import Data.Binary.Builder as B

14−import Data.ByteString.Char8 ()

15−import Data.Monoid (mconcat, mempty)

16−import qualified Blaze.ByteString.Builder as Blaze

17−import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze

18−import qualified Data.ByteString as SB

19−import qualified Data.ByteString.Lazy as LB

20−import qualified Data.Text as T

21−import qualified Data.Text.Lazy as LT

22−import qualified Data.Text.Lazy.Builder as LTB

23−import qualified Data.Text.Lazy.Builder.Int as Int

24−import Data.Int (Int64)

25−

26−benchmark :: IO Benchmark

27−benchmark = return $ bgroup "Builder"

28− [ bgroup "Comparison"

29− [ bench "LazyText" $ nf

30− (LT.length . LTB.toLazyText . mconcat . map LTB.fromText) texts

31− , bench "Binary" $ nf

32− (LB.length . B.toLazyByteString . mconcat . map B.fromByteString)

33− byteStrings

34− , bench "Blaze" $ nf

35− (LB.length . Blaze.toLazyByteString . mconcat . map Blaze.fromString)

36− strings

37− ]

38− , bgroup "Int"

39− [ bgroup "Decimal"

40− [ bgroup "Positive" .

41− flip map numbers $ \n ->

42− (bench (show (length (show n))) $ nf (LTB.toLazyText . Int.decimal) n)

43− , bgroup "Negative" .

44− flip map numbers $ \m ->

45− let n = negate m in

46− (bench (show (length (show n))) $ nf (LTB.toLazyText . Int.decimal) n)

47− , bench "Empty" $ nf LTB.toLazyText mempty

48− , bgroup "Show" .

49− flip map numbers $ \n ->

50− (bench (show (length (show n))) $ nf show n)

51− ]

52− ]

53− ]

54− where

55− numbers :: [Int64]

56− numbers = [

57− 6, 14, 500, 9688, 10654, 620735, 5608880, 37010612,

58− 731223504, 5061580596, 24596952933, 711732309084, 2845910093839,

59− 54601756118340, 735159434806159, 3619097625502435, 95777227510267124,

60− 414944309510675693, 8986407456998704019

61− ]

62−

63−texts :: [T.Text]

64−texts = take 200000 $ cycle ["foo", "λx", "由の"]

65−{-# NOINLINE texts #-}

66−

67−-- Note that the non-ascii characters will be chopped

68−byteStrings :: [SB.ByteString]

69−byteStrings = take 200000 $ cycle ["foo", "λx", "由の"]

70−{-# NOINLINE byteStrings #-}

71−

72−-- Note that the non-ascii characters will be chopped

73−strings :: [String]

74−strings = take 200000 $ cycle ["foo", "λx", "由の"]

75−{-# NOINLINE strings #-}

benchmarks/haskell/Benchmarks/FileRead.hsdeleted−33

@@ -1,33 +0,0 @@

1−-- | Benchmarks simple file reading

2−--

3−-- Tested in this benchmark:

4−--

5−-- * Reading a file from the disk

6−--

7−module Benchmarks.FileRead

8− ( benchmark

9− ) where

10−

11−import Control.Applicative ((<$>))

12−import Criterion (Benchmark, bgroup, bench, whnfIO)

13−import qualified Data.ByteString as SB

14−import qualified Data.ByteString.Lazy as LB

15−import qualified Data.Text as T

16−import qualified Data.Text.Encoding as T

17−import qualified Data.Text.IO as T

18−import qualified Data.Text.Lazy as LT

19−import qualified Data.Text.Lazy.Encoding as LT

20−import qualified Data.Text.Lazy.IO as LT

21−

22−benchmark :: FilePath -> IO Benchmark

23−benchmark p = return $ bgroup "FileRead"

24− [ bench "String" $ whnfIO $ length <$> readFile p

25− , bench "ByteString" $ whnfIO $ SB.length <$> SB.readFile p

26− , bench "LazyByteString" $ whnfIO $ LB.length <$> LB.readFile p

27− , bench "Text" $ whnfIO $ T.length <$> T.readFile p

28− , bench "LazyText" $ whnfIO $ LT.length <$> LT.readFile p

29− , bench "TextByteString" $ whnfIO $

30− (T.length . T.decodeUtf8) <$> SB.readFile p

31− , bench "LazyTextByteString" $ whnfIO $

32− (LT.length . LT.decodeUtf8) <$> LB.readFile p

33− ]

benchmarks/haskell/Benchmarks/Mul.hsdeleted−138

@@ -1,138 +0,0 @@

1−module Benchmarks.Mul (benchmark) where

2−

3−import Control.Exception (evaluate)

4−import Criterion.Main

5−import Data.Int (Int32, Int64)

6−import Data.Text.Internal (mul32, mul64)

7−import qualified Data.Vector.Unboxed as U

8−

9−oldMul :: Int64 -> Int64 -> Int64

10−oldMul m n

11− | n == 0 = 0

12− | m <= maxBound `quot` n = m * n

13− | otherwise = error "overflow"

14−

15−benchmark :: IO Benchmark

16−benchmark = do

17− _ <- evaluate testVector32

18− _ <- evaluate testVector64

19− return $ bgroup "Mul" [

20− bench "oldMul" $ whnf (U.map (uncurry oldMul)) testVector64

21− , bench "mul64" $ whnf (U.map (uncurry mul64)) testVector64

22− , bench "*64" $ whnf (U.map (uncurry (*))) testVector64

23− , bench "mul32" $ whnf (U.map (uncurry mul32)) testVector32

24− , bench "*32" $ whnf (U.map (uncurry (*))) testVector32

25− ]

26−

27−testVector64 :: U.Vector (Int64,Int64)

28−testVector64 = U.fromList [

29− (0,1248868987182846646),(169004623633872,24458),(482549039517835,7614),

30− (372,8157063115504364),(27,107095594861148252),(3,63249878517962420),

31− (4363,255694473572912),(86678474,1732634806),(1572453024,1800489338),

32− (9384523143,77053781),(49024709555,75095046),(7,43457620410239131),

33− (8,8201563008844571),(387719037,1520696708),(189869238220197,1423),

34− (46788016849611,23063),(503077742109974359,0),(104,1502010908706487),

35− (30478140346,207525518),(80961140129236192,14),(4283,368012829143675),

36− (1028719181728108146,6),(318904,5874863049591),(56724427166898,110794),

37− (234539368,31369110449),(2,251729663598178612),(103291548194451219,5),

38− (76013,5345328755566),(1769631,2980846129318),(40898,60598477385754),

39− (0,98931348893227155),(573555872156917492,3),(318821187115,4476566),

40− (11152874213584,243582),(40274276,16636653248),(127,4249988676030597),

41− (103543712111871836,5),(71,16954462148248238),(3963027173504,216570),

42− (13000,503523808916753),(17038308,20018685905),(0,510350226577891549),

43− (175898,3875698895405),(425299191292676,5651),(17223451323664536,50),

44− (61755131,14247665326),(0,1018195131697569303),(36433751497238985,20),

45− (3473607861601050,1837),(1392342328,1733971838),(225770297367,3249655),

46− (14,127545244155254102),(1751488975299136,2634),(3949208,504190668767),

47− (153329,831454434345),(1066212122928663658,2),(351224,2663633539556),

48− (344565,53388869217),(35825609350446863,54),(276011553660081475,10),

49− (1969754174790470349,3),(35,68088438338633),(506710,3247689556438),

50− (11099382291,327739909),(105787303549,32824363),(210366111,14759049409),

51− (688893241579,3102676),(8490,70047474429581),(152085,29923000251880),

52− (5046974599257095,400),(4183167795,263434071),(10089728,502781960687),

53− (44831977765,4725378),(91,8978094664238578),(30990165721,44053350),

54− (1772377,149651820860),(243420621763408572,4),(32,5790357453815138),

55− (27980806337993771,5),(47696295759774,20848),(1745874142313778,1098),

56− (46869334770121,1203),(886995283,1564424789),(40679396544,76002479),

57− (1,672849481568486995),(337656187205,3157069),(816980552858963,6003),

58− (2271434085804831543,1),(0,1934521023868747186),(6266220038281,15825),

59− (4160,107115946987394),(524,246808621791561),(0,1952519482439636339),

60− (128,2865935904539691),(1044,3211982069426297),(16000511542473,88922),

61− (1253596745404082,2226),(27041,56836278958002),(23201,49247489754471),

62− (175906590497,21252392),(185163584757182295,24),(34742225226802197,150),

63− (2363228,250824838408),(216327527109550,45),(24,81574076994520675),

64− (28559899906542,15356),(10890139774837133,511),(2293,707179303654492),

65− (2749366833,40703233),(0,4498229704622845986),(439,4962056468281937),

66− (662,1453820621089921),(16336770612459631,220),(24282989393,74239137),

67− (2724564648490195,3),(743672760,124992589),(4528103,704330948891),

68− (6050483122491561,250),(13322953,13594265152),(181794,22268101450214),

69− (25957941712,75384092),(43352,7322262295009),(32838,52609059549923),

70− (33003585202001564,2),(103019,68430142267402),(129918230800,8742978),

71− (0,2114347379589080688),(2548,905723041545274),(222745067962838382,0),

72− (1671683850790425181,1),(455,4836932776795684),(794227702827214,6620),

73− (212534135175874,1365),(96432431858,29784975),(466626763743380,3484),

74− (29793949,53041519613),(8359,309952753409844),(3908960585331901,26),

75− (45185288970365760,114),(10131829775,68110174),(58039242399640479,83),

76− (628092278238719399,6),(1,196469106875361889),(302336625,16347502444),

77− (148,3748088684181047),(1,1649096568849015456),(1019866864,2349753026),

78− (8211344830,569363306),(65647579546873,34753),(2340190,1692053129069),

79− (64263301,30758930355),(48681618072372209,110),(7074794736,47640197),

80− (249634721521,7991792),(1162917363807215,232),(7446433349,420634045),

81− (63398619383,60709817),(51359004508011,14200),(131788797028647,7072),

82− (52079887791430043,7),(7,136277667582599838),(28582879735696,50327),

83− (1404582800566278,833),(469164435,15017166943),(99567079957578263,49),

84− (1015285971,3625801566),(321504843,4104079293),(5196954,464515406632),

85− (114246832260876,7468),(8149664437,487119673),(12265299,378168974869),

86− (37711995764,30766513),(3971137243,710996152),(483120070302,603162),

87− (103009942,61645547145),(8476344625340,6987),(547948761229739,1446),

88− (42234,18624767306301),(13486714173011,58948),(4,198309153268019840),

89− (9913176974,325539248),(28246225540203,116822),(2882463945582154,18),

90− (959,25504987505398),(3,1504372236378217710),(13505229956793,374987),

91− (751661959,457611342),(27375926,36219151769),(482168869,5301952074),

92− (1,1577425863241520640),(714116235611821,1164),(904492524250310488,0),

93− (5983514941763398,68),(10759472423,23540686),(72539568471529,34919),

94− (4,176090672310337473),(938702842110356453,1),(673652445,3335287382),

95− (3111998893666122,917),(1568013,3168419765469)]

96−

97−testVector32 :: U.Vector (Int32,Int32)

98−testVector32 = U.fromList [

99− (39242,410),(0,100077553),(2206,9538),(509400240,1),(38048,6368),

100− (1789,651480),(2399,157032),(701,170017),(5241456,14),(11212,70449),

101− (1,227804876),(749687254,1),(74559,2954),(1158,147957),(410604456,1),

102− (170851,1561),(92643422,1),(6192,180509),(7,24202210),(3440,241481),

103− (5753677,5),(294327,1622),(252,4454673),(127684121,11),(28315800,30),

104− (340370905,0),(1,667887987),(592782090,1),(49023,27641),(750,290387),

105− (72886,3847),(0,301047933),(3050276,473),(1,788366142),(59457,15813),

106− (637726933,1),(1135,344317),(853616,264),(696816,493),(7038,12046),

107− (125219574,4),(803694088,1),(107081726,1),(39294,21699),(16361,38191),

108− (132561123,12),(1760,23499),(847543,484),(175687349,1),(2963,252678),

109− (6248,224553),(27596,4606),(5422922,121),(1542,485890),(131,583035),

110− (59096,4925),(3637115,132),(0,947225435),(86854,6794),(2984745,339),

111− (760129569,1),(1,68260595),(380835652,2),(430575,2579),(54514,7211),

112− (15550606,3),(9,27367402),(3007053,207),(7060988,60),(28560,27130),

113− (1355,21087),(10880,53059),(14563646,4),(461886361,1),(2,169260724),

114− (241454126,2),(406797,1),(61631630,16),(44473,5943),(63869104,12),

115− (950300,1528),(2113,62333),(120817,9358),(100261456,1),(426764723,1),

116− (119,12723684),(3,53358711),(4448071,18),(1,230278091),(238,232102),

117− (8,57316440),(42437979,10),(6769,19555),(48590,22006),(11500585,79),

118− (2808,97638),(42,26952545),(11,32104194),(23954638,1),(785427272,0),

119− (513,81379),(31333960,37),(897772,1009),(4,25679692),(103027993,12),

120− (104972702,11),(546,443401),(7,65137092),(88574269,3),(872139069,0),

121− (2,97417121),(378802603,0),(141071401,4),(22613,10575),(2191743,118),

122− (470,116119),(7062,38166),(231056,1847),(43901963,9),(2400,70640),

123− (63553,1555),(34,11249573),(815174,1820),(997894011,0),(98881794,2),

124− (5448,43132),(27956,9),(904926,1357),(112608626,3),(124,613021),

125− (282086,1966),(99,10656881),(113799,1501),(433318,2085),(442,948171),

126− (165380,1043),(28,14372905),(14880,50462),(2386,219918),(229,1797565),

127− (1174961,298),(3925,41833),(3903515,299),(15690452,111),(360860521,3),

128− (7440846,81),(2541026,507),(0,492448477),(6869,82469),(245,8322939),

129− (3503496,253),(123495298,0),(150963,2299),(33,4408482),(1,200911107),

130− (305,252121),(13,123369189),(215846,8181),(2440,65387),(776764401,1),

131− (1241172,434),(8,15493155),(81953961,6),(17884993,5),(26,6893822),

132− (0,502035190),(1,582451018),(2,514870139),(227,3625619),(49,12720258),

133− (1456769,207),(94797661,10),(234407,893),(26843,5783),(15688,24547),

134− (4091,86268),(4339448,151),(21360,6294),(397046497,2),(1227,205936),

135− (9966,21959),(160046791,1),(0,159992224),(27,24974797),(19177,29334),

136− (4136148,42),(21179785,53),(61256583,31),(385,344176),(7,11934915),

137− (1,18992566),(3488065,5),(768021,224),(36288474,7),(8624,117561),

138− (8,20341439),(5903,261475),(561,1007618),(1738,392327),(633049,1708)]

benchmarks/haskell/Benchmarks/Replace.hsdeleted−43

@@ -1,43 +0,0 @@

1−{-# LANGUAGE BangPatterns #-}

2−-- | Replace a string by another string

3−--

4−-- Tested in this benchmark:

5−--

6−-- * Search and replace of a pattern in a text

7−--

8−module Benchmarks.Replace

9− ( benchmark

10− ) where

11−

12−import Criterion (Benchmark, bgroup, bench, nf)

13−import qualified Data.ByteString.Char8 as B

14−import qualified Data.ByteString.Lazy as BL

15−import qualified Data.ByteString.Lazy.Search as BL

16−import qualified Data.ByteString.Search as B

17−import qualified Data.Text as T

18−import qualified Data.Text.Encoding as T

19−import qualified Data.Text.Lazy as TL

20−import qualified Data.Text.Lazy.Encoding as TL

21−import qualified Data.Text.Lazy.IO as TL

22−

23−benchmark :: FilePath -> String -> String -> IO Benchmark

24−benchmark fp pat sub = do

25− tl <- TL.readFile fp

26− bl <- BL.readFile fp

27− let !t = TL.toStrict tl

28− !b = T.encodeUtf8 t

29− return $ bgroup "Replace" [

30− bench "Text" $ nf (T.length . T.replace tpat tsub) t

31− , bench "ByteString" $ nf (BL.length . B.replace bpat bsub) b

32− , bench "LazyText" $ nf (TL.length . TL.replace tlpat tlsub) tl

33− , bench "LazyByteString" $ nf (BL.length . BL.replace blpat blsub) bl

34− ]

35− where

36− tpat = T.pack pat

37− tsub = T.pack sub

38− tlpat = TL.pack pat

39− tlsub = TL.pack sub

40− bpat = T.encodeUtf8 tpat

41− bsub = T.encodeUtf8 tsub

42− blpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tlpat

43− blsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tlsub

benchmarks/haskell/Multilang.hsdeleted−32

@@ -1,32 +0,0 @@

1−{-# LANGUAGE BangPatterns, OverloadedStrings, RankNTypes #-}

2−

3−module Main (

4− main

5− ) where

6−

7−import Control.Monad (forM_)

8−import qualified Data.ByteString as B

9−import qualified Data.Text as Text

10−import Data.Text.Encoding (decodeUtf8)

11−import Data.Text (Text)

12−import System.IO (hFlush, stdout)

13−import Timer (timer)

14−

15−type BM = Text -> ()

16−

17−bm :: forall a. (Text -> a) -> BM

18−bm f t = f t `seq` ()

19−

20−benchmarks :: [(String, Text.Text -> ())]

21−benchmarks = [

22− ("find_first", bm $ Text.isInfixOf "en:Benin")

23− , ("find_index", bm $ Text.findIndex (=='c'))

24− ]

25−

26−main :: IO ()

27−main = do

28− !contents <- decodeUtf8 `fmap` B.readFile "../tests/text-test-data/yiwiki.xml"

29− forM_ benchmarks $ \(name, bmark) -> do

30− putStr $ name ++ " "

31− hFlush stdout

32− putStrLn =<< (timer 100 contents bmark)

benchmarks/haskell/Timer.hsdeleted−30

@@ -1,30 +0,0 @@

1−{-# LANGUAGE BangPatterns #-}

2−

3−module Timer (timer) where

4−

5−import Control.Exception (evaluate)

6−import Data.Time.Clock.POSIX (getPOSIXTime)

7−import GHC.Float (FFFormat(..), formatRealFloat)

8−

9−ickyRound :: Int -> Double -> String

10−ickyRound k = formatRealFloat FFFixed (Just k)

11−

12−timer :: Int -> a -> (a -> b) -> IO String

13−timer count a0 f = do

14− let loop !k !fastest

15− | k <= 0 = return fastest

16− | otherwise = do

17− start <- getPOSIXTime

18− let inner a i

19− | i <= 0 = return ()

20− | otherwise = evaluate (f a) >> inner a (i-1)

21− inner a0 count

22− end <- getPOSIXTime

23− let elapsed = end - start

24− loop (k-1) (min fastest (elapsed / fromIntegral count))

25− t <- loop (3::Int) 1e300

26− let log10 x = log x / log 10

27− ft = realToFrac t

28− prec = round (log10 (fromIntegral count) - log10 ft)

29− return $! ickyRound prec ft

30−{-# NOINLINE timer #-}

benchmarks/python/multilang.pydeleted−50

@@ -1,50 +0,0 @@

1−#!/usr/bin/env python

2−

3−import math

4−import sys

5−import time

6−

7−def find_first():

8− cf = contents.find

9− return timer(lambda: cf("en:Benin"))

10−

11−def timer(f, count=100):

12− a = 1e300

13− def g():

14− return

15− for i in xrange(3):

16− start = time.time()

17− for j in xrange(count):

18− g()

19− a = min(a, (time.time() - start) / count)

20−

21− b = 1e300

22− for i in xrange(3):

23− start = time.time()

24− for j in xrange(count):

25− f()

26− b = min(b, (time.time() - start) / count)

27−

28− return round(b - a, int(round(math.log(count, 10) - math.log(b - a, 10))))

29−

30−contents = open('../../tests/text-test-data/yiwiki.xml', 'r').read()

31−contents = contents.decode('utf-8')

32−

33−benchmarks = (

34− find_first,

35− )

36−

37−to_run = sys.argv[1:]

38−bms = []

39−if to_run:

40− for r in to_run:

41− for b in benchmarks:

42− if b.__name__.startswith(r):

43− bms.append(b)

44−else:

45− bms = benchmarks

46−

47−for b in bms:

48− sys.stdout.write(b.__name__ + ' ')

49− sys.stdout.flush()

50− print b()

benchmarks/text-benchmarks.cabaldeleted−66

@@ -1,66 +0,0 @@

1−name: text-benchmarks

2−version: 0.0.0.0

3−synopsis: Benchmarks for the text package

4−description: Benchmarks for the text package

5−homepage: https://bitbucket.org/bos/text

6−license: BSD2

7−license-file: ../LICENSE

8−author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

9− Bryan O'Sullivan <bos@serpentine.com>,

10− Tom Harper <rtomharper@googlemail.com>,

11− Duncan Coutts <duncan@haskell.org>

12−maintainer: jaspervdj@gmail.com

13−category: Text

14−build-type: Simple

15−

16−cabal-version: >=1.2

17−

18−flag bytestring-builder

19− description: Depend on the bytestring-builder package for backwards compatibility.

20− default: False

21− manual: False

22−

23−flag llvm

24− description: use LLVM

25− default: False

26− manual: True

27−

28−executable text-benchmarks

29− hs-source-dirs: haskell ..

30− c-sources: ../cbits/cbits.c

31− cbits/time_iconv.c

32− include-dirs: ../include

33− main-is: Benchmarks.hs

34− ghc-options: -Wall -O2 -rtsopts

35− if flag(llvm)

36− ghc-options: -fllvm

37− cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP

38− build-depends: base == 4.*,

39− binary,

40− blaze-builder,

41− bytestring-lexing >= 0.5.0,

42− containers,

43− criterion >= 0.10.0.0,

44− deepseq,

45− directory,

46− filepath,

47− ghc-prim,

48− integer-gmp,

49− stringsearch,

50− utf8-string,

51− vector

52−

53− if flag(bytestring-builder)

54− build-depends: bytestring >= 0.9 && < 0.10.4,

55− bytestring-builder >= 0.10.4

56− else

57− build-depends: bytestring >= 0.10.4

58−

59−executable text-multilang

60− hs-source-dirs: haskell

61− main-is: Multilang.hs

62− ghc-options: -Wall -O2

63− build-depends: base == 4.*,

64− bytestring,

65− text,

66− time

cbits/cbits.c+14−192

@@ -9,7 +9,6 @@

99#include <string.h>

1010#include <stdint.h>

1111#include <stdio.h>

12−#include "text_cbits.h"

1312

1413void _hs_text_memcpy(void *dest, size_t doff, const void *src, size_t soff,

1514 size_t n)

@@ -48,7 +47,7 @@ static const uint8_t utf8d[] = {

4847 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,

4948 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,

5049 12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,

51− 12,36,12,12,12,12,12,12,12,12,12,12,

50+ 12,36,12,12,12,12,12,12,12,12,12,12,

5251};

5352

5453static inline uint32_t

@@ -62,90 +61,24 @@ decode(uint32_t *state, uint32_t* codep, uint32_t byte) {

6261 return *state = utf8d[256 + *state + type];

6362}

6463

65−/*

66− * The ISO 8859-1 (aka latin-1) code points correspond exactly to the first 256 unicode

67− * code-points, therefore we can trivially convert from a latin-1 encoded bytestring to

68− * an UTF16 array

69− */

70−void

71−_hs_text_decode_latin1(uint16_t *dest, const uint8_t *src,

72− const uint8_t *srcend)

73−{

74− const uint8_t *p = src;

75−

76−#if defined(__i386__) || defined(__x86_64__)

77− /* This optimization works on a little-endian systems by using

78− (aligned) 32-bit loads instead of 8-bit loads

79− */

80−

81− /* consume unaligned prefix */

82− while (p != srcend && (uintptr_t)p & 0x3)

83− *dest++ = *p++;

84−

85− /* iterate over 32-bit aligned loads */

86− while (p < srcend - 3) {

87− const uint32_t w = *((const uint32_t *)p);

88−

89− *dest++ = w & 0xff;

90− *dest++ = (w >> 8) & 0xff;

91− *dest++ = (w >> 16) & 0xff;

92− *dest++ = (w >> 24) & 0xff;

93−

94− p += 4;

95− }

96−#endif

97−

98− /* handle unaligned suffix */

99− while (p != srcend)

100− *dest++ = *p++;

101−}

102−

10364/*

10465 * A best-effort decoder. Runs until it hits either end of input or

10566 * the start of an invalid byte sequence.

10667 *

107− * At exit, we update *destoff with the next offset to write to, *src

108− * with the next source location past the last one successfully

109− * decoded, and return the next source location to read from.

110− *

111− * Moreover, we expose the internal decoder state (state0 and

112− * codepoint0), allowing one to restart the decoder after it

113− * terminates (say, due to a partial codepoint).

114− *

115− * In particular, there are a few possible outcomes,

116− *

117− * 1) We decoded the buffer entirely:

118− * In this case we return srcend

119− * state0 == UTF8_ACCEPT

120− *

121− * 2) We met an invalid encoding

122− * In this case we return the address of the first invalid byte

123− * state0 == UTF8_REJECT

124− *

125− * 3) We reached the end of the buffer while decoding a codepoint

126− * In this case we return a pointer to the first byte of the partial codepoint

127− * state0 != UTF8_ACCEPT, UTF8_REJECT

128− *

68+ * At exit, updates *destoff with the next offset to write to, and

69+ * returns the next source offset to read from.

12970 */

130−#if defined(__GNUC__) || defined(__clang__)

131−static inline uint8_t const *

132−_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,

133− const uint8_t **src, const uint8_t *srcend,

134− uint32_t *codepoint0, uint32_t *state0)

135− __attribute((always_inline));

136−#endif

137−

138−static inline uint8_t const *

139−_hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,

140− const uint8_t **src, const uint8_t *srcend,

141− uint32_t *codepoint0, uint32_t *state0)

71+uint8_t const *

72+_hs_text_decode_utf8(uint16_t *dest, size_t *destoff,

73+ const uint8_t const *src, const uint8_t const *srcend)

14274{

14375 uint16_t *d = dest + *destoff;

144− const uint8_t *s = *src, *last = *src;

145− uint32_t state = *state0;

146− uint32_t codepoint = *codepoint0;

76+ const uint8_t const *s = src;

77+ uint32_t state = UTF8_ACCEPT;

14778

14879 while (s < srcend) {

80+ uint32_t codepoint;

81+

14982#if defined(__i386__) || defined(__x86_64__)

15083 /*

15184 * This code will only work on a little-endian system that

@@ -173,7 +106,6 @@ _hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,

173106 *d++ = (uint16_t) ((codepoint >> 16) & 0xff);

174107 *d++ = (uint16_t) ((codepoint >> 24) & 0xff);

175108 }

176− last = s;

177109 }

178110#endif

179111

@@ -189,123 +121,13 @@ _hs_text_decode_utf8_int(uint16_t *const dest, size_t *destoff,

189121 *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10));

190122 *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF));

191123 }

192− last = s;

193124 }

194125

195− *destoff = d - dest;

196− *codepoint0 = codepoint;

197− *state0 = state;

198− *src = last;

199−

200− return s;

201−}

202−

203−uint8_t const *

204−_hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,

205− const uint8_t **src,

206− const uint8_t *srcend,

207− uint32_t *codepoint0, uint32_t *state0)

208−{

209− uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,

210− codepoint0, state0);

211− if (*state0 == UTF8_REJECT)

212− ret -=1;

213− return ret;

214−}

215−

216−/*

217− * Helper to decode buffer and discard final decoder state

218− */

219−const uint8_t *

220−_hs_text_decode_utf8(uint16_t *const dest, size_t *destoff,

221− const uint8_t *src, const uint8_t *const srcend)

222−{

223− uint32_t codepoint;

224− uint32_t state = UTF8_ACCEPT;

225− uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, &src, srcend,

226− &codepoint, &state);

227− /* Back up if we have an incomplete or invalid encoding */

126+ /* Error recovery - if we're not in a valid finishing state, back up. */

228127 if (state != UTF8_ACCEPT)

229− ret -= 1;

230− return ret;

231−}

232−

233−void

234−_hs_text_encode_utf8(uint8_t **destp, const uint16_t *src, size_t srcoff,

235− size_t srclen)

236−{

237− const uint16_t *srcend;

238− uint8_t *dest = *destp;

239−

240− src += srcoff;

241− srcend = src + srclen;

128+ s -= 1;

242129

243− ascii:

244−#if defined(__x86_64__)

245− while (srcend - src >= 4) {

246− uint64_t w = *((uint64_t *) src);

247−

248− if (w & 0xFF80FF80FF80FF80ULL) {

249− if (!(w & 0x000000000000FF80ULL)) {

250− *dest++ = w & 0xFFFF;

251− src++;

252− if (!(w & 0x00000000FF800000ULL)) {

253− *dest++ = (w >> 16) & 0xFFFF;

254− src++;

255− if (!(w & 0x0000FF8000000000ULL)) {

256− *dest++ = (w >> 32) & 0xFFFF;

257− src++;

258− }

259− }

260− }

261− break;

262− }

263− *dest++ = w & 0xFFFF;

264− *dest++ = (w >> 16) & 0xFFFF;

265− *dest++ = (w >> 32) & 0xFFFF;

266− *dest++ = w >> 48;

267− src += 4;

268− }

269−#endif

270−

271−#if defined(__i386__)

272− while (srcend - src >= 2) {

273− uint32_t w = *((uint32_t *) src);

274−

275− if (w & 0xFF80FF80)

276− break;

277− *dest++ = w & 0xFFFF;

278− *dest++ = w >> 16;

279− src += 2;

280− }

281−#endif

282−

283− while (src < srcend) {

284− uint16_t w = *src++;

285−

286− if (w <= 0x7F) {

287− *dest++ = w;

288− /* An ASCII byte is likely to begin a run of ASCII bytes.

289− Falling back into the fast path really helps performance. */

290− goto ascii;

291− }

292− else if (w <= 0x7FF) {

293− *dest++ = (w >> 6) | 0xC0;

294− *dest++ = (w & 0x3f) | 0x80;

295− }

296− else if (w < 0xD800 || w > 0xDBFF) {

297− *dest++ = (w >> 12) | 0xE0;

298− *dest++ = ((w >> 6) & 0x3F) | 0x80;

299− *dest++ = (w & 0x3F) | 0x80;

300− } else {

301− uint32_t c = ((((uint32_t) w) - 0xD800) << 10) +

302− (((uint32_t) *src++) - 0xDC00) + 0x10000;

303− *dest++ = (c >> 18) | 0xF0;

304− *dest++ = ((c >> 12) & 0x3F) | 0x80;

305− *dest++ = ((c >> 6) & 0x3F) | 0x80;

306− *dest++ = (c & 0x3F) | 0x80;

307− }

308− }

130+ *destoff = d - dest;

309131

310− *destp = dest;

132+ return s;

311133}

changelog.mddeleted−164

@@ -1,164 +0,0 @@

1−1.2.2.1

2−

3−* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.

4− The build flag has been renamed accordingly. Your army of diligent

5− maintainers apologizes for the churn.

6−

7−* Spec compliance: toCaseFold now follows the Unicode 8.0 spec

8− (updated from 7.0)

9−

10−* An STG lint error has been fixed

11−

12−1.2.2.0

13−

14−* The `integer-simple` package, upon which this package optionally

15− depended, has been replaced with `integer-pure`. The build flag has

16− been renamed accordingly.

17−

18−* Bug fix: For the `Binary` instance, If UTF-8 decoding fails during a

19− `get`, the error is propagated via `fail` instead of an uncatchable

20− crash.

21−

22−* New function: `takeWhileEnd`

23−

24−* New instances for the `Text` types:

25− * if `base` >= 4.7: `PrintfArg`

26− * if `base` >= 4.9: `Semigroup`

27−

28−1.2.1.3

29−

30−* Bug fix: As it turns out, moving the literal rewrite rules to simplifier

31− phase 2 does not prevent competition with the `unpack` rule, which is

32− also active in this phase. Unfortunately this was hidden due to a silly

33− test environment mistake. Moving literal rules back to phase 1 finally

34− fixes GHC Trac #10528 correctly.

35−

36−1.2.1.2

37−

38−* Bug fix: Run literal rewrite rules in simplifier phase 2.

39− The behavior of the simplifier changed in GHC 7.10.2,

40− causing these rules to fail to fire, leading to poor code generation

41− and long compilation times. See

42− [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528).

43−

44−1.2.1.1

45−

46−* Expose unpackCString#, which you should never use.

47−

48−1.2.1.0

49−

50−* Added Binary instances for both Text types. (If you have previously

51− been using the text-binary package to get a Binary instance, it is

52− now obsolete.)

53−

54−1.2.0.6

55−

56−* Fixed a space leak in UTF-8 decoding

57−

58−1.2.0.5

59−

60−* Feature parity: repeat, cycle, iterate are now implemented for lazy

61− Text, and the Data instance is more complete

62−

63−* Build speed: an inliner space explosion has been fixed with toCaseFold

64−

65−* Bug fix: encoding Int to a Builder would infinite-loop if the

66− integer-simple package was used

67−

68−* Deprecation: OnEncodeError and EncodeError are deprecated, as they

69− are never used

70−

71−* Internals: some types that are used internally in fusion-related

72− functions have moved around, been renamed, or been deleted (we don't

73− bump the major version if .Internal modules change)

74−

75−* Spec compliance: toCaseFold now follows the Unicode 7.0 spec

76− (updated from 6.3)

77−

78−1.2.0.4

79−

80−* Fixed an incompatibility with base < 4.5

81−

82−1.2.0.3

83−

84−* Update formatRealFloat to correspond to the definition in versions

85− of base newer than 4.5 (https://github.com/bos/text/issues/105)

86−

87−1.2.0.2

88−

89−* Bumped lower bound on deepseq to 1.4 for compatibility with the

90− upcoming GHC 7.10

91−

92−1.2.0.1

93−

94−* Fixed a buffer overflow in rendering of large Integers

95− (https://github.com/bos/text/issues/99)

96−

97−1.2.0.0

98−

99−* Fixed an integer overflow in the replace function

100− (https://github.com/bos/text/issues/81)

101−

102−* Fixed a hang in lazy decodeUtf8With

103− (https://github.com/bos/text/issues/87)

104−

105−* Reduced codegen bloat caused by use of empty and single-character

106− literals

107−

108−* Added an instance of IsList for GHC 7.8 and above

109−

110−1.1.1.0

111−

112−* The Data.Data instance now allows gunfold to work, via a virtual

113− pack constructor

114−

115−* dropEnd, takeEnd: new functions

116−

117−* Comparing the length of a Text against a number can now

118− short-circuit in more cases

119−

120−1.1.0.1

121−

122−* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes

123− in single-byte chunks

124−

125−1.1.0.0

126−

127−* encodeUtf8: Performance is improved by up to 4x.

128−

129−* encodeUtf8Builder, encodeUtf8BuilderEscaped: new functions,

130− available only if bytestring >= 0.10.4.0 is installed, that allow

131− very fast and flexible encoding of a Text value to a bytestring

132− Builder.

133−

134− As an example of the performance gain to be had, the

135− encodeUtf8BuilderEscaped function helps to double the speed of JSON

136− encoding in the latest version of aeson! (Note: if all you need is a

137− plain ByteString, encodeUtf8 is still the faster way to go.)

138−

139−* All of the internal module hierarchy is now publicly exposed. If a

140− module is in the .Internal hierarchy, or is documented as internal,

141− use at your own risk - there are no API stability guarantees for

142− internal modules!

143−

144−1.0.0.1

145−

146−* decodeUtf8: Fixed a regression that caused us to incorrectly

147− identify truncated UTF-8 as valid (gh-61)

148−

149−1.0.0.0

150−

151−* Added support for Unicode 6.3.0 to case conversion functions

152−

153−* New function toTitle converts words in a string to title case

154−

155−* New functions peekCStringLen and withCStringLen simplify

156− interoperability with C functionns

157−

158−* Added support for decoding UTF-8 in stream-friendly fashion

159−

160−* Fixed a bug in mapAccumL

161−

162−* Added trusted Haskell support

163−

164−* Removed support for GHC 6.10 (released in 2008) and older

include/text_cbits.hdeleted−11

@@ -1,11 +0,0 @@

1−/*

3− */

4−

5−#ifndef _text_cbits_h

6−#define _text_cbits_h

7−

8−#define UTF8_ACCEPT 0

9−#define UTF8_REJECT 12

10−

11−#endif

scripts/Arsec.hs+9−4

@@ -1,7 +1,6 @@

11module Arsec

22 (

3− Comment

4− , comment

3+ comment

54 , semi

65 , showC

76 , unichar

@@ -24,7 +23,13 @@ import Text.ParserCombinators.Parsec.Combinator hiding (optional)

2423import Text.ParserCombinators.Parsec.Error

2524import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many)

2625

27−type Comment = String

26+instance Applicative (GenParser s a) where

27+ pure = return

28+ (<*>) = ap

29+

30+instance Alternative (GenParser s a) where

31+ empty = mzero

32+ (<|>) = mplus

2833

2934unichar :: Parser Char

3035unichar = chr . fst . head . readHex <$> many1 hexDigit

@@ -35,7 +40,7 @@ unichars = manyTill (unichar <* spaces) semi

3540semi :: Parser ()

3641semi = char ';' *> spaces *> pure ()

3742

38−comment :: Parser Comment

43+comment :: Parser String

3944comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"

4045

4146showC :: Char -> String

scripts/CaseFolding.hs+7−11

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

55module CaseFolding

66 (

7− CaseFolding(..)

8− , Fold(..)

7+ Fold(..)

98 , parseCF

109 , mapCF

1110 ) where

@@ -19,25 +18,22 @@ data Fold = Fold {

1918 , name :: String

2019 } deriving (Eq, Ord, Show)

2120

22−data CaseFolding = CF { cfComments :: [Comment], cfFolding :: [Fold] }

23− deriving (Show)

24−

25−entries :: Parser CaseFolding

26−entries = CF <$> many comment <*> many (entry <* many comment)

21+entries :: Parser [Fold]

22+entries = many comment *> many (entry <* many comment)

2723 where

2824 entry = Fold <$> unichar <* semi

2925 <*> oneOf "CFST" <* semi

3026 <*> unichars

3127 <*> (string "# " *> manyTill anyToken (char '\n'))

3228

33−parseCF :: FilePath -> IO (Either ParseError CaseFolding)

29+parseCF :: FilePath -> IO (Either ParseError [Fold])

3430parseCF name = parse entries name <$> readFile name

3531

36−mapCF :: CaseFolding -> [String]

37−mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]

32+mapCF :: [Fold] -> [String]

33+mapCF ms = typ ++ (map nice . filter p $ ms) ++ [last]

3834 where

3935 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"

40− ,"{-# NOINLINE foldMapping #-}"]

36+ ,"{-# INLINE foldMapping #-}"]

4137 last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"

4238 nice c = "-- " ++ name c ++ "\n" ++

4339 "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"

scripts/CaseMapping.hs+5−11

@@ -8,7 +8,7 @@ import SpecialCasing

88main = do

99 args <- getArgs

1010 let oname = case args of

11− [] -> "../Data/Text/Internal/Fusion/CaseMapping.hs"

11+ [] -> "../Data/Text/Fusion/CaseMapping.hs"

1212 [o] -> o

1313 psc <- parseSC "SpecialCasing.txt"

1414 pcf <- parseCF "CaseFolding.txt"

@@ -19,20 +19,14 @@ main = do

1919 Left err -> print err >> return undefined

2020 Right ms -> return ms

2121 h <- openFile oname WriteMode

22− let comments = map ("--" ++) $

23− take 2 (cfComments cfs) ++ take 2 (scComments scs)

24− mapM_ (hPutStrLn h) $

25− ["{-# LANGUAGE Rank2Types #-}"

22+ mapM_ (hPutStrLn h) ["{-# LANGUAGE Rank2Types #-}"

2623 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"

27− ,"-- Generated by scripts/CaseMapping.hs"] ++

28− comments ++

29− [""

30− ,"module Data.Text.Internal.Fusion.CaseMapping where"

24+ ,"-- Generated by scripts/SpecialCasing.hs"

25+ ,"module Data.Text.Fusion.CaseMapping where"

3126 ,"import Data.Char"

32− ,"import Data.Text.Internal.Fusion.Types"

27+ ,"import Data.Text.Fusion.Internal"

3328 ,""]

3429 mapM_ (hPutStrLn h) (mapSC "upper" upper toUpper scs)

3530 mapM_ (hPutStrLn h) (mapSC "lower" lower toLower scs)

36− mapM_ (hPutStrLn h) (mapSC "title" title toTitle scs)

3731 mapM_ (hPutStrLn h) (mapCF cfs)

3832 hClose h

scripts/SpecialCasing.hs+7−13

@@ -4,17 +4,13 @@

55module SpecialCasing

66 (

7− SpecialCasing(..)

8− , Case(..)

7+ Case(..)

98 , parseSC

109 , mapSC

1110 ) where

1211

1312import Arsec

1413

15−data SpecialCasing = SC { scComments :: [Comment], scCasing :: [Case] }

16− deriving (Show)

17−

1814data Case = Case {

1915 code :: Char

2016 , lower :: [Char]

@@ -24,8 +20,8 @@ data Case = Case {

2420 , name :: String

2521 } deriving (Eq, Ord, Show)

2622

27−entries :: Parser SpecialCasing

28−entries = SC <$> many comment <*> many (entry <* many comment)

23+entries :: Parser [Case]

24+entries = many comment *> many (entry <* many comment)

2925 where

3026 entry = Case <$> unichar <* semi

3127 <*> unichars

@@ -34,16 +30,14 @@ entries = SC <$> many comment <*> many (entry <* many comment)

3430 <*> manyTill anyToken (string "# ")

3531 <*> manyTill anyToken (char '\n')

3632

37−parseSC :: FilePath -> IO (Either ParseError SpecialCasing)

33+parseSC :: FilePath -> IO (Either ParseError [Case])

3834parseSC name = parse entries name <$> readFile name

3935

40−mapSC :: String -> (Case -> String) -> (Char -> Char) -> SpecialCasing

41− -> [String]

42−mapSC which access twiddle (SC _ ms) =

43− typ ++ (map nice . filter p $ ms) ++ [last]

36+mapSC :: String -> (Case -> String) -> (Char -> Char) -> [Case] -> [String]

37+mapSC which access twiddle ms = typ ++ (map nice . filter p $ ms) ++ [last]

4438 where

4539 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"

46− ,"{-# NOINLINE " ++ which ++ "Mapping #-}"]

40+ ,"{-# INLINE " ++ which ++ "Mapping #-}"]

4741 last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (CC s '\\0' '\\0')"

4842 nice c = "-- " ++ name c ++ "\n" ++

4943 which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"

tests-and-benchmarks.markdowndeleted−63

@@ -1,63 +0,0 @@

1−Tests and benchmarks

2−====================

3−

4−Prerequisites

5−-------------

6−

7−To run the tests and benchmarks, you will need the test data, which

8−you can clone from one of the following locations:

9−

10−* Mercurial master repository:

11− [bitbucket.org/bos/text-test-data](https://bitbucket.org/bos/text-test-data)

12−

13−* Git mirror repository:

14− [github.com/bos/text-test-data](https://github.com/bos/text-test-data)

15−

16−You should clone that repository into the `tests` subdirectory (your

17−clone must be named `text-test-data` locally), then run `make -C

18−tests/text-test-data` to uncompress the test files. Many tests and

19−benchmarks will fail if the test files are missing.

20−

21−Functional tests

22−----------------

23−

24−The functional tests are located in the `tests` subdirectory. An overview of

25−what's in that directory:

26−

27− Makefile Has targets for common tasks

28− Tests Source files of the testing code

29− scripts Various utility scripts

30− text-tests.cabal Cabal file that compiles all benchmarks

31−

32−The `text-tests.cabal` builds:

33−

34−- A copy of the text library, sharing the source code, but exposing all internal

35− modules, for testing purposes

36−- The different test suites

37−

38−To compile, run all tests, and generate a coverage report, simply use `make`.

39−

40−Benchmarks

41−----------

42−

43−The benchmarks are located in the `benchmarks` subdirectory. An overview of

44−what's in that directory:

45−

46− Makefile Has targets for common tasks

47− haskell Source files of the haskell benchmarks

48− python Python implementations of some benchmarks

49− ruby Ruby implementations of some benchmarks

50− text-benchmarks.cabal Cabal file which compiles all benchmarks

51−

52−To compile the benchmarks, navigate to the `benchmarks` subdirectory and run

53−`cabal configure && cabal build`. Then, you can run the benchmarks using:

54−

55− ./dist/build/text-benchmarks/text-benchmarks

56−

57−However, since there's quite a lot of benchmarks, you usually don't want to

58−run them all. Instead, use the `-l` flag to get a list of benchmarks:

59−

60− ./dist/build/text-benchmarks/text-benchmarks

61−

62−And run the ones you want to inspect. If you want to configure the benchmarks

63−further, the exact parameters can be changed in `Benchmarks.hs`.

tests/LiteralRuleTest.hsdeleted−21

@@ -1,21 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−module LiteralRuleTest where

4−

5−import Data.Text (Text)

6−

7−-- This should produce 8 firings of the "TEXT literal" rule

8−strings :: [Text]

9−strings = [ "abstime", "aclitem", "bit", "bool", "box", "bpchar", "bytea", "char" ]

10−

11−-- This should produce 7 firings of the "TEXT literal UTF8" rule

12−utf8Strings :: [Text]

13−utf8Strings = [ "\0abstime", "\0aclitem", "\xfefe bit", "\0bool", "\0box", "\0bpchar", "\0bytea" ]

14−

15−-- This should produce 4 firings of the "TEXT empty literal" rule

16−empties :: [Text]

17−empties = [ "", "", "", "" ]

18−

19−-- This should produce 5 firings of the "TEXT empty literal" rule

20−--singletons :: [Text]

21−--singletons = [ "a", "b", "c", "d", "e" ]

tests/README.markdownnew file+63

@@ -0,0 +1,63 @@

1+Tests

2+=====

4+This directory contains the tests for the Text library. To run these

5+tests, you will need the test data from one of the following

6+locations:

8+* Mercurial master repository:

9+ [bitbucket.org/bos/text-test-data](https://bitbucket.org/bos/text-test-data)

10+

11+* Git mirror repository:

12+ [github.com/bos/text-test-data](https://github.com/bos/text-test-data)

13+

14+You should clone that repository to the same directory as this `README`

15+file, then run `make` to uncompress the test files. Many tests will

16+fail if the test files are missing.

17+

18+There are two categories of tests: functional tests (including QuickCheck

19+properties), and benchmarks.

20+

21+Functional tests

22+----------------

23+

24+The functional tests are located in the `tests` subdirectory. An overview of

25+what's in that directory:

26+

27+ scripts Various utility scripts

28+ src Source files of the testing code

29+ text-tests.cabal Cabal file which compiles all benchmarks

30+ Makefile Has targets for common tasks

31+

32+The `text-tests.cabal` builds:

33+

34+- A copy of the text library, sharing the source code, but exposing all internal

35+ modules, for testing purposes

36+- The different test suites

37+

38+To compile, run all tests, and generate a coverage report, simply use `make`.

39+

40+Benchmarks

41+----------

42+

43+The benchmarks are located in the `benchmarks` subdirectory. An overview of

44+what's in that directory:

45+

46+ python Python implementations of some benchmarks

47+ ruby Ruby implementations of some benchmarks

48+ src Source files of the haskell benchmarks

49+ benchmarks.cabal Cabal file which compiles all benchmarks

50+ Makefile Has targets for common tasks

51+

52+To compile the benchmarks, navigate to the `benchmarks` subdirectory and run

53+`cabal configure && cabal build`. Then, you can run the benchmarks using:

54+

55+ ./dist/build/benchmarks/benchmarks

56+

57+However, since there quite a lot of benchmarks, you usually don't want to run

58+them all. Instead, use the `-l` flag to get a list of benchmarks:

59+

60+ ./dist/build/benchmarks/benchmarks

61+

62+And run the ones you want to inspect. If you want to configure the benchmarks

63+further, the exact parameters can be changed in `src/Data/Text/Benchmarks.hs`.

tests/Tests/Properties/Mul.hsdeleted−40

@@ -1,40 +0,0 @@

1−{-# LANGUAGE ScopedTypeVariables #-}

2−

3−module Tests.Properties.Mul (tests) where

4−

5−import Control.Applicative ((<$>), pure)

6−import Control.Exception as E (SomeException, catch, evaluate)

7−import Data.Int (Int32, Int64)

8−import Data.Text.Internal (mul, mul32, mul64)

9−import System.IO.Unsafe (unsafePerformIO)

10−import Test.Framework (Test)

11−import Test.Framework.Providers.QuickCheck2 (testProperty)

12−import Test.QuickCheck hiding ((.&.))

13−

14−mulRef :: (Integral a, Bounded a) => a -> a -> Maybe a

15−mulRef a b

16− | ab < bot || ab > top = Nothing

17− | otherwise = Just (fromIntegral ab)

18− where ab = fromIntegral a * fromIntegral b

19− top = fromIntegral (maxBound `asTypeOf` a) :: Integer

20− bot = fromIntegral (minBound `asTypeOf` a) :: Integer

21−

22−eval :: (a -> b -> c) -> a -> b -> Maybe c

23−eval f a b = unsafePerformIO $

24− (Just <$> evaluate (f a b)) `E.catch` (\(_::SomeException) -> pure Nothing)

25−

26−t_mul32 :: Int32 -> Int32 -> Property

27−t_mul32 a b = mulRef a b === eval mul32 a b

28−

29−t_mul64 :: Int64 -> Int64 -> Property

30−t_mul64 a b = mulRef a b === eval mul64 a b

31−

32−t_mul :: Int -> Int -> Property

33−t_mul a b = mulRef a b === eval mul a b

34−

35−tests :: [Test]

36−tests = [

37− testProperty "t_mul" t_mul

38− , testProperty "t_mul32" t_mul32

39− , testProperty "t_mul64" t_mul64

40− ]

benchmarks/.gitignore → tests/benchmarks/.gitignorerenamed

The content is the same.

benchmarks/Setup.hs → tests/benchmarks/Setup.hsrenamed

The content is the same.

benchmarks/cbits/time_iconv.c → tests/benchmarks/cbits/time_iconv.crenamed

The content is the same.

benchmarks/python/.gitignore → tests/benchmarks/python/.gitignorerenamed

The content is the same.

benchmarks/python/cut.py → tests/benchmarks/python/cut.pyrenamed

The content is the same.

benchmarks/python/sort.py → tests/benchmarks/python/sort.pyrenamed

The content is the same.

benchmarks/python/strip_tags.py → tests/benchmarks/python/strip_tags.pyrenamed

The content is the same.

benchmarks/python/utils.py → tests/benchmarks/python/utils.pyrenamed

The content is the same.

benchmarks/ruby/cut.rb → tests/benchmarks/ruby/cut.rbrenamed

The content is the same.

benchmarks/ruby/fold.rb → tests/benchmarks/ruby/fold.rbrenamed

The content is the same.

benchmarks/ruby/sort.rb → tests/benchmarks/ruby/sort.rbrenamed

The content is the same.

benchmarks/ruby/strip_tags.rb → tests/benchmarks/ruby/strip_tags.rbrenamed

The content is the same.

benchmarks/ruby/utils.rb → tests/benchmarks/ruby/utils.rbrenamed

The content is the same.

benchmarks/haskell/Benchmarks.hs → tests/benchmarks/src/Data/Text/Benchmarks.hsrenamed+20−26

@@ -9,26 +9,25 @@ import Criterion.Main (Benchmark, defaultMain, bgroup)

99import System.FilePath ((</>))

1010import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)

1111

12−import qualified Benchmarks.Builder as Builder

13−import qualified Benchmarks.DecodeUtf8 as DecodeUtf8

14−import qualified Benchmarks.EncodeUtf8 as EncodeUtf8

15−import qualified Benchmarks.Equality as Equality

16−import qualified Benchmarks.FileRead as FileRead

17−import qualified Benchmarks.FoldLines as FoldLines

18−import qualified Benchmarks.Mul as Mul

19−import qualified Benchmarks.Pure as Pure

20−import qualified Benchmarks.ReadNumbers as ReadNumbers

21−import qualified Benchmarks.Replace as Replace

22−import qualified Benchmarks.Search as Search

23−import qualified Benchmarks.Stream as Stream

24−import qualified Benchmarks.WordFrequencies as WordFrequencies

12+import qualified Data.Text.Benchmarks.Builder as Builder

13+import qualified Data.Text.Benchmarks.DecodeUtf8 as DecodeUtf8

14+import qualified Data.Text.Benchmarks.EncodeUtf8 as EncodeUtf8

15+import qualified Data.Text.Benchmarks.Equality as Equality

16+import qualified Data.Text.Benchmarks.FileRead as FileRead

17+import qualified Data.Text.Benchmarks.FoldLines as FoldLines

18+import qualified Data.Text.Benchmarks.Pure as Pure

19+import qualified Data.Text.Benchmarks.ReadNumbers as ReadNumbers

20+import qualified Data.Text.Benchmarks.Replace as Replace

21+import qualified Data.Text.Benchmarks.Search as Search

22+import qualified Data.Text.Benchmarks.Stream as Stream

23+import qualified Data.Text.Benchmarks.WordFrequencies as WordFrequencies

2524

26−import qualified Benchmarks.Programs.BigTable as Programs.BigTable

27−import qualified Benchmarks.Programs.Cut as Programs.Cut

28−import qualified Benchmarks.Programs.Fold as Programs.Fold

29−import qualified Benchmarks.Programs.Sort as Programs.Sort

30−import qualified Benchmarks.Programs.StripTags as Programs.StripTags

31−import qualified Benchmarks.Programs.Throughput as Programs.Throughput

25+import qualified Data.Text.Benchmarks.Programs.BigTable as Programs.BigTable

26+import qualified Data.Text.Benchmarks.Programs.Cut as Programs.Cut

27+import qualified Data.Text.Benchmarks.Programs.Fold as Programs.Fold

28+import qualified Data.Text.Benchmarks.Programs.Sort as Programs.Sort

29+import qualified Data.Text.Benchmarks.Programs.StripTags as Programs.StripTags

30+import qualified Data.Text.Benchmarks.Programs.Throughput as Programs.Throughput

3231

3332main :: IO ()

3433main = benchmarks >>= defaultMain

@@ -50,12 +49,7 @@ benchmarks = do

5049 , Equality.benchmark (tf "japanese.txt")

5150 , FileRead.benchmark (tf "russian.txt")

5251 , FoldLines.benchmark (tf "russian.txt")

53− , Mul.benchmark

54− , Pure.benchmark "tiny" (tf "tiny.txt")

55− , Pure.benchmark "ascii" (tf "ascii-small.txt")

56− -- , Pure.benchmark "france" (tf "france.html")

57− , Pure.benchmark "russian" (tf "russian-small.txt")

58− , Pure.benchmark "japanese" (tf "japanese.txt")

52+ , Pure.benchmark (tf "japanese.txt")

5953 , ReadNumbers.benchmark (tf "numbers.txt")

6054 , Replace.benchmark (tf "russian.txt") "принимая" "своем"

6155 , Search.benchmark (tf "russian.txt") "принимая"

@@ -76,4 +70,4 @@ benchmarks = do

7670 return $ bs ++ [ps]

7771 where

7872 -- Location of a test file

79− tf = ("../tests/text-test-data" </>)

73+ tf = ("../text-test-data" </>)

tests/benchmarks/src/Data/Text/Benchmarks/Builder.hsnew file+48

@@ -0,0 +1,48 @@

1+-- | Testing the internal builder monoid

2+--

3+-- Tested in this benchmark:

4+--

5+-- * Concatenating many small strings using a builder

6+--

7+{-# LANGUAGE OverloadedStrings #-}

8+module Data.Text.Benchmarks.Builder

9+ ( benchmark

10+ ) where

11+

12+import Criterion (Benchmark, bgroup, bench, nf)

13+import Data.Binary.Builder as B

14+import Data.ByteString.Char8 ()

15+import Data.Monoid (mconcat)

16+import qualified Blaze.ByteString.Builder as Blaze

17+import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze

18+import qualified Data.ByteString as SB

19+import qualified Data.ByteString.Lazy as LB

20+import qualified Data.Text as T

21+import qualified Data.Text.Lazy as LT

22+import qualified Data.Text.Lazy.Builder as LTB

23+

24+benchmark :: IO Benchmark

25+benchmark = return $ bgroup "Builder"

26+ [ bench "LazyText" $ nf

27+ (LT.length . LTB.toLazyText . mconcat . map LTB.fromText) texts

28+ , bench "Binary" $ nf

29+ (LB.length . B.toLazyByteString . mconcat . map B.fromByteString)

30+ byteStrings

31+ , bench "Blaze" $ nf

32+ (LB.length . Blaze.toLazyByteString . mconcat . map Blaze.fromString)

33+ strings

34+ ]

35+

36+texts :: [T.Text]

37+texts = take 200000 $ cycle ["foo", "λx", "由の"]

38+{-# NOINLINE texts #-}

39+

40+-- Note that the non-ascii characters will be chopped

41+byteStrings :: [SB.ByteString]

42+byteStrings = take 200000 $ cycle ["foo", "λx", "由の"]

43+{-# NOINLINE byteStrings #-}

44+

45+-- Note that the non-ascii characters will be chopped

46+strings :: [String]

47+strings = take 200000 $ cycle ["foo", "λx", "由の"]

48+{-# NOINLINE strings #-}

benchmarks/haskell/Benchmarks/DecodeUtf8.hs → tests/benchmarks/src/Data/Text/Benchmarks/DecodeUtf8.hsrenamed+5−13

@@ -14,18 +14,17 @@

1414--

1515-- The latter are used for testing stream fusion.

1616--

17−module Benchmarks.DecodeUtf8

17+module Data.Text.Benchmarks.DecodeUtf8

1818 ( benchmark

1919 ) where

2020

21−import Foreign.C.Types

21+import Foreign.C.Types (CInt, CSize)

2222import Data.ByteString.Internal (ByteString(..))

23−import Data.ByteString.Lazy.Internal (ByteString(..))

2423import Foreign.Ptr (Ptr, plusPtr)

2524import Foreign.ForeignPtr (withForeignPtr)

2625import Data.Word (Word8)

2726import qualified Criterion as C

28−import Criterion (Benchmark, bgroup, nf, whnfIO)

27+import Criterion (Benchmark, bgroup, nf)

2928import qualified Codec.Binary.UTF8.Generic as U8

3029import qualified Data.ByteString as B

3130import qualified Data.ByteString.Lazy as BL

@@ -39,16 +38,9 @@ benchmark kind fp = do

3938 bs <- B.readFile fp

4039 lbs <- BL.readFile fp

4140 let bench name = C.bench (name ++ "+" ++ kind)

42− decodeStream (Chunk b0 bs0) = case T.streamDecodeUtf8 b0 of

43− T.Some t0 _ f0 -> t0 : go f0 bs0

44− where go f (Chunk b bs1) = case f b of

45− T.Some t1 _ f1 -> t1 : go f1 bs1

46− go _ _ = []

47− decodeStream _ = []

4841 return $ bgroup "DecodeUtf8"

4942 [ bench "Strict" $ nf T.decodeUtf8 bs

50− , bench "Stream" $ nf decodeStream lbs

51− , bench "IConv" $ whnfIO $ iconv bs

43+ , bench "IConv" $ iconv bs

5244 , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs

5345 , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs

5446 , bench "Lazy" $ nf TL.decodeUtf8 lbs

@@ -60,7 +52,7 @@ benchmark kind fp = do

6052 , bench "LazyStringUtf8Length" $ nf (length . U8.toString) lbs

6153 ]

6254

63−iconv :: B.ByteString -> IO CInt

55+iconv :: ByteString -> IO CInt

6456iconv (PS fp off len) = withForeignPtr fp $ \ptr ->

6557 time_iconv (ptr `plusPtr` off) (fromIntegral len)

6658

benchmarks/haskell/Benchmarks/EncodeUtf8.hs → tests/benchmarks/src/Data/Text/Benchmarks/EncodeUtf8.hsrenamed+1−1

@@ -6,7 +6,7 @@

66--

77-- * UTF-8 encoding it

88--

9−module Benchmarks.EncodeUtf8

9+module Data.Text.Benchmarks.EncodeUtf8

1010 ( benchmark

1111 ) where

1212

benchmarks/haskell/Benchmarks/Equality.hs → tests/benchmarks/src/Data/Text/Benchmarks/Equality.hsrenamed+1−1

@@ -5,7 +5,7 @@

55--

66-- * Comparison of strings (Eq instance)

77--

8−module Benchmarks.Equality

8+module Data.Text.Benchmarks.Equality

99 ( benchmark

1010 ) where

1111

tests/benchmarks/src/Data/Text/Benchmarks/FileRead.hsnew file+33

@@ -0,0 +1,33 @@

1+-- | Benchmarks simple file reading

2+--

3+-- Tested in this benchmark:

4+--

5+-- * Reading a file from the disk

6+--

7+module Data.Text.Benchmarks.FileRead

8+ ( benchmark

9+ ) where

10+

11+import Control.Exception (evaluate)

12+import Criterion (Benchmark, bgroup, bench)

13+import qualified Data.ByteString as SB

14+import qualified Data.ByteString.Lazy as LB

15+import qualified Data.Text as T

16+import qualified Data.Text.Encoding as T

17+import qualified Data.Text.IO as T

18+import qualified Data.Text.Lazy as LT

19+import qualified Data.Text.Lazy.Encoding as LT

20+import qualified Data.Text.Lazy.IO as LT

21+

22+benchmark :: FilePath -> IO Benchmark

23+benchmark p = return $ bgroup "FileRead"

24+ [ bench "String" $ readFile p >>= evaluate . length

25+ , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length

26+ , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length

27+ , bench "Text" $ T.readFile p >>= evaluate . T.length

28+ , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length

29+ , bench "TextByteString" $

30+ SB.readFile p >>= evaluate . T.length . T.decodeUtf8

31+ , bench "LazyTextByteString" $

32+ LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8

33+ ]

benchmarks/haskell/Benchmarks/FoldLines.hs → tests/benchmarks/src/Data/Text/Benchmarks/FoldLines.hsrenamed+3−3

@@ -6,11 +6,11 @@

66-- * Buffered, line-based IO

77--

88{-# LANGUAGE BangPatterns #-}

9−module Benchmarks.FoldLines

9+module Data.Text.Benchmarks.FoldLines

1010 ( benchmark

1111 ) where

1212

13−import Criterion (Benchmark, bgroup, bench, whnfIO)

13+import Criterion (Benchmark, bgroup, bench)

1414import System.IO

1515import qualified Data.ByteString as B

1616import qualified Data.Text as T

@@ -22,7 +22,7 @@ benchmark fp = return $ bgroup "ReadLines"

2222 , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)

2323 ]

2424 where

25− withHandle f = whnfIO $ do

25+ withHandle f = do

2626 h <- openFile fp ReadMode

2727 hSetBuffering h (BlockBuffering (Just 16384))

2828 x <- f h

benchmarks/haskell/Benchmarks/Programs/BigTable.hs → tests/benchmarks/src/Data/Text/Benchmarks/Programs/BigTable.hsrenamed+3−3

@@ -7,11 +7,11 @@

77-- * Writing to a handle

88--

99{-# LANGUAGE OverloadedStrings #-}

10−module Benchmarks.Programs.BigTable

10+module Data.Text.Benchmarks.Programs.BigTable

1111 ( benchmark

1212 ) where

1313

14−import Criterion (Benchmark, bench, whnfIO)

14+import Criterion (Benchmark, bench)

1515import Data.Monoid (mappend, mconcat)

1616import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)

1717import Data.Text.Lazy.IO (hPutStr)

@@ -19,7 +19,7 @@ import System.IO (Handle)

1919import qualified Data.Text as T

2020

2121benchmark :: Handle -> IO Benchmark

22−benchmark sink = return $ bench "BigTable" $ whnfIO $ do

22+benchmark sink = return $ bench "BigTable" $ do

2323 hPutStr sink "Content-Type: text/html\n\n<table>"

2424 hPutStr sink . toLazyText . makeTable =<< rows

2525 hPutStr sink "</table>"

benchmarks/haskell/Benchmarks/Programs/Cut.hs → tests/benchmarks/src/Data/Text/Benchmarks/Programs/Cut.hsrenamed+3−3

@@ -12,11 +12,11 @@

1212--

1313-- * Writing back to a handle

1414--

15−module Benchmarks.Programs.Cut

15+module Data.Text.Benchmarks.Programs.Cut

1616 ( benchmark

1717 ) where

1818

19−import Criterion (Benchmark, bgroup, bench, whnfIO)

19+import Criterion (Benchmark, bgroup, bench)

2020import System.IO (Handle, hPutStr)

2121import qualified Data.ByteString as B

2222import qualified Data.ByteString.Char8 as BC

@@ -40,7 +40,7 @@ benchmark p sink from to = return $ bgroup "Cut"

4040 , bench' "LazyTextByteString" lazyTextByteString

4141 ]

4242 where

43− bench' n s = bench n $ whnfIO (s p sink from to)

43+ bench' n s = bench n (s p sink from to)

4444

4545string :: FilePath -> Handle -> Int -> Int -> IO ()

4646string fp sink from to = do

benchmarks/haskell/Benchmarks/Programs/Fold.hs → tests/benchmarks/src/Data/Text/Benchmarks/Programs/Fold.hsrenamed+3−3

@@ -13,7 +13,7 @@

1313-- * Writing back to a handle

1414--

1515{-# LANGUAGE OverloadedStrings #-}

16−module Benchmarks.Programs.Fold

16+module Data.Text.Benchmarks.Programs.Fold

1717 ( benchmark

1818 ) where

1919

@@ -21,7 +21,7 @@ import Data.List (foldl')

2121import Data.List (intersperse)

2222import Data.Monoid (mempty, mappend, mconcat)

2323import System.IO (Handle)

24−import Criterion (Benchmark, bench, whnfIO)

24+import Criterion (Benchmark, bench)

2525import qualified Data.Text as T

2626import qualified Data.Text.IO as T

2727import qualified Data.Text.Lazy.Builder as TLB

@@ -30,7 +30,7 @@ import qualified Data.Text.Lazy.IO as TL

3030

3131benchmark :: FilePath -> Handle -> IO Benchmark

3232benchmark i o = return $

33− bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80

33+ bench "Fold" $ T.readFile i >>= TL.hPutStr o . fold 80

3434

3535-- | We represent a paragraph by a word list

3636--

benchmarks/haskell/Benchmarks/Programs/Sort.hs → tests/benchmarks/src/Data/Text/Benchmarks/Programs/Sort.hsrenamed+10−11

@@ -13,11 +13,11 @@

1313-- * Writing back to a handle

1414--

1515{-# LANGUAGE OverloadedStrings #-}

16−module Benchmarks.Programs.Sort

16+module Data.Text.Benchmarks.Programs.Sort

1717 ( benchmark

1818 ) where

1919

20−import Criterion (Benchmark, bgroup, bench, whnfIO)

20+import Criterion (Benchmark, bgroup, bench)

2121import Data.Monoid (mconcat)

2222import System.IO (Handle, hPutStr)

2323import qualified Data.ByteString as B

@@ -35,17 +35,16 @@ import qualified Data.Text.Lazy.IO as TL

3535

3636benchmark :: FilePath -> Handle -> IO Benchmark

3737benchmark i o = return $ bgroup "Sort"

38− [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string

39− , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString

40− , bench "LazyByteString" $ whnfIO $

41− BL.readFile i >>= BL.hPutStr o . lazyByteString

42− , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text

43− , bench "LazyText" $ whnfIO $ TL.readFile i >>= TL.hPutStr o . lazyText

44− , bench "TextByteString" $ whnfIO $ B.readFile i >>=

38+ [ bench "String" $ readFile i >>= hPutStr o . string

39+ , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString

40+ , bench "LazyByteString" $ BL.readFile i >>= BL.hPutStr o . lazyByteString

41+ , bench "Text" $ T.readFile i >>= T.hPutStr o . text

42+ , bench "LazyText" $ TL.readFile i >>= TL.hPutStr o . lazyText

43+ , bench "TextByteString" $ B.readFile i >>=

4544 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

46− , bench "LazyTextByteString" $ whnfIO $ BL.readFile i >>=

45+ , bench "LazyTextByteString" $ BL.readFile i >>=

4746 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8

48− , bench "TextBuilder" $ whnfIO $ B.readFile i >>=

47+ , bench "TextBuilder" $ B.readFile i >>=

4948 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8

5049 ]

5150

benchmarks/haskell/Benchmarks/Programs/StripTags.hs → tests/benchmarks/src/Data/Text/Benchmarks/Programs/StripTags.hsrenamed+7−7

@@ -11,11 +11,11 @@

1111-- * Writing back to a handle

1212--

1313{-# OPTIONS_GHC -fspec-constr-count=5 #-}

14−module Benchmarks.Programs.StripTags

14+module Data.Text.Benchmarks.Programs.StripTags

1515 ( benchmark

1616 ) where

17−

18−import Criterion (Benchmark, bgroup, bench, whnfIO)

17+

18+import Criterion (Benchmark, bgroup, bench)

1919import Data.List (mapAccumL)

2020import System.IO (Handle, hPutStr)

2121import qualified Data.ByteString as B

@@ -26,10 +26,10 @@ import qualified Data.Text.IO as T

2626

2727benchmark :: FilePath -> Handle -> IO Benchmark

2828benchmark i o = return $ bgroup "StripTags"

29− [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string

30− , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString

31− , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text

32− , bench "TextByteString" $ whnfIO $

29+ [ bench "String" $ readFile i >>= hPutStr o . string

30+ , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString

31+ , bench "Text" $ T.readFile i >>= T.hPutStr o . text

32+ , bench "TextByteString" $

3333 B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

3434 ]

3535

benchmarks/haskell/Benchmarks/Programs/Throughput.hs → tests/benchmarks/src/Data/Text/Benchmarks/Programs/Throughput.hsrenamed+9−9

@@ -14,11 +14,11 @@

1414--

1515-- * Writing back to a handle

1616--

17−module Benchmarks.Programs.Throughput

17+module Data.Text.Benchmarks.Programs.Throughput

1818 ( benchmark

1919 ) where

2020

21−import Criterion (Benchmark, bgroup, bench, whnfIO)

21+import Criterion (Benchmark, bgroup, bench)

2222import System.IO (Handle, hPutStr)

2323import qualified Data.ByteString as B

2424import qualified Data.ByteString.Lazy as BL

@@ -29,13 +29,13 @@ import qualified Data.Text.Lazy.IO as TL

2929

3030benchmark :: FilePath -> Handle -> IO Benchmark

3131benchmark fp sink = return $ bgroup "Throughput"

32− [ bench "String" $ whnfIO $ readFile fp >>= hPutStr sink

33− , bench "ByteString" $ whnfIO $ B.readFile fp >>= B.hPutStr sink

34− , bench "LazyByteString" $ whnfIO $ BL.readFile fp >>= BL.hPutStr sink

35− , bench "Text" $ whnfIO $ T.readFile fp >>= T.hPutStr sink

36− , bench "LazyText" $ whnfIO $ TL.readFile fp >>= TL.hPutStr sink

37− , bench "TextByteString" $ whnfIO $

32+ [ bench "String" $ readFile fp >>= hPutStr sink

33+ , bench "ByteString" $ B.readFile fp >>= B.hPutStr sink

34+ , bench "LazyByteString" $ BL.readFile fp >>= BL.hPutStr sink

35+ , bench "Text" $ T.readFile fp >>= T.hPutStr sink

36+ , bench "LazyText" $ TL.readFile fp >>= TL.hPutStr sink

37+ , bench "TextByteString" $

3838 B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8

39− , bench "LazyTextByteString" $ whnfIO $

39+ , bench "LazyTextByteString" $

4040 BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8

4141 ]

benchmarks/haskell/Benchmarks/Pure.hs → tests/benchmarks/src/Data/Text/Benchmarks/Pure.hsrenamed+10−22

@@ -4,9 +4,9 @@

44--

55-- * Most pure functions defined the string types

66--

7−{-# LANGUAGE BangPatterns, CPP, GADTs, MagicHash #-}

7+{-# LANGUAGE BangPatterns, GADTs, MagicHash #-}

88{-# OPTIONS_GHC -fno-warn-orphans #-}

9−module Benchmarks.Pure

9+module Data.Text.Benchmarks.Pure

1010 ( benchmark

1111 ) where

1212

@@ -18,6 +18,7 @@ import Data.Monoid (mappend, mempty)

1818import GHC.Base (Char (..), Int (..), chr#, ord#, (+#))

1919import qualified Data.ByteString.Char8 as BS

2020import qualified Data.ByteString.Lazy.Char8 as BL

21+import qualified Data.ByteString.Lazy.Internal as BL

2122import qualified Data.ByteString.UTF8 as UTF8

2223import qualified Data.List as L

2324import qualified Data.Text as T

@@ -26,8 +27,8 @@ import qualified Data.Text.Lazy as TL

2627import qualified Data.Text.Lazy.Builder as TB

2728import qualified Data.Text.Lazy.Encoding as TL

2829

29−benchmark :: String -> FilePath -> IO Benchmark

30−benchmark kind fp = do

30+benchmark :: FilePath -> IO Benchmark

31+benchmark fp = do

3132 -- Evaluate stuff before actually running the benchmark, we don't want to

3233 -- count it here.

3334

@@ -99,10 +100,6 @@ benchmark kind fp = do

99100 , benchBSL $ nf BL.unpack bla

100101 , benchS $ nf UTF8.toString bsa

101102 ]

102− , bgroup "decode'"

103− [ benchT $ nf T.decodeUtf8' bsa

104− , benchTL $ nf TL.decodeUtf8' bla

105− ]

106103 , bgroup "drop"

107104 [ benchT $ nf (T.drop (ta_len `div` 3)) ta

108105 , benchTL $ nf (TL.drop (tla_len `div` 3)) tla

@@ -262,13 +259,6 @@ benchmark kind fp = do

262259 , benchBSL $ nf (BL.map toUpper) bla

263260 , benchS $ nf (L.map toUpper) sa

264261 ]

265− , bgroup "uncons"

266− [ benchT $ nf T.uncons ta

267− , benchTL $ nf TL.uncons tla

268− , benchBS $ nf BS.uncons bsa

269− , benchBSL $ nf BL.uncons bla

270− , benchS $ nf L.uncons sa

271− ]

272262 , bgroup "words"

273263 [ benchT $ nf T.words ta

274264 , benchTL $ nf TL.words tla

@@ -415,11 +405,11 @@ benchmark kind fp = do

415405 ]

416406 ]

417407 where

418− benchS = bench ("String+" ++ kind)

419− benchT = bench ("Text+" ++ kind)

420− benchTL = bench ("LazyText+" ++ kind)

421− benchBS = bench ("ByteString+" ++ kind)

422− benchBSL = bench ("LazyByteString+" ++ kind)

408+ benchS = bench "String"

409+ benchT = bench "Text"

410+ benchTL = bench "LazyText"

411+ benchBS = bench "ByteString"

412+ benchBSL = bench "LazyByteString"

423413

424414 c = 'й'

425415 p0 = (== c)

@@ -435,13 +425,11 @@ benchmark kind fp = do

435425 replicat n = concat . L.replicate n

436426 short = T.pack "short"

437427

438−#if !MIN_VERSION_bytestring(0,10,0)

439428instance NFData BS.ByteString

440429

441430instance NFData BL.ByteString where

442431 rnf BL.Empty = ()

443432 rnf (BL.Chunk _ ts) = rnf ts

444−#endif

445433

446434data B where

447435 B :: NFData a => a -> B

benchmarks/haskell/Benchmarks/ReadNumbers.hs → tests/benchmarks/src/Data/Text/Benchmarks/ReadNumbers.hsrenamed+7−4

@@ -16,7 +16,7 @@

1616--

1717-- * Lexing/parsing of different numerical types

1818--

19−module Benchmarks.ReadNumbers

19+module Data.Text.Benchmarks.ReadNumbers

2020 ( benchmark

2121 ) where

2222

@@ -25,7 +25,8 @@ import Data.List (foldl')

2525import Numeric (readDec, readFloat, readHex)

2626import qualified Data.ByteString.Char8 as B

2727import qualified Data.ByteString.Lazy.Char8 as BL

28−import qualified Data.ByteString.Lex.Fractional as B

28+import qualified Data.ByteString.Lex.Double as B

29+import qualified Data.ByteString.Lex.Lazy.Double as BL

2930import qualified Data.Text as T

3031import qualified Data.Text.IO as T

3132import qualified Data.Text.Lazy as TL

@@ -62,10 +63,12 @@ benchmark fp = do

6263 whnf (double . text TL.rational) tl

6364

6465 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b

65− , bench "DoubleByteString" $ whnf (double . byteString B.readDecimal) b

66+ , bench "DoubleByteString" $ whnf (double . byteString B.readDouble) b

6667

6768 , bench "DecimalLazyByteString" $

6869 whnf (int . byteString BL.readInt) bl

70+ , bench "DoubleLazyByteString" $

71+ whnf (double . byteString BL.readDouble) bl

6972 ]

7073 where

7174 -- Used for fixing types

@@ -85,7 +88,7 @@ text reader = foldl' go 1000000

8588 where

8689 go z t = case reader t of Left _ -> z

8790 Right (n, _) -> min n z

88−

91+

8992byteString :: (Ord a, Num a) => (t -> Maybe (a,t)) -> [t] -> a

9093byteString reader = foldl' go 1000000

9194 where

tests/benchmarks/src/Data/Text/Benchmarks/Replace.hsnew file+31

@@ -0,0 +1,31 @@

1+-- | Replace a string by another string

2+--

3+-- Tested in this benchmark:

4+--

5+-- * Search and replace of a pattern in a text

6+--

7+module Data.Text.Benchmarks.Replace

8+ ( benchmark

9+ ) where

10+

11+import Criterion (Benchmark, bgroup, bench, nf)

12+import qualified Data.ByteString.Char8 as B

13+import qualified Data.ByteString.Lazy as BL

14+import qualified Data.ByteString.Lazy.Search as BL

15+import qualified Data.Text.Lazy as TL

16+import qualified Data.Text.Lazy.Encoding as TL

17+import qualified Data.Text.Lazy.IO as TL

18+

19+benchmark :: FilePath -> String -> String -> IO Benchmark

20+benchmark fp pat sub = do

21+ tl <- TL.readFile fp

22+ bl <- BL.readFile fp

23+ return $ bgroup "Replace"

24+ [ bench "LazyText" $ nf (TL.length . TL.replace tpat tsub) tl

25+ , bench "LazyByteString" $ nf (BL.length . BL.replace bpat bsub) bl

26+ ]

27+ where

28+ tpat = TL.pack pat

29+ tsub = TL.pack sub

30+ bpat = B.concat $ BL.toChunks $ TL.encodeUtf8 tpat

31+ bsub = B.concat $ BL.toChunks $ TL.encodeUtf8 tsub

benchmarks/haskell/Benchmarks/Search.hs → tests/benchmarks/src/Data/Text/Benchmarks/Search.hsrenamed+1−1

@@ -4,7 +4,7 @@

44--

55-- * Searching all occurences of a pattern using library routines

66--

7−module Benchmarks.Search

7+module Data.Text.Benchmarks.Search

88 ( benchmark

99 ) where

1010

benchmarks/haskell/Benchmarks/Stream.hs → tests/benchmarks/src/Data/Text/Benchmarks/Stream.hsrenamed+11−21

@@ -7,22 +7,22 @@

77--

88{-# LANGUAGE BangPatterns #-}

99{-# OPTIONS_GHC -fno-warn-orphans #-}

10−module Benchmarks.Stream

10+module Data.Text.Benchmarks.Stream

1111 ( benchmark

1212 ) where

1313

1414import Control.DeepSeq (NFData (..))

1515import Criterion (Benchmark, bgroup, bench, nf)

16−import Data.Text.Internal.Fusion.Types (Step (..), Stream (..))

16+import Data.Text.Fusion.Internal (Step (..), Stream (..))

1717import qualified Data.Text.Encoding as T

1818import qualified Data.Text.Encoding.Error as E

19−import qualified Data.Text.Internal.Encoding.Fusion as T

20−import qualified Data.Text.Internal.Encoding.Fusion.Common as F

21−import qualified Data.Text.Internal.Fusion as F

19+import qualified Data.Text.Encoding.Fusion as T

20+import qualified Data.Text.Encoding.Fusion.Common as F

21+import qualified Data.Text.Fusion as T

2222import qualified Data.Text.IO as T

2323import qualified Data.Text.Lazy.Encoding as TL

24−import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL

25−import qualified Data.Text.Internal.Lazy.Fusion as FL

24+import qualified Data.Text.Lazy.Encoding.Fusion as TL

25+import qualified Data.Text.Lazy.Fusion as TL

2626import qualified Data.Text.Lazy.IO as TL

2727

2828instance NFData a => NFData (Stream a) where

@@ -53,25 +53,14 @@ benchmark fp = do

5353 !utf32beL = TL.encodeUtf32BE tl

5454

5555 -- For the functions which operate on streams

56− let !s = F.stream t

56+ let !s = T.stream t

5757

5858 return $ bgroup "Stream"

5959

6060 -- Fusion

6161 [ bgroup "stream" $

62− [ bench "Text" $ nf F.stream t

63− , bench "LazyText" $ nf FL.stream tl

64− ]

65− -- must perform exactly the same as stream above due to

66− -- stream/unstream (i.e. stream after unstream) fusion

67− , bgroup "stream-fusion" $

68− [ bench "Text" $ nf (F.stream . F.unstream . F.stream) t

69− , bench "LazyText" $ nf (FL.stream . FL.unstream . FL.stream) tl

70− ]

71− -- measure the overhead of unstream after stream

72− , bgroup "stream-unstream" $

73− [ bench "Text" $ nf (F.unstream . F.stream) t

74− , bench "LazyText" $ nf (FL.unstream . FL.stream) tl

62+ [ bench "Text" $ nf T.stream t

63+ , bench "LazyText" $ nf TL.stream tl

7564 ]

7665

7766 -- Encoding.Fusion

@@ -97,6 +86,7 @@ benchmark fp = do

9786 ]

9887

9988 -- Encoding.Fusion.Common

89+ , bench "restreamUtf8" $ nf F.restreamUtf8 s

10090 , bench "restreamUtf16LE" $ nf F.restreamUtf16LE s

10191 , bench "restreamUtf16BE" $ nf F.restreamUtf16BE s

10292 , bench "restreamUtf32LE" $ nf F.restreamUtf32LE s

benchmarks/haskell/Benchmarks/WordFrequencies.hs → tests/benchmarks/src/Data/Text/Benchmarks/WordFrequencies.hsrenamed+1−1

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

88--

99-- * Comparing: Eq/Ord instances

1010--

11−module Benchmarks.WordFrequencies

11+module Data.Text.Benchmarks.WordFrequencies

1212 ( benchmark

1313 ) where

1414

tests/benchmarks/text-benchmarks.cabalnew file+36

@@ -0,0 +1,36 @@

1+name: text-benchmarks

2+version: 0.0.0.0

3+synopsis: Benchmarks for the text package

4+description: Benchmarks for the text package

5+homepage: https://bitbucket.org/bos/text

6+license: BSD3

7+license-file: ../../LICENSE

8+author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

9+ Bryan O'Sullivan <bos@serpentine.com>,

10+ Tom Harper <rtomharper@googlemail.com>,

11+ Duncan Coutts <duncan@haskell.org>

12+maintainer: jaspervdj@gmail.com

13+category: Text

14+build-type: Simple

15+

16+cabal-version: >=1.2

17+

18+executable text-benchmarks

19+ hs-source-dirs: src ../..

20+ c-sources: ../../cbits/cbits.c

21+ cbits/time_iconv.c

22+ main-is: Data/Text/Benchmarks.hs

23+ ghc-options: -Wall -O2

24+ cpp-options: -DHAVE_DEEPSEQ

25+ build-depends: base >= 4 && < 5,

26+ criterion >= 0.5 && < 0.7,

27+ bytestring >= 0.9 && < 0.10,

28+ deepseq >= 1.1 && < 1.2,

29+ filepath >= 1.1 && < 1.3,

30+ directory >= 1.1 && < 1.2,

31+ containers >= 0.3 && < 0.5,

32+ binary >= 0.5 && < 0.6,

33+ utf8-string >= 0.3 && < 0.4,

34+ blaze-builder >= 0.3 && < 0.4,

35+ bytestring-lexing >= 0.2 && < 0.3,

36+ stringsearch >= 0.3 && < 0.4

tests/cabal.configdeleted−6

@@ -1,6 +0,0 @@

1−-- These flags help to speed up building the test suite.

2−

3−documentation: False

4−executable-stripping: False

5−flags: developer

6−library-profiling: False

tests/literal-rule-test.shdeleted−29

@@ -1,29 +0,0 @@

1−#!/bin/bash -e

2−

3−failed=0

4−

5−function check_firings() {

6− rule=$1

7− expected=$2

8− build="ghc -O -ddump-rule-firings LiteralRuleTest.hs"

9− build="$build -i.. -I../include"

10− touch LiteralRuleTest.hs

11− echo -n "Want to see $expected firings of rule $rule... " >&2

12− firings=$($build 2>&1 | grep "Rule fired: $rule\$" | wc -l)

13− rm -f LiteralRuleTest.{o.hi}

14−

15− if [ $firings != $expected ]; then

16− echo "failed, saw $firings" >&2

17− failed=1

18− else

19− echo "pass" >&2

20− fi

21−}

22−

23−check_firings "TEXT literal" 8

24−check_firings "TEXT literal UTF8" 7

25−check_firings "TEXT empty literal" 4

26−# This is broken at the moment. "TEXT literal" rule fires instead.

27−#check_firings "TEXT singleton literal" 5

28−

29−exit $failed

tests/.ghci → tests/tests/.ghcirenamed

The content is the same.

tests/Makefile → tests/tests/Makefilerenamed+3−14

@@ -1,23 +1,12 @@

1−count = 1000

2−

3−all: coverage literal-rule-test

4−

5−literal-rule-test:

6− ./literal-rule-test.sh

7−

81coverage: build coverage/hpc_index.html

10−build: text-test-data

3+build:

114 cabal configure -fhpc

125 cabal build

136

14−text-test-data:

15− hg clone https://bitbucket.org/bos/text-test-data

16− $(MAKE) -C text-test-data

17−

187coverage/text-tests.tix:

198 -mkdir -p coverage

20− ./dist/build/text-tests/text-tests -a $(count)

9+ ./dist/build/text-tests/text-tests

2110 mv text-tests.tix $@

2211

2312coverage/text-tests-stdio.tix:

@@ -37,4 +26,4 @@ coverage/hpc_index.html: coverage/coverage.tix

3726clean:

3827 rm -rf dist coverage .hpc

3928

40−.PHONY: build coverage all literal-rule-test

29+.PHONY: build coverage

tests/scripts/cover-stdio.sh → tests/tests/scripts/cover-stdio.shrenamed

The content is the same.

tests/Tests.hs → tests/tests/src/Data/Text/Tests.hsrenamed+2−2

@@ -6,8 +6,8 @@ module Main

77import Test.Framework (defaultMain)

9−import qualified Tests.Properties as Properties

10−import qualified Tests.Regressions as Regressions

9+import qualified Data.Text.Tests.Properties as Properties

10+import qualified Data.Text.Tests.Regressions as Regressions

1111

1212main :: IO ()

1313main = defaultMain [Properties.tests, Regressions.tests]

tests/Tests/IO.hs → tests/tests/src/Data/Text/Tests/IO.hsrenamed

The content is the same.

tests/Tests/Properties.hs → tests/tests/src/Data/Text/Tests/Properties.hsrenamed+82−327

@@ -1,60 +1,54 @@

1−-- | QuickCheck properties for the text library.

2−

1+-- | General quicktest properties for the text library

2+--

33{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,

4− ScopedTypeVariables, TypeSynonymInstances #-}

5−{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}

6−module Tests.Properties

4+ ScopedTypeVariables, TypeSynonymInstances, CPP #-}

5+{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}

6+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

7+module Data.Text.Tests.Properties

78 (

89 tests

910 ) where

1011

11−import Control.Applicative ((<$>), (<*>))

12+import Test.QuickCheck

13+import Test.QuickCheck.Monadic

14+import Text.Show.Functions ()

15+

1216import Control.Arrow ((***), second)

13−import Data.Bits ((.&.))

17+import Control.Exception (catch)

1418import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)

15−import Data.Int (Int8, Int16, Int32, Int64)

1619import Data.Monoid (Monoid(..))

17−import Data.String (IsString(fromString))

20+import Data.String (fromString)

1821import Data.Text.Encoding.Error

1922import Data.Text.Foreign

20−import Data.Text.Internal.Encoding.Utf8

21−import Data.Text.Internal.Fusion.Size

22−import Data.Text.Internal.Search (indices)

23+import Data.Text.Fusion.Size

2324import Data.Text.Lazy.Read as TL

2425import Data.Text.Read as T

25−import Data.Word (Word, Word8, Word16, Word32, Word64)

26−import Numeric (showEFloat, showFFloat, showGFloat, showHex)

27−import Prelude hiding (replicate)

26+import Data.Text.Search (indices)

27+import Data.Word (Word8, Word16, Word32)

28+import Numeric (showHex)

29+import Prelude hiding (catch, replicate)

2830import Test.Framework (Test, testGroup)

2931import Test.Framework.Providers.QuickCheck2 (testProperty)

30−import Test.QuickCheck hiding ((.&.))

31−import Test.QuickCheck.Monadic

32−import Test.QuickCheck.Property (Property(..))

33−import Tests.QuickCheckUtils

34−import Tests.Utils

35−import Text.Show.Functions ()

36−import qualified Control.Exception as Exception

3732import qualified Data.Bits as Bits (shiftL, shiftR)

3833import qualified Data.ByteString as B

39−import qualified Data.ByteString.Lazy as BL

4034import qualified Data.List as L

4135import qualified Data.Text as T

4236import qualified Data.Text.Encoding as E

37+import qualified Data.Text.Fusion as S

38+import qualified Data.Text.Fusion.Common as S

4339import qualified Data.Text.IO as T

44−import qualified Data.Text.Internal.Fusion as S

45−import qualified Data.Text.Internal.Fusion.Common as S

46−import qualified Data.Text.Internal.Lazy.Fusion as SL

47−import qualified Data.Text.Internal.Lazy.Search as S (indices)

48−import qualified Data.Text.Internal.Unsafe.Shift as U

4940import qualified Data.Text.Lazy as TL

5041import qualified Data.Text.Lazy.Builder as TB

51−import qualified Data.Text.Lazy.Builder.Int as TB

52−import qualified Data.Text.Lazy.Builder.RealFloat as TB

5342import qualified Data.Text.Lazy.Encoding as EL

43+import qualified Data.Text.Lazy.Fusion as SL

5444import qualified Data.Text.Lazy.IO as TL

45+import qualified Data.Text.Lazy.Search as S (indices)

46+import qualified Data.Text.UnsafeShift as U

5547import qualified System.IO as IO

56−import qualified Tests.Properties.Mul as Mul

57−import qualified Tests.SlowFunctions as Slow

48+

49+import Data.Text.Tests.QuickCheckUtils

50+import Data.Text.Tests.Utils

51+import qualified Data.Text.Tests.SlowFunctions as Slow

5852

5953t_pack_unpack = (T.unpack . T.pack) `eq` id

6054tl_pack_unpack = (TL.unpack . TL.pack) `eq` id

@@ -68,20 +62,10 @@ tl_unstreamChunks x = f 11 x == f 1000 x

6862tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id

6963tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id

7064

71−-- Note: this silently truncates code-points > 255 to 8-bit due to 'B.pack'

72−encodeL1 :: T.Text -> B.ByteString

73−encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack

74−encodeLazyL1 :: TL.Text -> BL.ByteString

75−encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks

76−

7765t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a

7866 where a = T.map (\c -> chr (ord c `mod` 128)) t

7967tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a

8068 where a = TL.map (\c -> chr (ord c `mod` 128)) t

81−t_latin1 t = E.decodeLatin1 (encodeL1 a) == a

82− where a = T.map (\c -> chr (ord c `mod` 256)) t

83−tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a

84− where a = TL.map (\c -> chr (ord c `mod` 256)) t

8569t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id

8670t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)

8771tl_utf8 = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id

@@ -95,88 +79,23 @@ tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id

9579t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id

9680tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id

9781

98−t_utf8_incr = forAll genUnicode $ \s (Positive n) -> (recode n `eq` id) s

99− where recode n = T.concat . map fst . feedChunksOf n E.streamDecodeUtf8 .

100− E.encodeUtf8

101−

102−feedChunksOf :: Int -> (B.ByteString -> E.Decoding) -> B.ByteString

103− -> [(T.Text, B.ByteString)]

104−feedChunksOf n f bs

105− | B.null bs = []

106− | otherwise = let (x,y) = B.splitAt n bs

107− E.Some t b f' = f x

108− in (t,b) : feedChunksOf n f' y

109−

110−t_utf8_undecoded = forAll genUnicode $ \t ->

111− let b = E.encodeUtf8 t

112− ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t

113− leftover = (++ [B.empty]) . init . tail . B.inits

114− in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls

115−

116−data Badness = Solo | Leading | Trailing

117− deriving (Eq, Show)

118−

119−instance Arbitrary Badness where

120− arbitrary = elements [Solo, Leading, Trailing]

121−

122−t_utf8_err :: Badness -> DecodeErr -> Property

123−t_utf8_err bad de = do

124− let gen = case bad of

125− Solo -> genInvalidUTF8

126− Leading -> B.append <$> genInvalidUTF8 <*> genUTF8

127− Trailing -> B.append <$> genUTF8 <*> genInvalidUTF8

128− genUTF8 = E.encodeUtf8 <$> genUnicode

129− forAll gen $ \bs -> MkProperty $ do

130− onErr <- genDecodeErr de

131− unProperty . monadicIO $ do

132− l <- run $ let len = T.length (E.decodeUtf8With onErr bs)

133− in (len `seq` return (Right len)) `Exception.catch`

134− (\(e::UnicodeException) -> return (Left e))

135− assert $ case l of

136− Left err -> length (show err) >= 0

137− Right _ -> de /= Strict

82+-- This is a poor attempt to ensure that the error handling paths on

83+-- decode are exercised in some way. Proper testing would be rather

84+-- more involved.

85+t_utf8_err :: DecodeErr -> B.ByteString -> Property

86+t_utf8_err (DE _ de) bs = monadicIO $ do

87+ l <- run $ let len = T.length (E.decodeUtf8With de bs)

88+ in (len `seq` return (Right len)) `catch`

89+ (\(e::UnicodeException) -> return (Left e))

90+ case l of

91+ Left err -> assert $ length (show err) >= 0

92+ Right n -> assert $ n >= 0

13893

13994t_utf8_err' :: B.ByteString -> Property

14095t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of

14196 Left err -> length (show err) >= 0

14297 Right t -> T.length t >= 0

14398

144−genInvalidUTF8 :: Gen B.ByteString

145−genInvalidUTF8 = B.pack <$> oneof [

146− -- invalid leading byte of a 2-byte sequence

147− (:) <$> choose (0xC0, 0xC1) <*> upTo 1 contByte

148− -- invalid leading byte of a 4-byte sequence

149− , (:) <$> choose (0xF5, 0xFF) <*> upTo 3 contByte

150− -- 4-byte sequence greater than U+10FFFF

151− , do k <- choose (0x11, 0x13)

152− let w0 = 0xF0 + (k `Bits.shiftR` 2)

153− w1 = 0x80 + ((k .&. 3) `Bits.shiftL` 4)

154− ([w0,w1]++) <$> vectorOf 2 contByte

155− -- continuation bytes without a start byte

156− , listOf1 contByte

157− -- short 2-byte sequence

158− , (:[]) <$> choose (0xC2, 0xDF)

159− -- short 3-byte sequence

160− , (:) <$> choose (0xE0, 0xEF) <*> upTo 1 contByte

161− -- short 4-byte sequence

162− , (:) <$> choose (0xF0, 0xF4) <*> upTo 2 contByte

163− -- overlong encoding

164− , do k <- choose (0,0xFFFF)

165− let c = chr k

166− case k of

167− _ | k < 0x80 -> oneof [ let (w,x) = ord2 c in return [w,x]

168− , let (w,x,y) = ord3 c in return [w,x,y]

169− , let (w,x,y,z) = ord4 c in return [w,x,y,z] ]

170− | k < 0x7FF -> oneof [ let (w,x,y) = ord3 c in return [w,x,y]

171− , let (w,x,y,z) = ord4 c in return [w,x,y,z] ]

172− | otherwise -> let (w,x,y,z) = ord4 c in return [w,x,y,z]

173− ]

174− where

175− contByte = (0x80 +) <$> choose (0, 0x3f)

176− upTo n gen = do

177− k <- choose (0,n)

178− vectorOf k gen

179−

18099s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)

181100 where _types = s :: String

182101sf_Eq p s =

@@ -197,10 +116,8 @@ t_Show = show `eq` (show . T.pack)

197116tl_Show = show `eq` (show . TL.pack)

198117t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))

199118tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))

200−t_mconcat = unsquare $

201− mconcat `eq` (unpackS . mconcat . L.map T.pack)

202−tl_mconcat = unsquare $

203− mconcat `eq` (unpackS . mconcat . L.map TL.pack)

119+t_mconcat = mconcat `eq` (unpackS . mconcat . L.map T.pack)

120+tl_mconcat = mconcat `eq` (unpackS . mconcat . L.map TL.pack)

204121t_mempty = mempty == (unpackS (mempty :: T.Text))

205122tl_mempty = mempty == (unpackS (mempty :: TL.Text))

206123t_IsString = fromString `eqP` (T.unpack . fromString)

@@ -264,14 +181,11 @@ s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)

264181sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)

265182t_map f = map f `eqP` (unpackS . T.map f)

266183tl_map f = map f `eqP` (unpackS . TL.map f)

267−s_intercalate c = unsquare $

268− L.intercalate c `eq`

184+s_intercalate c = L.intercalate c `eq`

269185 (unpackS . S.intercalate (packS c) . map packS)

270−t_intercalate c = unsquare $

271− L.intercalate c `eq`

186+t_intercalate c = L.intercalate c `eq`

272187 (unpackS . T.intercalate (packS c) . map packS)

273−tl_intercalate c = unsquare $

274− L.intercalate c `eq`

188+tl_intercalate c = L.intercalate c `eq`

275189 (unpackS . TL.intercalate (TL.pack c) . map TL.pack)

276190s_intersperse c = L.intersperse c `eqP`

277191 (unpackS . S.intersperse c)

@@ -279,14 +193,10 @@ s_intersperse_s c = L.intersperse c `eqP`

279193 (unpackS . S.unstream . S.intersperse c)

280194sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`

281195 (unpackS . S.intersperse c . S.filter p)

282−t_intersperse c = unsquare $

283− L.intersperse c `eqP` (unpackS . T.intersperse c)

284−tl_intersperse c = unsquare $

285− L.intersperse c `eqP` (unpackS . TL.intersperse c)

286−t_transpose = unsquare $

287− L.transpose `eq` (map unpackS . T.transpose . map packS)

288−tl_transpose = unsquare $

289− L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)

196+t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)

197+tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)

198+t_transpose = L.transpose `eq` (map unpackS . T.transpose . map packS)

199+tl_transpose = L.transpose `eq` (map unpackS . TL.transpose . map TL.pack)

290200t_reverse = L.reverse `eqP` (unpackS . T.reverse)

291201tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)

292202t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)

@@ -298,7 +208,7 @@ tl_replace s d = (L.intercalate d . splitOn s) `eqP`

298208

299209splitOn :: (Eq a) => [a] -> [a] -> [[a]]

300210splitOn pat src0

301− | l == 0 = error "splitOn: empty"

211+ | l == 0 = error "empty"

302212 | otherwise = go src0

303213 where

304214 l = length pat

@@ -383,24 +293,17 @@ sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)

383293 where _types = f :: Char -> Char -> Char

384294t_foldr f z = L.foldr f z `eqP` T.foldr f z

385295 where _types = f :: Char -> Char -> Char

386−tl_foldr f z = unsquare $

387− L.foldr f z `eqP` TL.foldr f z

296+tl_foldr f z = L.foldr f z `eqP` TL.foldr f z

388297 where _types = f :: Char -> Char -> Char

389−sf_foldr1 p f = unsquare $

390− (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)

298+sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)

391299t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f

392−tl_foldr1 f = unsquare $

393− L.foldr1 f `eqP` TL.foldr1 f

300+tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f

394301

395−s_concat_s = unsquare $

396− L.concat `eq` (unpackS . S.unstream . S.concat . map packS)

397−sf_concat p = unsquare $

398− (L.concat . map (L.filter p)) `eq`

302+s_concat_s = L.concat `eq` (unpackS . S.unstream . S.concat . map packS)

303+sf_concat p = (L.concat . map (L.filter p)) `eq`

399304 (unpackS . S.concat . map (S.filter p . packS))

400−t_concat = unsquare $

401− L.concat `eq` (unpackS . T.concat . map packS)

402−tl_concat = unsquare $

403− L.concat `eq` (unpackS . TL.concat . map TL.pack)

305+t_concat = L.concat `eq` (unpackS . T.concat . map packS)

306+tl_concat = L.concat `eq` (unpackS . TL.concat . map TL.pack)

404307sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`

405308 (unpackS . S.concatMap (packS . f) . S.filter p)

406309t_concatMap f = unsquare $

@@ -440,10 +343,6 @@ t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)

440343tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)

441344 where _types = f :: Int -> Char -> (Int,Char)

442345

443−tl_repeat n = (L.take m . L.repeat) `eq`

444− (unpackS . TL.take (fromIntegral m) . TL.repeat)

445− where m = fromIntegral (n :: Word8)

446−

447346replicate n l = concat (L.replicate n l)

448347

449348s_replicate n = replicate m `eq`

@@ -455,14 +354,6 @@ tl_replicate n = replicate m `eq`

455354 (unpackS . TL.replicate (fromIntegral m) . packS)

456355 where m = fromIntegral (n :: Word8)

457356

458−tl_cycle n = (L.take m . L.cycle) `eq`

459− (unpackS . TL.take (fromIntegral m) . TL.cycle . packS)

460− where m = fromIntegral (n :: Word8)

461−

462−tl_iterate f n = (L.take m . L.iterate f) `eq`

463− (unpackS . TL.take (fromIntegral m) . TL.iterate f)

464− where m = fromIntegral (n :: Word8)

465−

466357unf :: Int -> Char -> Maybe (Char, Char)

467358unf n c | fromEnum c * 100 > n = Nothing

468359 | otherwise = Just (c, succ c)

@@ -489,22 +380,14 @@ s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)

489380sf_take p n = (L.take n . L.filter p) `eqP`

490381 (unpackS . S.take n . S.filter p)

491382t_take n = L.take n `eqP` (unpackS . T.take n)

492−t_takeEnd n = (L.reverse . L.take n . L.reverse) `eqP`

493− (unpackS . T.takeEnd n)

494383tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))

495−tl_takeEnd n = (L.reverse . L.take (fromIntegral n) . L.reverse) `eqP`

496− (unpackS . TL.takeEnd n)

497384s_drop n = L.drop n `eqP` (unpackS . S.drop n)

498385s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)

499386 where n = small m

500387sf_drop p n = (L.drop n . L.filter p) `eqP`

501388 (unpackS . S.drop n . S.filter p)

502389t_drop n = L.drop n `eqP` (unpackS . T.drop n)

503−t_dropEnd n = (L.reverse . L.drop n . L.reverse) `eqP`

504− (unpackS . T.dropEnd n)

505390tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))

506−tl_dropEnd n = (L.reverse . L.drop n . L.reverse) `eqP`

507− (unpackS . TL.dropEnd (fromIntegral n))

508391s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)

509392 where n = small m

510393s_take_drop_s m = (L.take n . L.drop n) `eqP`

@@ -516,10 +399,6 @@ sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`

516399 (unpackS . S.takeWhile p . S.filter q)

517400t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)

518401tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)

519−t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`

520− (unpackS . T.takeWhileEnd p)

521−tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`

522− (unpackS . TL.takeWhileEnd p)

523402s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

524403s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)

525404sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`

@@ -572,27 +451,24 @@ tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)

572451t_inits = L.inits `eqP` (map unpackS . T.inits)

573452tl_inits = L.inits `eqP` (map unpackS . TL.inits)

574453t_tails = L.tails `eqP` (map unpackS . T.tails)

575−tl_tails = unsquare $

576− L.tails `eqP` (map unpackS . TL.tails)

577−t_findAppendId = unsquare $ \(NotEmpty s) ts ->

454+tl_tails = L.tails `eqP` (map unpackS . TL.tails)

455+t_findAppendId (NotEmpty s) = unsquare $ \ts ->

578456 let t = T.intercalate s ts

579457 in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)

580−tl_findAppendId = unsquare $ \(NotEmpty s) ts ->

458+tl_findAppendId (NotEmpty s) = unsquare $ \ts ->

581459 let t = TL.intercalate s ts

582460 in all (==t) $ map (uncurry TL.append) (TL.breakOnAll s t)

583−t_findContains = unsquare $ \(NotEmpty s) ->

584− all (T.isPrefixOf s . snd) . T.breakOnAll s . T.intercalate s

585−tl_findContains = unsquare $ \(NotEmpty s) -> all (TL.isPrefixOf s . snd) .

461+t_findContains (NotEmpty s) = all (T.isPrefixOf s . snd) . T.breakOnAll s .

462+ T.intercalate s

463+tl_findContains (NotEmpty s) = all (TL.isPrefixOf s . snd) .

586464 TL.breakOnAll s . TL.intercalate s

587465sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c

588466t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s

589467tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s

590468

591−t_splitOn_split s = unsquare $

592− (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s

593−tl_splitOn_split s = unsquare $

594− ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`

595− (map TL.fromStrict . T.splitOn s)) . T.intercalate s

469+t_splitOn_split s = (T.splitOn s `eq` Slow.splitOn s) . T.intercalate s

470+tl_splitOn_split s = ((TL.splitOn (TL.fromStrict s) . TL.fromStrict) `eq`

471+ (map TL.fromStrict . T.splitOn s)) . T.intercalate s

596472t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)

597473tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)

598474

@@ -634,14 +510,10 @@ t_lines' = lines' `eqP` (map unpackS . T.lines')

634510t_words = L.words `eqP` (map unpackS . T.words)

635511

636512tl_words = L.words `eqP` (map unpackS . TL.words)

637−t_unlines = unsquare $

638− L.unlines `eq` (unpackS . T.unlines . map packS)

639−tl_unlines = unsquare $

640− L.unlines `eq` (unpackS . TL.unlines . map packS)

641−t_unwords = unsquare $

642− L.unwords `eq` (unpackS . T.unwords . map packS)

643−tl_unwords = unsquare $

644− L.unwords `eq` (unpackS . TL.unwords . map packS)

513+t_unlines = L.unlines `eq` (unpackS . T.unlines . map packS)

514+tl_unlines = L.unlines `eq` (unpackS . TL.unlines . map packS)

515+t_unwords = L.unwords `eq` (unpackS . T.unwords . map packS)

516+tl_unwords = L.unwords `eq` (unpackS . TL.unwords . map packS)

645517

646518s_isPrefixOf s = L.isPrefixOf s `eqP`

647519 (S.isPrefixOf (S.stream $ packS s) . S.stream)

@@ -718,9 +590,8 @@ t_indices (NotEmpty s) = Slow.indices s `eq` indices s

718590tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s

719591 where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)

720592 conc = T.concat . TL.toChunks

721−t_indices_occurs = unsquare $ \(NotEmpty t) ts ->

722− let s = T.intercalate t ts

723− in Slow.indices t s == indices t s

593+t_indices_occurs (NotEmpty t) ts = let s = T.intercalate t ts

594+ in Slow.indices t s == indices t s

724595

725596-- Bit shifts.

726597shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k

@@ -739,76 +610,17 @@ shiftR_Word32 = shiftR :: Word32 -> Property

739610

740611-- Builder.

741612

742−tb_singleton = id `eqP`

743− (unpackS . TB.toLazyText . mconcat . map TB.singleton)

744−tb_fromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .

613+t_builderSingleton = id `eqP`

614+ (unpackS . TB.toLazyText . mconcat . map TB.singleton)

615+t_builderFromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .

745616 map (TB.fromText . packS))

746−tb_associative s1 s2 s3 =

617+t_builderAssociative s1 s2 s3 =

747618 TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==

748619 TB.toLazyText ((b1 `mappend` b2) `mappend` b3)

749620 where b1 = TB.fromText (packS s1)

750621 b2 = TB.fromText (packS s2)

751622 b3 = TB.fromText (packS s3)

752623

753−-- Numeric builder stuff.

754−

755−tb_decimal :: (Integral a, Show a) => a -> Bool

756−tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)

757−

758−tb_decimal_integer (a::Integer) = tb_decimal a

759−tb_decimal_integer_big (Big a) = tb_decimal a

760−tb_decimal_int (a::Int) = tb_decimal a

761−tb_decimal_int8 (a::Int8) = tb_decimal a

762−tb_decimal_int16 (a::Int16) = tb_decimal a

763−tb_decimal_int32 (a::Int32) = tb_decimal a

764−tb_decimal_int64 (a::Int64) = tb_decimal a

765−tb_decimal_word (a::Word) = tb_decimal a

766−tb_decimal_word8 (a::Word8) = tb_decimal a

767−tb_decimal_word16 (a::Word16) = tb_decimal a

768−tb_decimal_word32 (a::Word32) = tb_decimal a

769−tb_decimal_word64 (a::Word64) = tb_decimal a

770−

771−tb_decimal_big_int (BigBounded (a::Int)) = tb_decimal a

772−tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a

773−tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a

774−tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a

775−

776−tb_hex :: (Integral a, Show a) => a -> Bool

777−tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")

778−

779−tb_hexadecimal_integer (a::Integer) = tb_hex a

780−tb_hexadecimal_int (a::Int) = tb_hex a

781−tb_hexadecimal_int8 (a::Int8) = tb_hex a

782−tb_hexadecimal_int16 (a::Int16) = tb_hex a

783−tb_hexadecimal_int32 (a::Int32) = tb_hex a

784−tb_hexadecimal_int64 (a::Int64) = tb_hex a

785−tb_hexadecimal_word (a::Word) = tb_hex a

786−tb_hexadecimal_word8 (a::Word8) = tb_hex a

787−tb_hexadecimal_word16 (a::Word16) = tb_hex a

788−tb_hexadecimal_word32 (a::Word32) = tb_hex a

789−tb_hexadecimal_word64 (a::Word64) = tb_hex a

790−

791−tb_realfloat :: (RealFloat a, Show a) => a -> Bool

792−tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)

793−

794−tb_realfloat_float (a::Float) = tb_realfloat a

795−tb_realfloat_double (a::Double) = tb_realfloat a

796−

797−showFloat :: (RealFloat a) => TB.FPFormat -> Maybe Int -> a -> ShowS

798−showFloat TB.Exponent = showEFloat

799−showFloat TB.Fixed = showFFloat

800−showFloat TB.Generic = showGFloat

801−

802−tb_formatRealFloat :: (RealFloat a, Show a) =>

803− a -> TB.FPFormat -> Precision a -> Property

804−tb_formatRealFloat a fmt prec =

805− TB.formatRealFloat fmt p a ===

806− TB.fromString (showFloat fmt p a "")

807− where p = precision a prec

808−

809−tb_formatRealFloat_float (a::Float) = tb_formatRealFloat a

810−tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a

811−

812624-- Reading.

813625

814626t_decimal (n::Int) s =

@@ -817,18 +629,16 @@ t_decimal (n::Int) s =

817629tl_decimal (n::Int) s =

818630 TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)

819631 where t = TL.dropWhile isDigit s

820−t_hexadecimal m s ox =

632+t_hexadecimal (n::Positive Int) s ox =

821633 T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)

822634 where t = T.dropWhile isHexDigit s

823635 p = if ox then "0x" else ""

824− n = getPositive m :: Int

825−tl_hexadecimal m s ox =

636+tl_hexadecimal (n::Positive Int) s ox =

826637 TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)

827638 where t = TL.dropWhile isHexDigit s

828639 p = if ox then "0x" else ""

829− n = getPositive m :: Int

830640

831−isFloaty c = c `elem` ("+-.0123456789eE" :: String)

641+isFloaty c = c `elem` "+-.0123456789eE"

832642

833643t_read_rational p tol (n::Double) s =

834644 case p (T.pack (show n) `T.append` t) of

@@ -871,8 +681,6 @@ t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t

871681 where n = small m

872682t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)

873683

874−t_copy t = T.copy t == t

875−

876684-- Regression tests.

877685s_filter_eq s = S.filter p t == S.streamList (filter p s)

878686 where p = (/= S.last t)

@@ -883,7 +691,7 @@ s_filter_eq s = S.filter p t == S.streamList (filter p s)

883691-- themselves.

884692shorten :: Int -> S.Stream a -> S.Stream a

885693shorten n t@(S.Stream arr off len)

886− | n > 0 = S.Stream arr off (smaller (exactSize n) len)

694+ | n > 0 = S.Stream arr off (smaller (exactSize n) len)

887695 | otherwise = t

888696

889697tests :: Test

@@ -905,12 +713,8 @@ tests =

905713 testGroup "transcoding" [

906714 testProperty "t_ascii" t_ascii,

907715 testProperty "tl_ascii" tl_ascii,

908− testProperty "t_latin1" t_latin1,

909− testProperty "tl_latin1" tl_latin1,

910716 testProperty "t_utf8" t_utf8,

911717 testProperty "t_utf8'" t_utf8',

912− testProperty "t_utf8_incr" t_utf8_incr,

913− testProperty "t_utf8_undecoded" t_utf8_undecoded,

914718 testProperty "tl_utf8" tl_utf8,

915719 testProperty "tl_utf8'" tl_utf8',

916720 testProperty "t_utf16LE" t_utf16LE,

@@ -1110,12 +914,9 @@ tests =

1110914 ],

1111915

1112916 testGroup "unfolds" [

1113− testProperty "tl_repeat" tl_repeat,

1114917 testProperty "s_replicate" s_replicate,

1115918 testProperty "t_replicate" t_replicate,

1116919 testProperty "tl_replicate" tl_replicate,

1117− testProperty "tl_cycle" tl_cycle,

1118− testProperty "tl_iterate" tl_iterate,

1119920 testProperty "t_unfoldr" t_unfoldr,

1120921 testProperty "tl_unfoldr" tl_unfoldr,

1121922 testProperty "t_unfoldrN" t_unfoldrN,

@@ -1129,16 +930,12 @@ tests =

1129930 testProperty "s_take_s" s_take_s,

1130931 testProperty "sf_take" sf_take,

1131932 testProperty "t_take" t_take,

1132− testProperty "t_takeEnd" t_takeEnd,

1133933 testProperty "tl_take" tl_take,

1134− testProperty "tl_takeEnd" tl_takeEnd,

1135934 testProperty "s_drop" s_drop,

1136935 testProperty "s_drop_s" s_drop_s,

1137936 testProperty "sf_drop" sf_drop,

1138937 testProperty "t_drop" t_drop,

1139− testProperty "t_dropEnd" t_dropEnd,

1140938 testProperty "tl_drop" tl_drop,

1141− testProperty "tl_dropEnd" tl_dropEnd,

1142939 testProperty "s_take_drop" s_take_drop,

1143940 testProperty "s_take_drop_s" s_take_drop_s,

1144941 testProperty "s_takeWhile" s_takeWhile,

@@ -1146,8 +943,6 @@ tests =

1146943 testProperty "sf_takeWhile" sf_takeWhile,

1147944 testProperty "t_takeWhile" t_takeWhile,

1148945 testProperty "tl_takeWhile" tl_takeWhile,

1149− testProperty "t_takeWhileEnd" t_takeWhileEnd,

1150− testProperty "tl_takeWhileEnd" tl_takeWhileEnd,

1151946 testProperty "sf_dropWhile" sf_dropWhile,

1152947 testProperty "s_dropWhile" s_dropWhile,

1153948 testProperty "s_dropWhile_s" s_dropWhile_s,

@@ -1285,46 +1080,9 @@ tests =

12851080 ],

12861081

12871082 testGroup "builder" [

1288− testProperty "tb_associative" tb_associative,

1289− testGroup "decimal" [

1290− testProperty "tb_decimal_int" tb_decimal_int,

1291− testProperty "tb_decimal_int8" tb_decimal_int8,

1292− testProperty "tb_decimal_int16" tb_decimal_int16,

1293− testProperty "tb_decimal_int32" tb_decimal_int32,

1294− testProperty "tb_decimal_int64" tb_decimal_int64,

1295− testProperty "tb_decimal_integer" tb_decimal_integer,

1296− testProperty "tb_decimal_integer_big" tb_decimal_integer_big,

1297− testProperty "tb_decimal_word" tb_decimal_word,

1298− testProperty "tb_decimal_word8" tb_decimal_word8,

1299− testProperty "tb_decimal_word16" tb_decimal_word16,

1300− testProperty "tb_decimal_word32" tb_decimal_word32,

1301− testProperty "tb_decimal_word64" tb_decimal_word64,

1302− testProperty "tb_decimal_big_int" tb_decimal_big_int,

1303− testProperty "tb_decimal_big_word" tb_decimal_big_word,

1304− testProperty "tb_decimal_big_int64" tb_decimal_big_int64,

1305− testProperty "tb_decimal_big_word64" tb_decimal_big_word64

1306− ],

1307− testGroup "hexadecimal" [

1308− testProperty "tb_hexadecimal_int" tb_hexadecimal_int,

1309− testProperty "tb_hexadecimal_int8" tb_hexadecimal_int8,

1310− testProperty "tb_hexadecimal_int16" tb_hexadecimal_int16,

1311− testProperty "tb_hexadecimal_int32" tb_hexadecimal_int32,

1312− testProperty "tb_hexadecimal_int64" tb_hexadecimal_int64,

1313− testProperty "tb_hexadecimal_integer" tb_hexadecimal_integer,

1314− testProperty "tb_hexadecimal_word" tb_hexadecimal_word,

1315− testProperty "tb_hexadecimal_word8" tb_hexadecimal_word8,

1316− testProperty "tb_hexadecimal_word16" tb_hexadecimal_word16,

1317− testProperty "tb_hexadecimal_word32" tb_hexadecimal_word32,

1318− testProperty "tb_hexadecimal_word64" tb_hexadecimal_word64

1319− ],

1320− testGroup "realfloat" [

1321− testProperty "tb_realfloat_double" tb_realfloat_double,

1322− testProperty "tb_realfloat_float" tb_realfloat_float,

1323− testProperty "tb_formatRealFloat_float" tb_formatRealFloat_float,

1324− testProperty "tb_formatRealFloat_double" tb_formatRealFloat_double

1325− ],

1326− testProperty "tb_fromText" tb_fromText,

1327− testProperty "tb_singleton" tb_singleton

1083+ testProperty "t_builderSingleton" t_builderSingleton,

1084+ testProperty "t_builderFromText" t_builderFromText,

1085+ testProperty "t_builderAssociative" t_builderAssociative

13281086 ],

13291087

13301088 testGroup "read" [

@@ -1355,9 +1113,6 @@ tests =

13551113 testProperty "t_dropWord16" t_dropWord16,

13561114 testProperty "t_takeWord16" t_takeWord16,

13571115 testProperty "t_take_drop_16" t_take_drop_16,

1358− testProperty "t_use_from" t_use_from,

1359− testProperty "t_copy" t_copy

1360− ],

1361−

1362− testGroup "mul" Mul.tests

1116+ testProperty "t_use_from" t_use_from

1117+ ]

13631118 ]

tests/Tests/QuickCheckUtils.hs → tests/tests/src/Data/Text/Tests/QuickCheckUtils.hsrenamed+87−110

@@ -1,100 +1,116 @@

11-- | This module provides quickcheck utilities, e.g. arbitrary and show

22-- instances, and comparison functions, so we can focus on the actual properties

3−-- in the 'Tests.Properties' module.

3+-- in the 'Data.Text.Tests.Properties' module.

44--

55{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}

66{-# OPTIONS_GHC -fno-warn-orphans #-}

7−module Tests.QuickCheckUtils

7+module Data.Text.Tests.QuickCheckUtils

88 (

99 genUnicode

1010 , unsquare

1111 , smallArbitrary

1212

13− , BigBounded(..)

14− , BigInt(..)

15− , NotEmpty(..)

13+ , NotEmpty (..)

1614

17− , Small(..)

15+ , Small (..)

1816 , small

1917

20− , Precision(..)

21− , precision

22−

2318 , integralRandomR

2419

25− , DecodeErr(..)

26− , genDecodeErr

20+ , DecodeErr (..)

2721

28− , Stringy(..)

22+ , Stringy (..)

2923 , eq

3024 , eqP

3125

32− , Encoding(..)

33−

26+ , Encoding (..)

27+

3428 , write_read

3529 ) where

3630

37−import Control.Applicative ((<$>))

3831import Control.Arrow (first, (***))

3932import Control.DeepSeq (NFData (..), deepseq)

4033import Control.Exception (bracket)

34+import Data.Bits ((.&.))

35+import Data.Char (chr)

36+import Data.Word (Word8, Word16)

4137import Data.String (IsString, fromString)

4238import Data.Text.Foreign (I16)

43−import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))

44−import Data.Word (Word8, Word16)

4539import Debug.Trace (trace)

46−import System.Random (Random(..), RandomGen)

47−import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))

40+import System.Random (Random (..), RandomGen)

41+import Test.QuickCheck hiding ((.&.))

4842import Test.QuickCheck.Monadic (assert, monadicIO, run)

49−import Test.QuickCheck.Unicode (string)

50−import Tests.Utils

5143import qualified Data.ByteString as B

5244import qualified Data.Text as T

5345import qualified Data.Text.Encoding.Error as T

54−import qualified Data.Text.Internal.Fusion as TF

55−import qualified Data.Text.Internal.Fusion.Common as TF

56−import qualified Data.Text.Internal.Lazy as TL

57−import qualified Data.Text.Internal.Lazy.Fusion as TLF

46+import qualified Data.Text.Fusion as TF

47+import qualified Data.Text.Fusion.Common as TF

5848import qualified Data.Text.Lazy as TL

49+import qualified Data.Text.Lazy.Fusion as TLF

50+import qualified Data.Text.Lazy.Internal as TL

5951import qualified System.IO as IO

6052

61−#if !MIN_VERSION_base(4,4,0)

62−import Data.Int (Int64)

63−import Data.Word (Word, Word64)

64−#endif

65−

66−genUnicode :: IsString a => Gen a

67−genUnicode = fromString <$> string

53+import Data.Text.Tests.Utils

6854

6955instance Random I16 where

7056 randomR = integralRandomR

7157 random = randomR (minBound,maxBound)

7258

7359instance Arbitrary I16 where

74− arbitrary = arbitrarySizedIntegral

75− shrink = shrinkIntegral

60+ arbitrary = choose (minBound,maxBound)

7661

7762instance Arbitrary B.ByteString where

7863 arbitrary = B.pack `fmap` arbitrary

79− shrink = map B.pack . shrink . B.unpack

80−

81−#if !MIN_VERSION_base(4,4,0)

82−instance Random Int64 where

83− randomR = integralRandomR

84− random = randomR (minBound,maxBound)

85−

86−instance Random Word where

87− randomR = integralRandomR

88− random = randomR (minBound,maxBound)

8964

90−instance Random Word8 where

91− randomR = integralRandomR

92− random = randomR (minBound,maxBound)

93−

94−instance Random Word64 where

95− randomR = integralRandomR

96− random = randomR (minBound,maxBound)

97−#endif

65+genUnicode :: IsString a => Gen a

66+genUnicode = fmap fromString string where

67+ string = sized $ \n ->

68+ do k <- choose (0,n)

69+ sequence [ char | _ <- [1..k] ]

70+

71+ excluding :: [a -> Bool] -> Gen a -> Gen a

72+ excluding bad gen = loop

73+ where

74+ loop = do

75+ x <- gen

76+ if or (map ($ x) bad)

77+ then loop

78+ else return x

79+

80+ reserved = [lowSurrogate, highSurrogate, noncharacter]

81+ lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF

82+ highSurrogate c = c >= 0xD800 && c <= 0xDBFF

83+ noncharacter c = masked == 0xFFFE || masked == 0xFFFF

84+ where

85+ masked = c .&. 0xFFFF

86+

87+ ascii = choose (0,0x7F)

88+ plane0 = choose (0xF0, 0xFFFF)

89+ plane1 = oneof [ choose (0x10000, 0x10FFF)

90+ , choose (0x11000, 0x11FFF)

91+ , choose (0x12000, 0x12FFF)

92+ , choose (0x13000, 0x13FFF)

93+ , choose (0x1D000, 0x1DFFF)

94+ , choose (0x1F000, 0x1FFFF)

95+ ]

96+ plane2 = oneof [ choose (0x20000, 0x20FFF)

97+ , choose (0x21000, 0x21FFF)

98+ , choose (0x22000, 0x22FFF)

99+ , choose (0x23000, 0x23FFF)

100+ , choose (0x24000, 0x24FFF)

101+ , choose (0x25000, 0x25FFF)

102+ , choose (0x26000, 0x26FFF)

103+ , choose (0x27000, 0x27FFF)

104+ , choose (0x28000, 0x28FFF)

105+ , choose (0x29000, 0x29FFF)

106+ , choose (0x2A000, 0x2AFFF)

107+ , choose (0x2B000, 0x2BFFF)

108+ , choose (0x2F000, 0x2FFFF)

109+ ]

110+ plane14 = choose (0xE0000, 0xE0FFF)

111+ planes = [ascii, plane0, plane1, plane2, plane14]

112+

113+ char = chr `fmap` excluding reserved (oneof planes)

98114

99115-- For tests that have O(n^2) running times or input sizes, resize

100116-- their inputs to the square root of the originals.

@@ -107,25 +123,9 @@ smallArbitrary = sized $ \n -> resize (smallish n) arbitrary

107123

108124instance Arbitrary T.Text where

109125 arbitrary = T.pack `fmap` arbitrary

110− shrink = map T.pack . shrink . T.unpack

111126

112127instance Arbitrary TL.Text where

113128 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary

114− shrink = map TL.pack . shrink . TL.unpack

115−

116−newtype BigInt = Big Integer

117− deriving (Eq, Show)

118−

119−instance Arbitrary BigInt where

120− arbitrary = choose (1::Int,200) >>= \e -> Big <$> choose (10^(e-1),10^e)

121− shrink (Big a) = [Big (a `div` 2^(l-e)) | e <- shrink l]

122− where l = truncate (log (fromIntegral a) / log 2 :: Double) :: Integer

123−

124−newtype BigBounded a = BigBounded a

125− deriving (Eq, Show)

126−

127−instance (Bounded a, Random a, Arbitrary a) => Arbitrary (BigBounded a) where

128− arbitrary = BigBounded <$> choose (minBound, maxBound)

129129

130130newtype NotEmpty a = NotEmpty { notEmpty :: a }

131131 deriving (Eq, Ord)

@@ -138,23 +138,15 @@ instance Functor NotEmpty where

138138

139139instance Arbitrary a => Arbitrary (NotEmpty [a]) where

140140 arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))

141− shrink = shrinkNotEmpty null

142141

143142instance Arbitrary (NotEmpty T.Text) where

144143 arbitrary = (fmap T.pack) `fmap` arbitrary

145− shrink = shrinkNotEmpty T.null

146144

147145instance Arbitrary (NotEmpty TL.Text) where

148146 arbitrary = (fmap TL.pack) `fmap` arbitrary

149− shrink = shrinkNotEmpty TL.null

150147

151148instance Arbitrary (NotEmpty B.ByteString) where

152149 arbitrary = (fmap B.pack) `fmap` arbitrary

153− shrink = shrinkNotEmpty B.null

154−

155−shrinkNotEmpty :: Arbitrary a => (a -> Bool) -> NotEmpty a -> [NotEmpty a]

156−shrinkNotEmpty isNull (NotEmpty xs) =

157− [ NotEmpty xs' | xs' <- shrink xs, not (isNull xs') ]

158150

159151data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7

160152 | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15

@@ -195,25 +187,23 @@ instance Random Small where

195187 random = randomR (minBound,maxBound)

196188

197189instance Arbitrary Small where

198− arbitrary = choose (minBound, maxBound)

199− shrink = shrinkIntegral

190+ arbitrary = choose (minBound,maxBound)

200191

201192integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)

202193integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,

203194 fromIntegral b :: Integer) g of

204195 (x,h) -> (fromIntegral x, h)

205196

206−data DecodeErr = Lenient | Ignore | Strict | Replace

207− deriving (Show, Eq)

197+data DecodeErr = DE String T.OnDecodeError

208198

209−genDecodeErr :: DecodeErr -> Gen T.OnDecodeError

210−genDecodeErr Lenient = return T.lenientDecode

211−genDecodeErr Ignore = return T.ignore

212−genDecodeErr Strict = return T.strictDecode

213−genDecodeErr Replace = arbitrary

199+instance Show DecodeErr where

200+ show (DE d _) = "DE " ++ d

214201

215202instance Arbitrary DecodeErr where

216− arbitrary = elements [Lenient, Ignore, Strict, Replace]

203+ arbitrary = oneof [ return $ DE "lenient" T.lenientDecode

204+ , return $ DE "ignore" T.ignore

205+ , return $ DE "strict" T.strictDecode

206+ , DE "replace" `fmap` arbitrary ]

217207

218208class Stringy s where

219209 packS :: String -> s

@@ -267,30 +257,6 @@ eqP f g s w = eql "orig" (f s) (g t) &&

267257 | a =^= b = True

268258 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False

269259

270−instance Arbitrary FPFormat where

271− arbitrary = elements [Exponent, Fixed, Generic]

272−

273−newtype Precision a = Precision (Maybe Int)

274− deriving (Eq, Show)

275−

276−precision :: a -> Precision a -> Maybe Int

277−precision _ (Precision prec) = prec

278−

279−arbitraryPrecision :: Int -> Gen (Precision a)

280−arbitraryPrecision maxDigits = Precision <$> do

281− n <- choose (-1,maxDigits)

282− return $ if n == -1

283− then Nothing

284− else Just n

285−

286−instance Arbitrary (Precision Float) where

287− arbitrary = arbitraryPrecision 11

288− shrink = map Precision . shrink . precision undefined

289−

290−instance Arbitrary (Precision Double) where

291− arbitrary = arbitraryPrecision 22

292− shrink = map Precision . shrink . precision undefined

293−

294260-- Work around lack of Show instance for TextEncoding.

295261data Encoding = E String IO.TextEncoding

296262

@@ -308,6 +274,17 @@ windowsNewlineMode = IO.NewlineMode

308274 { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF

309275 }

310276

277+-- Newline and NewlineMode have standard Show instance from GHC 7 onwards

278+#if __GLASGOW_HASKELL__ < 700

279+instance Show IO.Newline where

280+ show IO.CRLF = "CRLF"

281+ show IO.LF = "LF"

282+

283+instance Show IO.NewlineMode where

284+ show (IO.NewlineMode i o) = "NewlineMode { inputNL = " ++ show i ++

285+ ", outputNL = " ++ show o ++ " }"

286+# endif

287+

311288instance Arbitrary IO.NewlineMode where

312289 arbitrary = oneof . map return $

313290 [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode

tests/Tests/Regressions.hs → tests/tests/src/Data/Text/Tests/Regressions.hsrenamed+3−28

@@ -1,27 +1,24 @@

11-- | Regression tests for specific bugs.

22--

33{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

4−module Tests.Regressions

4+module Data.Text.Tests.Regressions

55 (

66 tests

77 ) where

99import Control.Exception (SomeException, handle)

1010import System.IO

11−import Test.HUnit (assertBool, assertEqual, assertFailure)

11+import Test.HUnit (assertFailure)

1212import qualified Data.ByteString as B

13−import Data.ByteString.Char8 ()

1413import qualified Data.ByteString.Lazy as LB

1514import qualified Data.Text as T

16−import qualified Data.Text.Encoding as TE

1715import qualified Data.Text.IO as T

1816import qualified Data.Text.Lazy as LT

1917import qualified Data.Text.Lazy.Encoding as LE

20−import qualified Data.Text.Unsafe as T

2118import qualified Test.Framework as F

2219import qualified Test.Framework.Providers.HUnit as F

2320

24−import Tests.Utils (withTempFile)

21+import Data.Text.Tests.Utils (withTempFile)

2522

2623-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring

2724-- caused either a segfault or attempt to allocate a negative number

@@ -52,31 +49,9 @@ replicate_crash = handle (\(_::SomeException) -> return ()) $

5249 power | maxBound == (2147483647::Int) = 28

5350 | otherwise = 60 :: Int

5451

55−-- Reported by John Millikin: a UTF-8 decode error handler could

56−-- return a bogus substitution character, which we would write without

57−-- checking.

58−utf8_decode_unsafe :: IO ()

59−utf8_decode_unsafe = do

60− let t = TE.decodeUtf8With (\_ _ -> Just '\xdc00') "\x80"

61− assertBool "broken error recovery shouldn't break us" (t == "\xfffd")

62−

63−-- Reported by Eric Seidel: we mishandled mapping Chars that fit in a

64−-- single Word16 to Chars that require two.

65−mapAccumL_resize :: IO ()

66−mapAccumL_resize = do

67− let f a _ = (a, '\65536')

68− count = 5

69− val = T.mapAccumL f (0::Int) (T.replicate count "a")

70− assertEqual "mapAccumL should correctly fill buffers for two-word results"

71− (0, T.replicate count "\65536") val

72− assertEqual "mapAccumL should correctly size buffers for two-word results"

73− (count * 2) (T.lengthWord16 (snd val))

74−

7552tests :: F.Test

7653tests = F.testGroup "Regressions"

7754 [ F.testCase "hGetContents_crash" hGetContents_crash

7855 , F.testCase "lazy_encode_crash" lazy_encode_crash

79− , F.testCase "mapAccumL_resize" mapAccumL_resize

8056 , F.testCase "replicate_crash" replicate_crash

81− , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe

8257 ]

tests/Tests/SlowFunctions.hs → tests/tests/src/Data/Text/Tests/SlowFunctions.hsrenamed+1−1

@@ -1,5 +1,5 @@

11{-# LANGUAGE BangPatterns #-}

2−module Tests.SlowFunctions

2+module Data.Text.Tests.SlowFunctions

33 (

44 indices

55 , splitOn

tests/Tests/Utils.hs → tests/tests/src/Data/Text/Tests/Utils.hsrenamed+1−1

@@ -1,7 +1,7 @@

11-- | Miscellaneous testing utilities

22--

33{-# LANGUAGE ScopedTypeVariables #-}

4−module Tests.Utils

4+module Data.Text.Tests.Utils

55 (

66 (=^=)

77 , withRedirect

tests/tests/text-tests.cabalnew file+124

@@ -0,0 +1,124 @@

1+name: text-tests

2+version: 0.0.0.0

3+synopsis: Functional tests for the text package

4+description: Functional tests for the text package

5+homepage: https://bitbucket.org/bos/text

6+license: BSD3

7+license-file: ../../LICENSE

8+author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

9+ Bryan O'Sullivan <bos@serpentine.com>,

10+ Tom Harper <rtomharper@googlemail.com>,

11+ Duncan Coutts <duncan@haskell.org>

12+maintainer: Bryan O'Sullivan <bos@serpentine.com>

13+category: Text

14+build-type: Simple

15+

16+cabal-version: >=1.8

17+

18+flag hpc

19+ description: Enable HPC to generate coverage reports

20+ default: False

21+

22+executable text-tests

23+ hs-source-dirs: src

24+ main-is: Data/Text/Tests.hs

25+

26+ ghc-options:

27+ -Wall -threaded -O0 -rtsopts

28+

29+ if flag(hpc)

30+ ghc-options:

31+ -fhpc

32+

33+ cpp-options:

34+ -DASSERTS

35+ -DHAVE_DEEPSEQ

36+

37+ build-depends:

38+ text-tests,

39+ base >= 4 && < 5,

40+ bytestring >= 0.9 && < 0.10,

41+ deepseq >= 1.1,

42+ directory >= 1.1 && < 1.2,

43+ random >= 1.0 && < 1.1,

44+ QuickCheck >= 2.4 && < 2.5,

45+ HUnit >= 1.2 && < 1.3,

46+ test-framework >= 0.4 && < 0.5,

47+ test-framework-quickcheck2 >= 0.2 && < 0.3,

48+ test-framework-hunit >= 0.2 && < 0.3

49+

50+executable text-tests-stdio

51+ hs-source-dirs: src

52+ main-is: Data/Text/Tests/IO.hs

53+

54+ ghc-options:

55+ -Wall -threaded -rtsopts

56+

57+ -- Optional HPC support

58+ if flag(hpc)

59+ ghc-options:

60+ -fhpc

61+

62+ build-depends:

63+ text-tests,

64+ base >= 4 && < 5

65+

66+library

67+ hs-source-dirs: ../..

68+ c-sources: ../../cbits/cbits.c

69+ exposed-modules:

70+ Data.Text

71+ Data.Text.Array

72+ Data.Text.Encoding

73+ Data.Text.Encoding.Error

74+ Data.Text.Foreign

75+ Data.Text.IO

76+ Data.Text.Internal

77+ Data.Text.Lazy

78+ Data.Text.Lazy.Builder

79+ Data.Text.Lazy.Builder.Int

80+ Data.Text.Lazy.Builder.RealFloat

81+ Data.Text.Lazy.Encoding

82+ Data.Text.Lazy.IO

83+ Data.Text.Lazy.Internal

84+ Data.Text.Lazy.Read

85+ Data.Text.Read

86+ Data.Text.Encoding.Fusion

87+ Data.Text.Encoding.Fusion.Common

88+ Data.Text.Encoding.Utf16

89+ Data.Text.Encoding.Utf32

90+ Data.Text.Encoding.Utf8

91+ Data.Text.Fusion

92+ Data.Text.Fusion.CaseMapping

93+ Data.Text.Fusion.Common

94+ Data.Text.Fusion.Internal

95+ Data.Text.Fusion.Size

96+ Data.Text.IO.Internal

97+ Data.Text.Lazy.Builder.Functions

98+ Data.Text.Lazy.Builder.RealFloat.Functions

99+ Data.Text.Lazy.Encoding.Fusion

100+ Data.Text.Lazy.Fusion

101+ Data.Text.Lazy.Search

102+ Data.Text.Search

103+ Data.Text.Unsafe

104+ Data.Text.Unsafe.Base

105+ Data.Text.UnsafeChar

106+ Data.Text.UnsafeShift

107+ Data.Text.Util

108+

109+ if flag(hpc)

110+ ghc-options:

111+ -fhpc

112+

113+ cpp-options:

114+ -DHAVE_DEEPSEQ

115+ -DASSERTS

116+ -DINTEGER_GMP

117+

118+ build-depends:

119+ array,

120+ base >= 4 && < 5,

121+ bytestring >= 0.9 && < 1.0,

122+ deepseq >= 1.1,

123+ integer-gmp >= 0.2 && < 0.3,

124+ ghc-prim >= 0.2 && < 0.3

tests/text-tests.cabaldeleted−143

@@ -1,143 +0,0 @@

1−name: text-tests

2−version: 0.0.0.0

3−synopsis: Functional tests for the text package

4−description: Functional tests for the text package

5−homepage: https://github.com/bos/text

6−license: BSD2

7−license-file: ../LICENSE

8−author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

9− Bryan O'Sullivan <bos@serpentine.com>,

10− Tom Harper <rtomharper@googlemail.com>,

11− Duncan Coutts <duncan@haskell.org>

12−maintainer: Bryan O'Sullivan <bos@serpentine.com>

13−category: Text

14−build-type: Simple

15−

16−cabal-version: >=1.8

17−

18−flag hpc

19− description: Enable HPC to generate coverage reports

20− default: False

21− manual: True

22−

23−executable text-tests

24− main-is: Tests.hs

25−

26− other-modules:

27− Tests.IO

28− Tests.Properties

29− Tests.Properties.Mul

30− Tests.QuickCheckUtils

31− Tests.Regressions

32− Tests.SlowFunctions

33− Tests.Utils

34−

35− ghc-options:

36− -Wall -threaded -O0 -rtsopts

37−

38− if flag(hpc)

39− ghc-options:

40− -fhpc

41−

42− cpp-options:

43− -DTEST_SUITE

44− -DASSERTS

45− -DHAVE_DEEPSEQ

46−

47− build-depends:

48− HUnit >= 1.2,

49− QuickCheck >= 2.7,

50− base == 4.*,

51− bytestring,

52− deepseq,

53− directory,

54− quickcheck-unicode,

55− random,

56− test-framework >= 0.4,

57− test-framework-hunit >= 0.2,

58− test-framework-quickcheck2 >= 0.2,

59− text-tests

60−

61−executable text-tests-stdio

62− main-is: Tests/IO.hs

63−

64− ghc-options:

65− -Wall -threaded -rtsopts

66−

67− -- Optional HPC support

68− if flag(hpc)

69− ghc-options:

70− -fhpc

71−

72− build-depends:

73− text-tests,

74− base >= 4 && < 5

75−

76−library

77− hs-source-dirs: ..

78− c-sources: ../cbits/cbits.c

79− include-dirs: ../include

80− ghc-options: -Wall

81− exposed-modules:

82− Data.Text

83− Data.Text.Array

84− Data.Text.Encoding

85− Data.Text.Encoding.Error

86− Data.Text.Internal.Encoding.Fusion

87− Data.Text.Internal.Encoding.Fusion.Common

88− Data.Text.Internal.Encoding.Utf16

89− Data.Text.Internal.Encoding.Utf32

90− Data.Text.Internal.Encoding.Utf8

91− Data.Text.Foreign

92− Data.Text.Internal.Fusion

93− Data.Text.Internal.Fusion.CaseMapping

94− Data.Text.Internal.Fusion.Common

95− Data.Text.Internal.Fusion.Size

96− Data.Text.Internal.Fusion.Types

97− Data.Text.IO

98− Data.Text.Internal.IO

99− Data.Text.Internal

100− Data.Text.Lazy

101− Data.Text.Lazy.Builder

102− Data.Text.Internal.Builder.Functions

103− Data.Text.Lazy.Builder.Int

104− Data.Text.Internal.Builder.Int.Digits

105− Data.Text.Internal.Builder

106− Data.Text.Lazy.Builder.RealFloat

107− Data.Text.Internal.Builder.RealFloat.Functions

108− Data.Text.Lazy.Encoding

109− Data.Text.Internal.Lazy.Encoding.Fusion

110− Data.Text.Internal.Lazy.Fusion

111− Data.Text.Lazy.IO

112− Data.Text.Internal.Lazy

113− Data.Text.Lazy.Read

114− Data.Text.Internal.Lazy.Search

115− Data.Text.Internal.Private

116− Data.Text.Read

117− Data.Text.Show

118− Data.Text.Internal.Read

119− Data.Text.Internal.Search

120− Data.Text.Unsafe

121− Data.Text.Internal.Unsafe

122− Data.Text.Internal.Unsafe.Char

123− Data.Text.Internal.Unsafe.Shift

124− Data.Text.Internal.Functions

125−

126− if flag(hpc)

127− ghc-options:

128− -fhpc

129−

130− cpp-options:

131− -DTEST_SUITE

132− -DHAVE_DEEPSEQ

133− -DASSERTS

134− -DINTEGER_GMP

135−

136− build-depends:

137− array,

138− base == 4.*,

139− binary,

140− bytestring,

141− deepseq,

142− ghc-prim,

143− integer-gmp

text.cabal+74−113

@@ -1,9 +1,9 @@

11name: text

2−version: 1.2.2.1

2+version: 0.11.1.13

33homepage: https://github.com/bos/text

44bug-reports: https://github.com/bos/text/issues

55synopsis: An efficient packed Unicode text type.

6−description:

6+description:

77 .

88 An efficient packed, immutable Unicode text type (both strict and

99 lazy), with a powerful loop fusion optimization framework.

@@ -30,8 +30,8 @@ description:

3030 non-standard encodings, text breaking, and locales), see

3131 the @text-icu@ package:

3232 <http://hackage.haskell.org/package/text-icu>

33−

34−license: BSD2

33+ .

34+license: BSD3

3535license-file: LICENSE

3636author: Bryan O'Sullivan <bos@serpentine.com>

3737maintainer: Bryan O'Sullivan <bos@serpentine.com>

@@ -40,48 +40,31 @@ category: Data, Text

4040build-type: Simple

4141cabal-version: >= 1.8

4242extra-source-files:

43+ README.markdown

4344 -- scripts/CaseFolding.txt

4445 -- scripts/SpecialCasing.txt

45− README.markdown

46− benchmarks/Setup.hs

47− benchmarks/cbits/*.c

48− benchmarks/haskell/*.hs

49− benchmarks/haskell/Benchmarks/*.hs

50− benchmarks/haskell/Benchmarks/Programs/*.hs

51− benchmarks/python/*.py

52− benchmarks/ruby/*.rb

53− benchmarks/text-benchmarks.cabal

54− changelog.md

55− include/*.h

5646 scripts/*.hs

57− tests-and-benchmarks.markdown

58− tests/*.hs

59− tests/.ghci

60− tests/Makefile

61− tests/Tests/*.hs

62− tests/Tests/Properties/*.hs

63− tests/cabal.config

64− tests/scripts/*.sh

65− tests/text-tests.cabal

66−

67−flag bytestring-builder

68− description: Depend on the bytestring-builder package for backwards compatibility.

69− default: False

70− manual: False

47+ tests/README.markdown

48+ tests/benchmarks/Setup.hs

49+ tests/benchmarks/cbits/*.c

50+ tests/benchmarks/python/*.py

51+ tests/benchmarks/ruby/*.rb

52+ tests/benchmarks/src/Data/Text/*.hs

53+ tests/benchmarks/src/Data/Text/Benchmarks/*.hs

54+ tests/benchmarks/text-benchmarks.cabal

55+ tests/tests/.ghci

56+ tests/tests/Makefile

57+ tests/tests/scripts/*.sh

58+ tests/tests/src/Data/Text/*.hs

59+ tests/tests/src/Data/Text/Tests/*.hs

60+ tests/tests/text-tests.cabal

7161

7262flag developer

7363 description: operate in developer mode

7464 default: False

75− manual: True

76−

77−flag integer-simple

78− description: Use the simple integer library instead of GMP

79− default: False

80− manual: False

8165

8266library

83− c-sources: cbits/cbits.c

84− include-dirs: include

67+ c-sources: cbits/cbits.c

8568

8669 exposed-modules:

8770 Data.Text

@@ -91,32 +74,6 @@ library

9174 Data.Text.Foreign

9275 Data.Text.IO

9376 Data.Text.Internal

94− Data.Text.Internal.Builder

95− Data.Text.Internal.Builder.Functions

96− Data.Text.Internal.Builder.Int.Digits

97− Data.Text.Internal.Builder.RealFloat.Functions

98− Data.Text.Internal.Encoding.Fusion

99− Data.Text.Internal.Encoding.Fusion.Common

100− Data.Text.Internal.Encoding.Utf16

101− Data.Text.Internal.Encoding.Utf32

102− Data.Text.Internal.Encoding.Utf8

103− Data.Text.Internal.Functions

104− Data.Text.Internal.Fusion

105− Data.Text.Internal.Fusion.CaseMapping

106− Data.Text.Internal.Fusion.Common

107− Data.Text.Internal.Fusion.Size

108− Data.Text.Internal.Fusion.Types

109− Data.Text.Internal.IO

110− Data.Text.Internal.Lazy

111− Data.Text.Internal.Lazy.Encoding.Fusion

112− Data.Text.Internal.Lazy.Fusion

113− Data.Text.Internal.Lazy.Search

114− Data.Text.Internal.Private

115− Data.Text.Internal.Read

116− Data.Text.Internal.Search

117− Data.Text.Internal.Unsafe

118− Data.Text.Internal.Unsafe.Char

119− Data.Text.Internal.Unsafe.Shift

12077 Data.Text.Lazy

12178 Data.Text.Lazy.Builder

12279 Data.Text.Lazy.Builder.Int

@@ -126,78 +83,82 @@ library

12683 Data.Text.Lazy.Internal

12784 Data.Text.Lazy.Read

12885 Data.Text.Read

129− Data.Text.Unsafe

130−

13186 other-modules:

132− Data.Text.Show

87+ Data.Text.Encoding.Fusion

88+ Data.Text.Encoding.Fusion.Common

89+ Data.Text.Encoding.Utf16

90+ Data.Text.Encoding.Utf32

91+ Data.Text.Encoding.Utf8

92+ Data.Text.Fusion

93+ Data.Text.Fusion.CaseMapping

94+ Data.Text.Fusion.Common

95+ Data.Text.Fusion.Internal

96+ Data.Text.Fusion.Size

97+ Data.Text.IO.Internal

98+ Data.Text.Lazy.Builder.Functions

99+ Data.Text.Lazy.Builder.RealFloat.Functions

100+ Data.Text.Lazy.Encoding.Fusion

101+ Data.Text.Lazy.Fusion

102+ Data.Text.Lazy.Search

103+ Data.Text.Private

104+ Data.Text.Search

105+ Data.Text.Unsafe

106+ Data.Text.Unsafe.Base

107+ Data.Text.UnsafeChar

108+ Data.Text.UnsafeShift

109+ Data.Text.Util

133110

134111 build-depends:

135− array >= 0.3,

136− base >= 4.2 && < 5,

137− binary,

138− deepseq >= 1.1.0.0,

139− ghc-prim >= 0.2

140−

141− if flag(bytestring-builder)

142− build-depends: bytestring >= 0.9 && < 0.10.4,

143− bytestring-builder >= 0.10.4

112+ array,

113+ base < 5,

114+ bytestring >= 0.9 && < 1.0

115+ if impl(ghc >= 6.10)

116+ build-depends:

117+ ghc-prim, base >= 4, deepseq >= 1.1.0.0

118+ cpp-options: -DHAVE_DEEPSEQ

144119 else

145− build-depends: bytestring >= 0.10.4

120+ build-depends: extensible-exceptions

121+ extensions: PatternSignatures

146122

147− cpp-options: -DHAVE_DEEPSEQ

148− ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

123+ ghc-options: -Wall -funbox-strict-fields -O2

124+ if impl(ghc >= 6.8)

125+ ghc-options: -fwarn-tabs

149126 if flag(developer)

150127 ghc-prof-options: -auto-all

151128 ghc-options: -Werror

152129 cpp-options: -DASSERTS

153130

154− if flag(integer-simple)

155− cpp-options: -DINTEGER_SIMPLE

156− build-depends: integer-simple >= 0.1 && < 0.5

157− else

131+ if impl(ghc >= 6.11)

158132 cpp-options: -DINTEGER_GMP

159− build-depends: integer-gmp >= 0.2

133+ build-depends: integer-gmp >= 0.2 && < 0.5

134+

135+ if impl(ghc >= 6.9) && impl(ghc < 6.11)

136+ cpp-options: -DINTEGER_GMP

137+ build-depends: integer >= 0.1 && < 0.2

160138

161139test-suite tests

162140 type: exitcode-stdio-1.0

163− hs-source-dirs: tests .

164− main-is: Tests.hs

141+ hs-source-dirs: . tests/tests/src

142+ main-is: Data/Text/Tests.hs

165143 c-sources: cbits/cbits.c

166− include-dirs: include

167144

168145 ghc-options:

169146 -Wall -threaded -O0 -rtsopts

170147

171148 cpp-options:

172− -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE

149+ -DASSERTS -DHAVE_DEEPSEQ

173150

174151 build-depends:

175− HUnit >= 1.2,

176− QuickCheck >= 2.7,

177− array,

178− base,

179− binary,

180− deepseq,

181− directory,

182− ghc-prim,

183− quickcheck-unicode,

184− random,

185− test-framework >= 0.4,

186− test-framework-hunit >= 0.2,

187− test-framework-quickcheck2 >= 0.2

188−

189− if flag(bytestring-builder)

190− build-depends: bytestring >= 0.9 && < 0.10.4,

191− bytestring-builder >= 0.10.4

192− else

193− build-depends: bytestring >= 0.10.4

194−

195− if flag(integer-simple)

196− cpp-options: -DINTEGER_SIMPLE

197− build-depends: integer-simple >= 0.1 && < 0.5

198− else

199− cpp-options: -DINTEGER_GMP

200− build-depends: integer-gmp >= 0.2

152+ base >= 4 && < 5,

153+ bytestring >= 0.9 && < 0.10,

154+ deepseq >= 1.1,

155+ directory >= 1.0 && < 1.2,

156+ random >= 1.0 && < 1.1,

157+ QuickCheck >= 2.4 && < 2.5,

158+ HUnit >= 1.2 && < 1.3,

159+ test-framework >= 0.4 && < 0.5,

160+ test-framework-quickcheck2 >= 0.2 && < 0.3,

161+ test-framework-hunit >= 0.2 && < 0.3

201162

202163source-repository head

203164 type: git