master..a99b318 · text

.gitignoredeleted−3

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

1−dist

2−cabal-dev

3−cabal.sandbox.config

.hgignoredeleted−14

@@ -1,14 +0,0 @@

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

2−^benchmarks/.*\.txt$

3−^tests/text-testdata.tar.bz2$

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

6−~$

7−

8−syntax: glob

9−.\#*

10−cabal-dev

11−cabal.sandbox.config

12−\.cabal-sandbox

13−scripts/CaseFolding.txt

14−scripts/SpecialCasing.txt

.hgtagsdeleted−66

@@ -1,66 +0,0 @@

1−0edd5dc96024e6c0f56f175ffa673f9178cece8c 0.9.0.0

2−1de0da99d31ba212e179d88957cf5f3b9c4facd7 0.7.0.1

3−30575507578cf04b5b1501ee23b1faa83315eb88 0.1

4−321e61f17630dbd346c1c9991831572f964b7d5a 0.4

5−34cef27f87287cd3c17d78ac99e9de2d6c8a1200 0.6

6−3cbff6d9bca135a85e428a7f6c4e15739a562b8b 0.7.1.0

7−587c8661393f83cb2b9452f6cc1d6885e52fe544 0.8.1.0

8−61c322bd5b6446255870422f854266396169a7e5 0.5

9−9adb5edd9b6407335e8772ea86036b938471fc89 0.2

10−b4fdbef1c1027a70b95c1a81747d968890acc3f6 0.3

11−de7cb0cb2a72606126c357b860bb0dbf7f145ad2 0.9.0.1

12−f2c9b1c019e3277926378d7b5a604f1c995f0202 0.7

13−f3d625f2d0730cb6adf8506a1f37762178c9aea6 0.10.0.0

14−99ea36957b1d47145d70f2ee8b13f1ddfd09245c 0.10.0.1

15−1b7889216e78b00d69b32c48782111bcd935978d 0.10.0.2

16−75157eaec6eb38574ad5c347e75c48dcb7262dee 0.11.0.0

17−0d7bc7bd77ec5a8f6d064de59d459e5eaf906b0f 0.11.0.1

18−a9d582a75dea9a4417883019d5110a35e4c07265 0.11.0.2

19−36b2a3aa661892ea25101199220383ba6d579abb 0.11.0.3

20−06e407bcdc9a3905abf9551062ecc6f92abcdde5 0.11.0.4

21−94bcf16e812f6fb49b87598673e17270f48c2bf1 0.11.0.5

22−784a32ffbec0b77adb43e9a64328db0482007309 0.11.0.6

23−c808123a3d37f25004d2aad8f3a395acfcf9122f 0.11.0.7

24−679826e742b239c5dd0c1fa4ebe98aa4bfe02a00 0.11.0.8

25−b49eebfa5673da89a23939d523c9de9edbd410b0 0.11.1.0

26−9c820a2ecaea01bc614d8e6bccf90e57431bdcbb 0.11.1.1

27−ed3a60ec627af6ba8af321009aa00224b3296e47 0.11.1.2

28−b75d3041d275e8e76b26605b0d426a572ddf1249 0.11.1.3

29−53906ad0c7e64f6c9a5df569e7cc642579aab8fc 0.11.1.5

30−9d6d3a9690ade506897c072060eb92868e229d5c 0.11.1.6

31−5ac062eace36b333566d1676979a57039a188840 0.11.1.7

32−9f01361a73071936b6ab0bdb879f1a45cca6577a 0.11.1.8

33−5dce2a934be53e74310fedffb51d7bd3e61fa993 0.11.1.9

34−9f47a2cfc9e51fd622d7553f08ad2ac1faad0438 0.11.1.10

35−9f47a2cfc9e51fd622d7553f08ad2ac1faad0438 0.11.1.10

36−407937739e9e764f1ae0f1f9ca454c42dca38772 0.11.1.10

37−8b981edd27befa4c2dd334fcb7db22ac67e22b67 0.11.1.11

38−204da16b5098531bdf858c388e2620238ef2aa5e 0.11.1.12

39−6a3d847a56a69d0514a79cb212cb218271ad0917 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+301−707

@@ -1,48 +1,29 @@

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

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

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

93

104-- |

115-- Module : Data.Text

6+-- Copyright : (c) Tom Harper 2008-2009,

7+-- (c) Bryan O'Sullivan 2009,

8+-- (c) Duncan Coutts 2009

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

21−-- A time and space-efficient implementation of Unicode text.

22−-- Suitable for performance critical use, both in terms of large data

23−-- quantities and high speed.

24−--

25−-- /Note/: Read below the synopsis for important notes on the use of

26−-- this module.

16+-- A time and space-efficient implementation of Unicode text using

17+-- packed Word16 arrays. Suitable for performance critical use, both

18+-- in terms of large data quantities and high speed.

2719--

2820-- This module is intended to be imported @qualified@, to avoid name

2921-- clashes with "Prelude" functions, e.g.

3022--

3123-- > import qualified Data.Text as T

32−--

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

34−-- 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 >.

3724

3825module Data.Text

3926 (

40− -- * Strict vs lazy types

41− -- $strict

42−

43− -- * Acceptable data

44− -- $replacement

45−

4627 -- * Fusion

4728 -- $fusion

4829

@@ -66,7 +47,6 @@ module Data.Text

6647 , init

6748 , null

6849 , length

69− , compareLength

7050

7151 -- * Transformations

7252 , map

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

8161 , toCaseFold

8262 , toLower

8363 , toUpper

84− , toTitle

8564

8665 -- ** Justification

8766 , justifyLeft

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

125104

126105 -- ** Breaking strings

127106 , take

128− , takeEnd

129107 , drop

130− , dropEnd

131108 , takeWhile

132− , takeWhileEnd

133109 , dropWhile

134110 , dropWhileEnd

135111 , dropAround

@@ -137,10 +113,10 @@ module Data.Text

137113 , stripStart

138114 , stripEnd

139115 , splitAt

140− , breakOn

141− , breakOnEnd

116+ , spanBy

142117 , break

143− , span

118+ , breakEnd

119+ , breakBy

144120 , group

145121 , groupBy

146122 , inits

@@ -148,8 +124,8 @@ module Data.Text

148124

149125 -- ** Breaking into many substrings

150126 -- $split

151− , splitOn

152127 , split

128+ , splitBy

153129 , chunksOf

154130

155131 -- ** Breaking into lines and words

@@ -165,308 +141,166 @@ module Data.Text

165141 , isInfixOf

166142

167143 -- ** View patterns

168− , stripPrefix

169− , stripSuffix

170− , commonPrefixes

144+ , prefixed

145+ , suffixed

171146

172147 -- * Searching

173148 , filter

174− , breakOnAll

175149 , find

176− , partition

150+ , findBy

151+ , partitionBy

177152

178153 -- , findSubstring

179−

154+

180155 -- * Indexing

181156 -- $index

182157 , index

183158 , findIndex

184159 , count

185160

186− -- * Zipping

161+ -- * Zipping and unzipping

187162 , zip

188163 , zipWith

189164

190165 -- -* Ordered text

191166 -- , sort

192−

193− -- * Low level operations

194− , copy

195− , unpackCString#

196167 ) where

197168

198−import Prelude (Char, Bool(..), Int, Maybe(..), String,

199− Eq(..), Ord(..), Ordering(..), (++),

200− Read(..),

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

202− not, return, otherwise, quot)

169+import Prelude (Char, Bool(..), Functor(..), Int, Maybe(..), String,

170+ Eq(..), Ord(..), (++),

171+ Read(..), Show(..),

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

173+ div, error, not, return, otherwise)

203174#if defined(HAVE_DEEPSEQ)

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

175+import Control.DeepSeq (NFData)

205176#endif

206177#if defined(ASSERTS)

207178import Control.Exception (assert)

208179#endif

209180import Data.Char (isSpace)

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

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

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

182+#if __GLASGOW_HASKELL__ >= 612

183+import Data.Data (mkNoRepType)

184+#else

185+import Data.Data (mkNorepType)

186+#endif

212187import Control.Monad (foldM)

213188import Control.Monad.ST (ST)

214189import qualified Data.Text.Array as A

215190import qualified Data.List as L

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

217191import Data.Monoid (Monoid(..))

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

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

220−#endif

221192import 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#)

193+import qualified Data.Text.Fusion as S

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

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

196+import Data.Text.Internal (Text(..), empty, text, textP)

229197import qualified Prelude as P

230−import 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)

236−#if defined(__HADDOCK__)

237−import Data.ByteString (ByteString)

238−import qualified Data.Text.Lazy as L

239−import Data.Int (Int64)

240−#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

248−

249−-- $strict

250−--

251−-- 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

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

255−--

256−-- 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.

264−--

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

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

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

268−-- lengths.

269−

270−-- $replacement

271−--

272−-- 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.

283−--

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

285−-- more 'Char' values. Those functions will substitute 'Char' values

286−-- that are not valid Unicode scalar values with the replacement

287−-- character \"�\" (U+FFFD). Functions that perform this

288−-- inspection and replacement are documented with the phrase

289−-- \"Performs replacement on invalid scalar values\".

290−--

291−-- (One reason for this policy of replacement is that internally, a

292−-- 'Text' value is represented as packed UTF-16 data. Values in the

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

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

295−-- 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 >.)

198+import Data.Text.Unsafe (iter, iter_, reverseIter, unsafeHead, unsafeTail)

199+import Data.Text.UnsafeChar (unsafeChr)

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

201+import Data.Text.Search (indices)

298202

299203-- $fusion

300204--

301205-- Most of the functions in this module are subject to /fusion/,

302206-- meaning that a pipeline of such functions will usually allocate at

303207-- most one 'Text' value.

304−--

305−-- As an example, consider the following pipeline:

306−--

307−-- > import Data.Text as T

308−-- > import Data.Text.Encoding as E

309−-- > import Data.ByteString (ByteString)

310−-- >

311−-- > countChars :: ByteString -> Int

312−-- > countChars = T.length . T.toUpper . E.decodeUtf8

313−--

314−-- 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'.

320−--

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

322−-- phrase \"Subject to fusion\".

323208

324209instance Eq Text where

325− Text arrA offA lenA == Text arrB offB lenB

326− | lenA == lenB = A.equal arrA offA arrB offB lenA

327− | otherwise = False

210+ t1 == t2 = stream t1 == stream t2

328211 {-# INLINE (==) #-}

329212

330213instance Ord Text where

331− compare = compareText

214+ compare t1 t2 = compare (stream t1) (stream t2)

215+ {-# INLINE compare #-}

216+

217+instance Show Text where

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

332219

333220instance Read Text where

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

335222

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−

344223instance Monoid Text where

345224 mempty = empty

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

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

348−#else

349225 mappend = append

350−#endif

351226 mconcat = concat

352227

353228instance IsString Text where

354229 fromString = pack

355230

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−

363231#if defined(HAVE_DEEPSEQ)

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

232+instance NFData Text

365233#endif

366234

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.

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

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

237+--

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

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

240+-- submit improvements.

377241--

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

242+-- Original discussion is archived here:

243+

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

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

389246

390247instance Data Text where

391248 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

249+ toConstr _ = error "Data.Text.Text.toConstr"

250+ gunfold _ _ = error "Data.Text.Text.gunfold"

251+#if __GLASGOW_HASKELL__ >= 612

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

253+#else

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

402255#endif

403256

404−packConstr :: Constr

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

406−

407−textDataType :: DataType

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

409−

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

411−compareText :: Text -> Text -> Ordering

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

413− | lenA == 0 && lenB == 0 = EQ

414− | otherwise = go 0 0

415− where

416− go !i !j

417− | i >= lenA || j >= lenB = compare lenA lenB

418− | a < b = LT

419− | a > b = GT

420− | otherwise = go (i+di) (j+dj)

421− where Iter a di = iter ta i

422− Iter b dj = iter tb j

423−

424257-- -----------------------------------------------------------------------------

425258-- * Conversion to/from 'Text'

426259

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

428−-- fusion. Performs replacement on invalid scalar values.

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

429261pack :: String -> Text

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

262+pack = unstream . S.streamList

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

432264

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

266+unpack :: Text -> String

267+unpack = S.unstreamList . stream

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

269+

270+-- | /O(1)/ Convert a character into a Text.

271+-- Subject to fusion.

272+singleton :: Char -> Text

273+singleton = unstream . S.singleton

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

275+

433276-- -----------------------------------------------------------------------------

434277-- * Basic functions

435278

436279-- | /O(n)/ Adds a character to the front of a 'Text'. This function

437280-- is more costly than its 'List' counterpart because it requires

438−-- copying a new array. Subject to fusion. Performs replacement on

439−-- invalid scalar values.

281+-- copying a new array. Subject to fusion.

440282cons :: Char -> Text -> Text

441−cons c t = unstream (S.cons (safe c) (stream t))

283+cons c t = unstream (S.cons c (stream t))

442284{-# INLINE cons #-}

443285

444−infixr 5 `cons`

445−

446286-- | /O(n)/ Adds a character to the end of a 'Text'. This copies the

447287-- entire array in the process, unless fused. Subject to fusion.

448−-- Performs replacement on invalid scalar values.

449288snoc :: Text -> Char -> Text

450−snoc t c = unstream (S.snoc (stream t) (safe c))

289+snoc t c = unstream (S.snoc (stream t) c)

451290{-# INLINE snoc #-}

452291

453292-- | /O(n)/ Appends one 'Text' to the other by copying both of them

454293-- into a new 'Text'. Subject to fusion.

455294append :: Text -> Text -> Text

456−append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)

457− | len1 == 0 = b

458− | len2 == 0 = a

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

460− | otherwise = overflowError "append"

295+append (Text arr1 off1 len1) (Text arr2 off2 len2) = Text (A.run x) 0 len

461296 where

462297 len = len1+len2

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

464298 x = do

465− arr <- A.new len

466− A.copyI arr 0 arr1 off1 len1

467− A.copyI arr len1 arr2 off2 len

299+ arr <- A.unsafeNew len

300+ copy arr 0 arr1 off1 len1

301+ copy arr len1 arr2 off2 (len1+len2)

468302 return arr

469−{-# NOINLINE append #-}

303+{-# INLINE append #-}

470304

471305{-# RULES

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

@@ -475,6 +309,14 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)

475309 unstream (S.append (stream t1) (stream t2)) = append t1 t2

476310 #-}

477311

312+copy :: forall s. A.MArray s -> Int -> A.Array -> Int -> Int

313+ -> ST s ()

314+copy dest i0 src j0 top = go i0 j0

315+ where

316+ go i j | i >= top = return ()

317+ | otherwise = do A.unsafeWrite dest i (src `A.unsafeIndex` j)

318+ go (i+1) (j+1)

319+

478320-- | /O(1)/ Returns the first character of a 'Text', which must be

479321-- non-empty. Subject to fusion.

480322head :: Text -> Char

@@ -486,14 +328,21 @@ head t = S.head (stream t)

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

487329uncons t@(Text arr off len)

488330 | len <= 0 = Nothing

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

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

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

332+ where (c,d) = iter t 0

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

492334

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

494336second :: (b -> c) -> (a,b) -> (a,c)

495337second f (a, b) = (a, f b)

496338

339+{-# RULES

340+"TEXT uncons -> fused" [~1] forall t.

341+ uncons t = fmap (second unstream) (S.uncons (stream t))

342+"TEXT uncons -> unfused" [1] forall t.

343+ fmap (second unstream) (S.uncons (stream t)) = uncons t

344+ #-}

345+

497346-- | /O(1)/ Returns the last character of a 'Text', which must be

498347-- non-empty. Subject to fusion.

499348last :: Text -> Char

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

517366tail :: Text -> Text

518367tail t@(Text arr off len)

519368 | len <= 0 = emptyError "tail"

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

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

521370 where d = iter_ t 0

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

523372

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

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

533382init :: Text -> Text

534383init (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)

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

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

537386 where

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

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

@@ -572,76 +421,27 @@ isSingleton = S.isSingleton . stream

572421-- Subject to fusion.

573422length :: Text -> Int

574423length 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.

578−

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

580−-- Subject to fusion.

581−--

582−-- This function gives the same answer as comparing against the result

583−-- of 'length', but can short circuit if the count of characters is

584−-- greater than the number, and hence be more efficient.

585−compareLength :: Text -> Int -> Ordering

586−compareLength t n = S.compareLengthI (stream t) n

587−{-# INLINE [1] compareLength #-}

588−

589−{-# RULES

590−"TEXT compareN/length -> compareLength" [~1] forall t n.

591− compare (length t) n = compareLength t n

592− #-}

593−

594−{-# RULES

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

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

597− #-}

598−

599−{-# RULES

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

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

602− #-}

603−

604−{-# RULES

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

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

607− #-}

608−

609−{-# RULES

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

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

612− #-}

613−

614−{-# RULES

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

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

617− #-}

618−

619−{-# RULES

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

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

622− #-}

424+{-# INLINE length #-}

623425

624426-- -----------------------------------------------------------------------------

625427-- * Transformations

626428-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to

627−-- each element of @t@. Subject to fusion. Performs replacement on

628−-- invalid scalar values.

429+-- each element of @t@. Subject to fusion.

629430map :: (Char -> Char) -> Text -> Text

630−map f t = unstream (S.map (safe . f) (stream t))

431+map f t = unstream (S.map f (stream t))

631432{-# INLINE [1] map #-}

632433

633434-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of

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

635436-- argument between each element of the list.

636437intercalate :: Text -> [Text] -> Text

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

438+intercalate t = concat . (L.intersperse t)

638439{-# INLINE intercalate #-}

639440

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

641−-- between the characters of a 'Text'. Subject to fusion. Performs

642−-- replacement on invalid scalar values.

442+-- between the characters of a 'Text'. Subject to fusion.

643443intersperse :: Char -> Text -> Text

644−intersperse c t = unstream (S.intersperse (safe c) (stream t))

444+intersperse c t = unstream (S.intersperse c (stream t))

645445{-# INLINE intersperse #-}

646446

647447-- | /O(n)/ Reverse the characters of a string. Subject to fusion.

@@ -649,59 +449,13 @@ reverse :: Text -> Text

649449reverse t = S.reverse (stream t)

650450{-# INLINE reverse #-}

651451

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"

672−--

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

674−-- 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.

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

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

454+ -> Text -- ^ Replacement text

455+ -> Text -- ^ Input text

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

457+replace s d = intercalate d . split s

458+{-# INLINE replace #-}

705459

706460-- ----------------------------------------------------------------------------

707461-- ** Case conversions (folds)

@@ -716,17 +470,10 @@ replace needle@(Text _ _ neeLen)

716470-- case conversion rules. As a result, these functions may map one

717471-- input character to two or three output characters. For examples,

718472-- see the documentation of each function.

719−--

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

721−-- context-dependent operation. The case conversion functions in this

722−-- 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 >.

725473

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.

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

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

476+-- string comparisons.

730477--

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

732479--

@@ -741,56 +488,27 @@ replace needle@(Text _ _ neeLen)

741488-- instead of itself.

742489toCaseFold :: Text -> Text

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

744−{-# INLINE toCaseFold #-}

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

745492

746493-- | /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).

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

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

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

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

753498toLower :: Text -> Text

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

755500{-# INLINE toLower #-}

756501

757502-- | /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

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

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

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

763506toUpper :: Text -> Text

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

765508{-# INLINE toUpper #-}

766509

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−

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

790−-- specified fill character on the right. Subject to fusion.

791−-- Performs replacement on invalid scalar values.

792−--

793−-- Examples:

511+-- specified fill character on the right. Subject to fusion. Examples:

794512--

795513-- > justifyLeft 7 'x' "foo" == "fooxxxx"

796514-- > justifyLeft 3 'x' "foobar" == "foobar"

@@ -809,10 +527,7 @@ justifyLeft k c t

809527 #-}

810528

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

812−-- specified fill character on the left. Performs replacement on

813−-- invalid scalar values.

814−--

815−-- Examples:

530+-- specified fill character on the left. Examples:

816531--

817532-- > justifyRight 7 'x' "bar" == "xxxxbar"

818533-- > justifyRight 3 'x' "foobar" == "foobar"

@@ -823,11 +538,8 @@ justifyRight k c t

823538 where len = length t

824539{-# INLINE justifyRight #-}

825540

826−-- | /O(n)/ Center a string to the given length, using the specified

827−-- fill character on either side. Performs replacement on invalid

828−-- scalar values.

829−--

830−-- Examples:

541+-- | /O(n)/ Center a string to the given length, using the

542+-- specified fill character on either side. Examples:

831543--

832544-- > center 8 'x' "HS" = "xxxHSxxx"

833545center :: Int -> Char -> Text -> Text

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

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

837549 where len = length t

838550 d = k - len

839− r = d `quot` 2

551+ r = d `div` 2

840552 l = d - r

841553{-# INLINE center #-}

842554

@@ -854,12 +566,12 @@ transpose ts = P.map pack (L.transpose (P.map unpack ts))

854566-- (typically the left-identity of the operator), and a 'Text',

855567-- reduces the 'Text' using the binary operator, from left to right.

856568-- Subject to fusion.

857−foldl :: (a -> Char -> a) -> a -> Text -> a

569+foldl :: (b -> Char -> b) -> b -> Text -> b

858570foldl f z t = S.foldl f z (stream t)

859571{-# INLINE foldl #-}

860572

861573-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.

862−foldl' :: (a -> Char -> a) -> a -> Text -> a

574+foldl' :: (b -> Char -> b) -> b -> Text -> b

863575foldl' f z t = S.foldl' f z (stream t)

864576{-# INLINE foldl' #-}

865577

@@ -878,12 +590,12 @@ foldl1' f t = S.foldl1' f (stream t)

878590-- (typically the right-identity of the operator), and a 'Text',

879591-- reduces the 'Text' using the binary operator, from right to left.

880592-- Subject to fusion.

881−foldr :: (Char -> a -> a) -> a -> Text -> a

593+foldr :: (Char -> b -> b) -> b -> Text -> b

882594foldr f z t = S.foldr f z (stream t)

883595{-# INLINE foldr #-}

884596

885597-- | /O(n)/ A variant of 'foldr' that has no starting value argument,

886−-- and thus must be applied to a non-empty 'Text'. Subject to

598+-- and thust must be applied to a non-empty 'Text'. Subject to

887599-- fusion.

888600foldr1 :: (Char -> Char -> Char) -> Text -> Char

889601foldr1 f t = S.foldr1 f (stream t)

@@ -894,19 +606,14 @@ foldr1 f t = S.foldr1 f (stream t)

894606

895607-- | /O(n)/ Concatenate a list of 'Text's.

896608concat :: [Text] -> Text

897−concat ts = case ts' of

898− [] -> empty

899− [t] -> t

900− _ -> Text (A.run go) 0 len

609+concat ts = Text (A.run go) 0 len

901610 where

902− ts' = L.filter (not . null) ts

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

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

611+ len = L.sum (L.map (\(Text _ _ l) -> l) ts)

905612 go = do

906− arr <- A.new len

907− let step i (Text a o l) =

908− let !j = i + l in A.copyI arr i a o j >> return j

909− foldM step 0 ts' >> return arr

613+ arr <- A.unsafeNew len

614+ let step i (Text a o l) = let j = i + l in copy arr i a o j >> return j

615+ foldM step 0 ts >> return arr

616+{-# INLINE concat #-}

910617

911618-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and

912619-- concatenate the results.

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

915622{-# INLINE concatMap #-}

916623

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

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

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

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

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

921628{-# INLINE any #-}

922629

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

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

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

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

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

927634{-# INLINE all #-}

@@ -943,7 +650,6 @@ minimum t = S.minimum (stream t)

943650

944651-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of

945652-- successive reduced values from the left. Subject to fusion.

946−-- Performs replacement on invalid scalar values.

947653--

948654-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]

949655--

@@ -951,13 +657,11 @@ minimum t = S.minimum (stream t)

951657--

952658-- > last (scanl f z xs) == foldl f z xs.

953659scanl :: (Char -> Char -> Char) -> Char -> Text -> Text

954−scanl f z t = unstream (S.scanl g z (stream t))

955− where g a b = safe (f a b)

660+scanl f z t = unstream (S.scanl f z (stream t))

956661{-# INLINE scanl #-}

957662

958663-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting

959−-- value argument. Subject to fusion. Performs replacement on

960−-- invalid scalar values.

664+-- value argument. Subject to fusion.

961665--

962666-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]

963667scanl1 :: (Char -> Char -> Char) -> Text -> Text

@@ -965,42 +669,40 @@ scanl1 f t | null t = empty

965669 | otherwise = scanl f (unsafeHead t) (unsafeTail t)

966670{-# INLINE scanl1 #-}

967671

968−-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs

969−-- replacement on invalid scalar values.

672+-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.

970673--

971674-- > scanr f v == reverse . scanl (flip f) v . reverse

972675scanr :: (Char -> Char -> Char) -> Char -> Text -> Text

973−scanr f z = S.reverse . S.reverseScanr g z . reverseStream

974− where g a b = safe (f a b)

676+scanr f z = S.reverse . S.reverseScanr f z . reverseStream

975677{-# INLINE scanr #-}

976678

977679-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting

978−-- value argument. Subject to fusion. Performs replacement on

979−-- invalid scalar values.

680+-- value argument. Subject to fusion.

980681scanr1 :: (Char -> Char -> Char) -> Text -> Text

981682scanr1 f t | null t = empty

982683 | otherwise = scanr f (last t) (init t)

983684{-# INLINE scanr1 #-}

984685

985−-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a

686+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a

986687-- function to each element of a 'Text', passing an accumulating

987−-- parameter from left to right, and returns a final 'Text'. Performs

988−-- replacement on invalid scalar values.

688+-- parameter from left to right, and returns a final 'Text'.

989689mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)

990−mapAccumL f z0 = S.mapAccumL g z0 . stream

991− where g a b = second safe (f a b)

992−{-# INLINE mapAccumL #-}

690+mapAccumL f s t = case uncons t of

691+ Nothing -> (s, empty)

692+ Just (x, xs) -> (s'', cons y ys)

693+ where (s', y ) = f s x

694+ (s'',ys) = mapAccumL f s' xs

993695

994696-- | The 'mapAccumR' function behaves like a combination of 'map' and

995−-- a strict 'foldr'; it applies a function to each element of a

996−-- 'Text', passing an accumulating parameter from right to left, and

997−-- returning a final value of this accumulator together with the new

998−-- 'Text'.

999−-- Performs replacement on invalid scalar values.

697+-- 'foldr'; it applies a function to each element of a 'Text', passing

698+-- an accumulating parameter from right to left, and returning a final

699+-- value of this accumulator together with the new 'Text'.

1000700mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)

1001−mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream

1002− where g a b = second safe (f a b)

1003−{-# INLINE mapAccumR #-}

701+mapAccumR f s t = case uncons t of

702+ Nothing -> (s, empty)

703+ Just (x, xs) -> (s'', cons y ys)

704+ where (s'',y ) = f s' x

705+ (s', ys) = mapAccumR f s xs

1004706

1005707-- -----------------------------------------------------------------------------

1006708-- ** Generating and unfolding 'Text's

@@ -1009,18 +711,17 @@ mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream

1009711-- @t@ repeated @n@ times.

1010712replicate :: Int -> Text -> Text

1011713replicate 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

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

715+ | n == 1 = t

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

717+ | otherwise = Text (A.run x) 0 len

1016718 where

1017− len = l `mul` n

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

719+ len = l * n

1019720 x = do

1020− arr <- A.new len

721+ arr <- A.unsafeNew len

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

1022723 | otherwise = let m = d + l

1023− in A.copyI arr d a o m >> loop m (i+1)

724+ in copy arr d a o m >> loop m (i+1)

1024725 loop 0 0

1025726{-# INLINE [1] replicate #-}

1026727

@@ -1032,7 +733,7 @@ replicate n t@(Text a o l)

1032733-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the

1033734-- value of every element. Subject to fusion.

1034735replicateChar :: Int -> Char -> Text

1035−replicateChar n c = unstream (S.replicateCharI n (safe c))

736+replicateChar n c = unstream (S.replicateCharI n c)

1036737{-# INLINE replicateChar #-}

1037738

1038739-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'

@@ -1041,9 +742,9 @@ replicateChar n c = unstream (S.replicateCharI n (safe c))

1041742-- returns 'Nothing' if it is done producing the 'Text', otherwise

1042743-- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the

1043744-- string, and @b@ is the seed value for further production. Subject

1044−-- to fusion. Performs replacement on invalid scalar values.

745+-- to fusion.

1045746unfoldr :: (a -> Maybe (Char,a)) -> a -> Text

1046−unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)

747+unfoldr f s = unstream (S.unfoldr f s)

1047748{-# INLINE unfoldr #-}

1048749

1049750-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed

@@ -1051,9 +752,9 @@ unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)

1051752-- first argument to 'unfoldrN'. This function is more efficient than

1052753-- 'unfoldr' when the maximum length of the result is known and

1053754-- correct, otherwise its performance is similar to 'unfoldr'. Subject

1054−-- to fusion. Performs replacement on invalid scalar values.

755+-- to fusion.

1055756unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text

1056−unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)

757+unfoldrN n f s = unstream (S.unfoldrN n f s)

1057758{-# INLINE unfoldrN #-}

1058759

1059760-- -----------------------------------------------------------------------------

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

1066767take n t@(Text arr off len)

1067768 | n <= 0 = empty

1068769 | n >= len = t

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

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

771+ where

772+ loop !i !cnt

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

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

775+ where d = iter_ t i

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

1071777

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−

1079778{-# RULES

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

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

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

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

1084783 #-}

1085784

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−

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

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

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

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

1111789drop n t@(Text arr off len)

1112790 | n <= 0 = t

1113791 | n >= len = empty

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

1115− where i = iterN n t

792+ | otherwise = loop 0 0

793+ where loop !i !cnt

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

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

796+ where d = iter_ t i

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

1117798

1118799{-# RULES

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

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

1123804 #-}

1124805

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−

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

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

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

@@ -1141,8 +810,8 @@ takeWhile :: (Char -> Bool) -> Text -> Text

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

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

1143812 | p c = loop (i+d)

1144− | otherwise = text arr off i

1145− where Iter c d = iter t i

813+ | otherwise = textP arr off i

814+ where (c,d) = iter t i

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

1147816

1148817{-# RULES

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

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

1153822 #-}

1154823

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−

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

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

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

@@ -1180,7 +828,7 @@ dropWhile p t@(Text arr off len) = loop 0 0

1180828 where loop !i !l | l >= len = empty

1181829 | p c = loop (i+d) (l+d)

1182830 | otherwise = Text arr (off+i) (len-l)

1183− where Iter c d = iter t i

831+ where (c,d) = iter t i

1184832{-# INLINE [1] dropWhile #-}

1185833

1186834{-# RULES

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

1191839 #-}

1192840

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

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

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

1195843-- @t@. Subject to fusion.

1196−--

1197844-- Examples:

1198845--

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

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

1213860 #-}

1214861

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

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

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

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

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

1219866dropAround p = dropWhile p . dropWhileEnd p

@@ -1248,23 +895,31 @@ splitAt :: Int -> Text -> (Text, Text)

1248895splitAt n t@(Text arr off len)

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

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

1251− | otherwise = let k = iterN n t

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

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

899+ where k = loop 0 0

900+ loop !i !cnt

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

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

903+ where d = iter_ t i

904+{-# INLINE splitAt #-}

1253905

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

906+-- | /O(n)/ 'spanBy', applied to a predicate @p@ and text @t@, returns

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

1256908-- of @t@ of elements that satisfy @p@, and whose second is the

1257909-- remainder of the list.

1258−span :: (Char -> Bool) -> Text -> (Text, Text)

1259−span p t = case span_ p t of

1260− (# hd,tl #) -> (hd,tl)

1261−{-# INLINE span #-}

1262−

1263−-- | /O(n)/ 'break' is like 'span', but the prefix returned is

910+spanBy :: (Char -> Bool) -> Text -> (Text, Text)

911+spanBy p t@(Text arr off len) = (textP arr off k, textP arr (off+k) (len-k))

912+ where k = loop 0

913+ loop !i | i >= len || not (p c) = i

914+ | otherwise = loop (i+d)

915+ where (c,d) = iter t i

916+{-# INLINE spanBy #-}

917+

918+-- | /O(n)/ 'breakBy' is like 'spanBy', but the prefix returned is

1264919-- over elements that fail the predicate @p@.

1265−break :: (Char -> Bool) -> Text -> (Text, Text)

1266−break p = span (not . p)

1267−{-# INLINE break #-}

920+breakBy :: (Char -> Bool) -> Text -> (Text, Text)

921+breakBy p = spanBy (not . p)

922+{-# INLINE breakBy #-}

1268923

1269924-- | /O(n)/ Group characters in a string according to a predicate.

1270925groupBy :: (Char -> Char -> Bool) -> Text -> [Text]

@@ -1273,7 +928,7 @@ groupBy p = loop

1273928 loop t@(Text arr off len)

1274929 | null t = []

1275930 | otherwise = text arr off n : loop (text arr (off+n) (len-n))

1276− where Iter c d = iter t 0

931+ where (c,d) = iter t 0

1277932 n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))

1278933

1279934-- | Returns the /array/ index (in units of 'Word16') at which a

@@ -1283,8 +938,8 @@ findAIndexOrEnd :: (Char -> Bool) -> Text -> Int

1283938findAIndexOrEnd q t@(Text _arr _off len) = go 0

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

1285940 | otherwise = go (i+d)

1286− where Iter c d = iter t i

1287−

941+ where (c,d) = iter t i

942+

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

1289944group :: Text -> [Text]

1290945group = groupBy (==)

@@ -1308,43 +963,36 @@ tails t | null t = [empty]

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

1309964-- are slices of the original.

1310965

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.

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

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

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

1314969--

1315970-- Examples:

1316971--

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

1318−-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]

1319−-- > splitOn "x" "x" == ["",""]

1320−--

972+-- > split "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]

973+-- > split "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]

974+-- > split "x" "x" == ["",""]

975+--

1321976-- and

1322977--

1323−-- > intercalate s . splitOn s == id

1324−-- > splitOn (singleton c) == split (==c)

1325−--

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

978+-- > intercalate s . split s == id

979+-- > split (singleton c) == splitBy (==c)

1327980--

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

1329982-- 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]

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

1337− | l <= 0 = emptyError "splitOn"

1338− | isSingleton pat = split (== unsafeHead pat) src

983+split :: Text -> Text -> [Text]

984+split pat@(Text _ _ l) src@(Text arr off len)

985+ | l <= 0 = emptyError "split"

986+ | isSingleton pat = splitBy (== unsafeHead pat) src

1339987 | otherwise = go 0 (indices pat src)

1340988 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)]

1343−{-# INLINE [1] splitOn #-}

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

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

991+{-# INLINE [1] split #-}

1344992

1345993{-# RULES

1346−"TEXT splitOn/singleton -> split/==" [~1] forall c t.

1347− splitOn (singleton c) t = split (==c) t

994+"TEXT split/singleton -> splitBy/==" [~1] forall c t.

995+ split (singleton c) t = splitBy (==c) t

1348996 #-}

1349997

1350998-- | /O(n)/ Splits a 'Text' into components delimited by separators,

@@ -1352,15 +1000,15 @@ splitOn pat@(Text _ _ l) src@(Text arr off len)

13521000-- resulting components do not contain the separators. Two adjacent

13531001-- separators result in an empty component in the output. eg.

13541002--

1355−-- > split (=='a') "aabbaca" == ["","","bb","c",""]

1356−-- > split (=='a') "" == [""]

1357−split :: (Char -> Bool) -> Text -> [Text]

1358−split _ t@(Text _off _arr 0) = [t]

1359−split p t = loop t

1003+-- > splitBy (=='a') "aabbaca" == ["","","bb","c",""]

1004+-- > splitBy (=='a') "" == [""]

1005+splitBy :: (Char -> Bool) -> Text -> [Text]

1006+splitBy _ t@(Text _off _arr 0) = [t]

1007+splitBy p t = loop t

13601008 where loop s | null s' = [l]

13611009 | otherwise = l : loop (unsafeTail s')

1362− where (# l, s' #) = span_ (not . p) s

1363−{-# INLINE split #-}

1010+ where (l, s') = breakBy p s

1011+{-# INLINE splitBy #-}

13641012

13651013-- | /O(n)/ Splits a 'Text' into components of length @k@. The last

13661014-- element may be shorter than the other chunks, depending on the

@@ -1382,21 +1030,21 @@ chunksOf k = go

13821030-------------------------------------------------------------------------------

13831031-- ** Searching with a predicate

13841032

1385−-- | /O(n)/ The 'find' function takes a predicate and a 'Text', and

1386−-- returns the first element matching the predicate, or 'Nothing' if

1387−-- there is no such element.

1388−find :: (Char -> Bool) -> Text -> Maybe Char

1389−find p t = S.findBy p (stream t)

1390−{-# INLINE find #-}

1033+-- | /O(n)/ The 'findBy' function takes a predicate and a 'Text', and

1034+-- returns the first element in matching the predicate, or 'Nothing'

1035+-- if there is no such element.

1036+findBy :: (Char -> Bool) -> Text -> Maybe Char

1037+findBy p t = S.findBy p (stream t)

1038+{-# INLINE findBy #-}

13911039

1392−-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',

1040+-- | /O(n)/ The 'partitionBy' function takes a predicate and a 'Text',

13931041-- and returns the pair of 'Text's with elements which do and do not

13941042-- satisfy the predicate, respectively; i.e.

13951043--

1396−-- > partition p t == (filter p t, filter (not . p) t)

1397−partition :: (Char -> Bool) -> Text -> (Text, Text)

1398−partition p t = (filter p t, filter (not . p) t)

1399−{-# INLINE partition #-}

1044+-- > partitionBy p t == (filter p t, filter (not . p) t)

1045+partitionBy :: (Char -> Bool) -> Text -> (Text, Text)

1046+partitionBy p t = (filter p t, filter (not . p) t)

1047+{-# INLINE partitionBy #-}

14001048

14011049-- | /O(n)/ 'filter', applied to a predicate and a 'Text',

14021050-- returns a 'Text' containing those characters that satisfy the

@@ -1412,40 +1060,39 @@ filter p t = unstream (S.filter p (stream t))

14121060--

14131061-- Examples:

14141062--

1415−-- > breakOn "::" "a::b::c" ==> ("a", "::b::c")

1416−-- > breakOn "/" "foobar" ==> ("foobar", "")

1063+-- > break "::" "a::b::c" ==> ("a", "::b::c")

1064+-- > break "/" "foobar" ==> ("foobar", "")

14171065--

14181066-- Laws:

14191067--

14201068-- > append prefix match == haystack

1421−-- > where (prefix, match) = breakOn needle haystack

1069+-- > where (prefix, match) = break needle haystack

14221070--

14231071-- If you need to break a string by a substring repeatedly (e.g. you

1424−-- want to break on every instance of a substring), use 'breakOnAll'

1072+-- want to break on every instance of a substring), use 'find'

14251073-- instead, as it has lower startup overhead.

14261074--

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

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

1429−breakOn :: Text -> Text -> (Text, Text)

1430−breakOn pat src@(Text arr off len)

1431− | null pat = emptyError "breakOn"

1077+break :: Text -> Text -> (Text, Text)

1078+break pat src@(Text arr off len)

1079+ | null pat = emptyError "break"

14321080 | otherwise = case indices pat src of

14331081 [] -> (src, empty)

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

1435−{-# INLINE breakOn #-}

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

1083+{-# INLINE break #-}

14361084

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

1438−-- string.

1085+-- | /O(n+m)/ Similar to 'break', but searches from the end of the string.

14391086--

14401087-- The first element of the returned tuple is the prefix of @haystack@

14411088-- up to and including the last match of @needle@. The second is the

14421089-- remainder of @haystack@, following the match.

14431090--

1444−-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")

1445−breakOnEnd :: Text -> Text -> (Text, Text)

1446−breakOnEnd pat src = (reverse b, reverse a)

1447− where (a,b) = breakOn (reverse pat) (reverse src)

1448−{-# INLINE breakOnEnd #-}

1091+-- > breakEnd "::" "a::b::c" ==> ("a::b::", "c")

1092+breakEnd :: Text -> Text -> (Text, Text)

1093+breakEnd pat src = let (a,b) = break (reverse pat) (reverse src)

1094+ in (reverse b, reverse a)

1095+{-# INLINE breakEnd #-}

14491096

14501097-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in

14511098-- @haystack@. Each element of the returned list consists of a pair:

@@ -1456,25 +1103,25 @@ breakOnEnd pat src = (reverse b, reverse a)

14561103--

14571104-- Examples:

14581105--

1459−-- > breakOnAll "::" ""

1106+-- > find "::" ""

14601107-- > ==> []

1461−-- > breakOnAll "/" "a/b/c/"

1108+-- > find "/" "a/b/c/"

14621109-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]

14631110--

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

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

14661113--

14671114-- The @needle@ parameter may not be empty.

1468−breakOnAll :: Text -- ^ @needle@ to search for

1469− -> Text -- ^ @haystack@ in which to search

1470− -> [(Text, Text)]

1471−breakOnAll pat src@(Text arr off slen)

1472− | null pat = emptyError "breakOnAll"

1115+find :: Text -- ^ @needle@ to search for

1116+ -> Text -- ^ @haystack@ in which to search

1117+ -> [(Text, Text)]

1118+find pat src@(Text arr off slen)

1119+ | null pat = emptyError "find"

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

14741121 where

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

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

1477−{-# INLINE breakOnAll #-}

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

1124+{-# INLINE find #-}

14781125

14791126-------------------------------------------------------------------------------

14801127-- ** Indexing 'Text's

@@ -1493,7 +1140,7 @@ breakOnAll pat src@(Text arr off slen)

14931140-- For example, suppose you have a string that you want to split on

14941141-- the substring @\"::\"@, such as @\"foo::bar::quux\"@. Instead of

14951142-- searching for the index of @\"::\"@ and taking the substrings

1496−-- before and after that index, you would instead use @breakOnAll \"::\"@.

1143+-- before and after that index, you would instead use @find \"::\"@.

14971144

14981145-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.

14991146index :: Text -> Int -> Char

@@ -1540,15 +1187,13 @@ countChar c t = S.countChar c (stream t)

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

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

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

1543−{-# INLINE zip #-}

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

15441191

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

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

1547−-- Performs replacement on invalid scalar values.

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

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

1550− where g a b = safe (f a b)

1551−{-# INLINE zipWith #-}

1195+zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))

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

15521197

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

15541199-- representing white space.

@@ -1564,7 +1209,7 @@ words t@(Text arr off len) = loop 0 0

15641209 then loop (start+1) (start+1)

15651210 else Text arr (start+off) (n-start) : loop (n+d) (n+d)

15661211 | otherwise = loop start (n+d)

1567− where Iter c d = iter t n

1212+ where (c,d) = iter t n

15681213{-# INLINE words #-}

15691214

15701215-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at

@@ -1574,7 +1219,7 @@ lines ps | null ps = []

15741219 | otherwise = h : if null t

15751220 then []

15761221 else lines (unsafeTail t)

1577− where (# h,t #) = span_ (/= '\n') ps

1222+ where (h,t) = spanBy (/= '\n') ps

15781223{-# INLINE lines #-}

15791224

15801225{-

@@ -1611,7 +1256,8 @@ unwords = intercalate (singleton ' ')

16111256{-# INLINE unwords #-}

16121257

16131258-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns

1614−-- 'True' iff the first is a prefix of the second. Subject to fusion.

1259+-- 'True' iff the first is a prefix of the second. This function is

1260+-- subject to fusion.

16151261isPrefixOf :: Text -> Text -> Bool

16161262isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =

16171263 alen <= blen && S.isPrefixOf (stream a) (stream b)

@@ -1620,6 +1266,8 @@ isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =

16201266{-# RULES

16211267"TEXT isPrefixOf -> fused" [~1] forall s t.

16221268 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)

1269+"TEXT isPrefixOf -> unfused" [1] forall s t.

1270+ S.isPrefixOf (stream s) (stream t) = isPrefixOf s t

16231271 #-}

16241272

16251273-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns

@@ -1653,14 +1301,13 @@ isInfixOf needle haystack

16531301-------------------------------------------------------------------------------

16541302-- * View patterns

16551303

1656−-- | /O(n)/ Return the suffix of the second string if its prefix

1657−-- matches the entire first string.

1304+-- | /O(n)/ Returns the suffix of the second string if its prefix

1305+-- matches the first.

16581306--

16591307-- Examples:

16601308--

1661−-- > stripPrefix "foo" "foobar" == Just "bar"

1662−-- > stripPrefix "" "baz" == Just "baz"

1663−-- > stripPrefix "foo" "quux" == Nothing

1309+-- > prefixed "foo" "foobar" == Just "bar"

1310+-- > prefixed "foo" "quux" == Nothing

16641311--

16651312-- This is particularly useful with the @ViewPatterns@ extension to

16661313-- GHC, as follows:

@@ -1669,44 +1316,20 @@ isInfixOf needle haystack

16691316-- > import Data.Text as T

16701317-- >

16711318-- > fnordLength :: Text -> Int

1672−-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf

1673−-- > fnordLength _ = -1

1674−stripPrefix :: Text -> Text -> Maybe Text

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

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

1319+-- > fnordLength (prefixed "fnord" -> Just suf) = T.length suf

1320+-- > fnordLength _ = -1

1321+prefixed :: Text -> Text -> Maybe Text

1322+prefixed p@(Text _arr _off plen) t@(Text arr off len)

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

16771324 | otherwise = Nothing

16781325

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

1680−-- and return it, along with the suffixes of each string at which they

1681−-- no longer match.

1682−--

1683−-- If the strings do not have a common prefix or either one is empty,

1684−-- this function returns 'Nothing'.

1326+-- | /O(n)/ Returns the prefix of the second string if its suffix

1327+-- matches the first.

16851328--

16861329-- Examples:

16871330--

1688−-- > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux")

1689−-- > commonPrefixes "veeble" "fetzer" == Nothing

1690−-- > commonPrefixes "" "baz" == Nothing

1691−commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)

1692−commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0

1693− where

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

1695− | i > 0 = Just (Text arr0 off0 i,

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

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

1698− | otherwise = Nothing

1699− where Iter a d0 = iter t0 i

1700− Iter b d1 = iter t1 j

1701−

1702−-- | /O(n)/ Return the prefix of the second string if its suffix

1703−-- matches the entire first string.

1704−--

1705−-- Examples:

1706−--

1707−-- > stripSuffix "bar" "foobar" == Just "foo"

1708−-- > stripSuffix "" "baz" == Just "baz"

1709−-- > stripSuffix "foo" "quux" == Nothing

1331+-- > suffixed "bar" "foobar" == Just "foo"

1332+-- > suffixed "foo" "quux" == Nothing

17101333--

17111334-- This is particularly useful with the @ViewPatterns@ extension to

17121335-- GHC, as follows:

@@ -1715,41 +1338,12 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0

17151338-- > import Data.Text as T

17161339-- >

17171340-- > quuxLength :: Text -> Int

1718−-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre

1719−-- > quuxLength _ = -1

1720−stripSuffix :: Text -> Text -> Maybe Text

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

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

1341+-- > quuxLength (suffixed "quux" -> Just pre) = T.length pre

1342+-- > quuxLength _ = -1

1343+suffixed :: Text -> Text -> Maybe Text

1344+suffixed p@(Text _arr _off plen) t@(Text arr off len)

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

17231346 | otherwise = Nothing

17241347

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

1726−sumP :: String -> [Int] -> Int

1727−sumP fun = go 0

1728− where go !a (x:xs)

1729− | ax >= 0 = go ax xs

1730− | otherwise = overflowError fun

1731− where ax = a + x

1732− go a _ = a

1733−

17341348emptyError :: String -> a

1735−emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"

1736−

1737−overflowError :: String -> a

1738−overflowError 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

1349+emptyError fun = P.error ("Data.Text." ++ fun ++ ": empty input")

Data/Text/Array.hs+86−133

@@ -1,12 +1,12 @@

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

2− RecordWildCards, UnboxedTuples, UnliftedFFITypes #-}

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

32{-# OPTIONS_GHC -fno-warn-unused-matches #-}

43-- |

54-- Module : Data.Text.Array

5+-- Copyright : (c) Bryan O'Sullivan 2009

76--

87-- License : BSD-style

9−-- Maintainer : bos@serpentine.com

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

9+-- duncan@haskell.org

1010-- Stability : experimental

1111-- Portability : portable

1212--

@@ -20,28 +20,25 @@

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

2121--

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

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

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

2424-- naming.

2525module Data.Text.Array

2626 (

2727 -- * Types

28− Array(Array, aBA)

29− , MArray(MArray, maBA)

28+ IArray(..)

29+ , Array

30+ , MArray

3031

3132 -- * Functions

32− , copyM

33− , copyI

33+ , copy

3434 , empty

35− , equal

36−#if defined(ASSERTS)

37− , length

38−#endif

3935 , run

4036 , run2

4137 , toList

38+ , unsafeCopy

4239 , unsafeFreeze

4340 , unsafeIndex

44− , new

41+ , unsafeNew

4542 , unsafeWrite

4643 ) where

4744

@@ -59,84 +56,59 @@ if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ "

5956#if defined(ASSERTS)

6057import Control.Exception (assert)

6158#endif

62−#if __GLASGOW_HASKELL__ >= 702

63−import Control.Monad.ST.Unsafe (unsafeIOToST)

64−#else

65−import Control.Monad.ST (unsafeIOToST)

66−#endif

67−import Data.Bits ((.&.), xor)

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

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

70−#if __GLASGOW_HASKELL__ >= 703

71−import Foreign.C.Types (CInt(CInt), CSize(CSize))

72−#else

73−import Foreign.C.Types (CInt, CSize)

74−#endif

59+import Data.Text.UnsafeShift (shiftL)

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

7661 indexWord16Array#, newByteArray#,

77− unsafeFreezeByteArray#, writeWord16Array#)

62+ readWord16Array#, unsafeCoerce#,

63+ writeWord16Array#)

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

7965import GHC.Word (Word16(..))

8066import Prelude hiding (length, read)

8167

8268-- | Immutable array type.

83−data Array = Array {

84− aBA :: ByteArray#

85−#if defined(ASSERTS)

86− , aLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)

87−#endif

88− }

69+data Array = Array

70+ {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)

71+ ByteArray#

8972

9073-- | Mutable array type, for use in the ST monad.

91−data MArray s = MArray {

92− maBA :: MutableByteArray# s

93−#if defined(ASSERTS)

94− , maLen :: {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)

95−#endif

96− }

74+data MArray s = MArray

75+ {-# UNPACK #-} !Int -- length (in units of Word16, not bytes)

76+ (MutableByteArray# s)

9777

98−#if defined(ASSERTS)

9978-- | Operations supported by all arrays.

10079class IArray a where

10180 -- | Return the length of an array.

10281 length :: a -> Int

10382

10483instance IArray Array where

105− length = aLen

84+ length (Array len _ba) = len

10685 {-# INLINE length #-}

10786

10887instance IArray (MArray s) where

109− length = maLen

88+ length (MArray len _ba) = len

11089 {-# INLINE length #-}

111−#endif

90+

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

92+unsafeFreeze :: MArray s -> ST s (Array)

11293

11394-- | Create an uninitialized mutable array.

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

115−new n

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

117− | otherwise = ST $ \s1# ->

118− case newByteArray# len# s1# of

119− (# s2#, marr# #) -> (# s2#, MArray marr#

95+unsafeNew :: forall s. Int -> ST s (MArray s)

96+unsafeNew n =

12097#if defined(ASSERTS)

121− n

98+ assert (n >= 0) .

12299#endif

123− #)

124− where !(I# len#) = bytesInArray n

125− highBit = maxBound `xor` (maxBound `shiftR` 1)

126−{-# INLINE new #-}

127−

128−array_size_error :: a

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

130−

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

132−unsafeFreeze :: MArray s -> ST s Array

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

134− case unsafeFreezeByteArray# maBA s1# of

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

100+ ST $ \s1# ->

101+ case bytesInArray n of

102+ len@(I# len#) ->

136103#if defined(ASSERTS)

137− maLen

104+ if len < 0 then error (show ("unsafeNew",len)) else

138105#endif

139− #)

106+ case newByteArray# len# s1# of

107+ (# s2#, marr# #) -> (# s2#, MArray n marr# #)

108+{-# INLINE unsafeNew #-}

109+

110+unsafeFreeze (MArray len mba#) = ST $ \s# ->

111+ (# s#, Array len (unsafeCoerce# mba#) #)

140112{-# INLINE unsafeFreeze #-}

141113

142114-- | Indicate how many bytes would be used for an array of the given

@@ -148,29 +120,39 @@ bytesInArray n = n `shiftL` 1

148120-- | Unchecked read of an immutable array. May return garbage or

149121-- crash on an out-of-bounds access.

150122unsafeIndex :: Array -> Int -> Word16

151−unsafeIndex Array{..} i@(I# i#) =

152− CHECK_BOUNDS("unsafeIndex",aLen,i)

153− case indexWord16Array# aBA i# of r# -> (W16# r#)

123+unsafeIndex (Array len ba#) i@(I# i#) =

124+ CHECK_BOUNDS("unsafeIndex",len,i)

125+ case indexWord16Array# ba# i# of r# -> (W16# r#)

154126{-# INLINE unsafeIndex #-}

155127

128+-- | Unchecked read of a mutable array. May return garbage or

129+-- crash on an out-of-bounds access.

130+unsafeRead :: MArray s -> Int -> ST s Word16

131+unsafeRead (MArray len mba#) i@(I# i#) = ST $ \s# ->

132+ CHECK_BOUNDS("unsafeRead",len,i)

133+ case readWord16Array# mba# i# s# of

134+ (# s2#, r# #) -> (# s2#, W16# r# #)

135+{-# INLINE unsafeRead #-}

136+

156137-- | Unchecked write of a mutable array. May return garbage or crash

157138-- on an out-of-bounds access.

158139unsafeWrite :: MArray s -> Int -> Word16 -> ST s ()

159−unsafeWrite MArray{..} i@(I# i#) (W16# e#) = ST $ \s1# ->

160− CHECK_BOUNDS("unsafeWrite",maLen,i)

161− case writeWord16Array# maBA i# e# s1# of

140+unsafeWrite (MArray len marr#) i@(I# i#) (W16# e#) = ST $ \s1# ->

141+ CHECK_BOUNDS("unsafeWrite",len,i)

142+ case writeWord16Array# marr# i# e# s1# of

162143 s2# -> (# s2#, () #)

163144{-# INLINE unsafeWrite #-}

164145

165146-- | Convert an immutable array to a list.

166−toList :: Array -> Int -> Int -> [Word16]

167−toList ary off len = loop 0

168− where loop i | i < len = unsafeIndex ary (off+i) : loop (i+1)

147+toList :: Array -> [Word16]

148+toList a = loop 0

149+ where loop i | i < len = unsafeIndex a i : loop (i+1)

169150 | otherwise = []

151+ len = length a

170152

171153-- | An empty immutable array.

172154empty :: Array

173−empty = runST (new 0 >>= unsafeFreeze)

155+empty = runST (unsafeNew 0 >>= unsafeFreeze)

174156

175157-- | Run an action in the ST monad and return an immutable array of

176158-- its result.

@@ -184,63 +166,34 @@ run2 k = runST (do

184166 (marr,b) <- k

185167 arr <- unsafeFreeze marr

186168 return (arr,b))

187−{-# INLINE run2 #-}

188−

189−-- | Copy some elements of a mutable array.

190−copyM :: MArray s -- ^ Destination

191− -> Int -- ^ Destination offset

192− -> MArray s -- ^ Source

193− -> Int -- ^ Source offset

194− -> Int -- ^ Count

195− -> ST s ()

196−copyM dest didx src sidx count

197− | count <= 0 = return ()

198− | otherwise =

169+

170+-- | Copy an array in its entirety. The destination array must be at

171+-- least as big as the source.

172+copy :: MArray s -- ^ source array

173+ -> MArray s -- ^ destination array

174+ -> ST s ()

175+copy src dest

176+ | length dest >= length src = copy_loop 0

177+ | otherwise = fail "Data.Text.Array.copy: array too small"

178+ where

179+ len = length src

180+ copy_loop i

181+ | i >= len = return ()

182+ | otherwise = do unsafeRead src i >>= unsafeWrite dest i

183+ copy_loop (i+1)

184+{-# INLINE copy #-}

185+

186+-- | Unsafely copy the elements of an array.

187+unsafeCopy :: MArray s -> Int -> MArray s -> Int -> Int -> ST s ()

188+unsafeCopy src sidx dest didx count =

199189#if defined(ASSERTS)

200190 assert (sidx + count <= length src) .

201− assert (didx + count <= length dest) .

191+ assert (didx + count <= length dest) $

202192#endif

203− unsafeIOToST $ memcpyM (maBA dest) (fromIntegral didx)

204− (maBA src) (fromIntegral sidx)

205− (fromIntegral count)

206−{-# INLINE copyM #-}

207−

208−-- | Copy some elements of an immutable array.

209−copyI :: MArray s -- ^ Destination

210− -> Int -- ^ Destination offset

211− -> Array -- ^ Source

212− -> Int -- ^ Source offset

213− -> Int -- ^ First offset in destination /not/ to

214− -- copy (i.e. /not/ length)

215− -> ST s ()

216−copyI dest i0 src j0 top

217− | i0 >= top = return ()

218− | otherwise = unsafeIOToST $

219− memcpyI (maBA dest) (fromIntegral i0)

220− (aBA src) (fromIntegral j0)

221− (fromIntegral (top-i0))

222−{-# INLINE copyI #-}

223−

224−-- | Compare portions of two arrays for equality. No bounds checking

225−-- is performed.

226−equal :: Array -- ^ First

227− -> Int -- ^ Offset into first

228− -> Array -- ^ Second

229− -> Int -- ^ Offset into second

230− -> Int -- ^ Count

231− -> Bool

232−equal arrA offA arrB offB count = inlinePerformIO $ do

233− i <- memcmp (aBA arrA) (fromIntegral offA)

234− (aBA arrB) (fromIntegral offB) (fromIntegral count)

235− return $! i == 0

236−{-# INLINE equal #-}

237−

238−foreign import ccall unsafe "_hs_text_memcpy" memcpyI

239− :: MutableByteArray# s -> CSize -> ByteArray# -> CSize -> CSize -> IO ()

240−

241−foreign import ccall unsafe "_hs_text_memcmp" memcmp

242− :: ByteArray# -> CSize -> ByteArray# -> CSize -> CSize -> IO CInt

243−

244−foreign import ccall unsafe "_hs_text_memcpy" memcpyM

245− :: MutableByteArray# s -> CSize -> MutableByteArray# s -> CSize -> CSize

246− -> IO ()

193+ copy_loop sidx didx 0

194+ where

195+ copy_loop !i !j !c

196+ | c >= count = return ()

197+ | otherwise = do unsafeRead src i >>= unsafeWrite dest j

198+ copy_loop (i+1) (j+1) (c+1)

199+{-# INLINE unsafeCopy #-}

Data/Text/Encoding.hs+23−375

@@ -1,40 +1,30 @@

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

2− UnliftedFFITypes #-}

3−#if __GLASGOW_HASKELL__ >= 702

4−{-# LANGUAGE Trustworthy #-}

5−#endif

61-- |

72-- Module : Data.Text.Encoding

3+-- Copyright : (c) Tom Harper 2008-2009,

4+-- (c) Bryan O'Sullivan 2009,

5+-- (c) Duncan Coutts 2009

116--

127-- License : BSD-style

13−-- Maintainer : bos@serpentine.com

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

9+-- duncan@haskell.org

1410-- Stability : experimental

1511-- Portability : portable

1612--

1713-- Functions for converting 'Text' values to and from 'ByteString',

1814-- using several standard encodings.

1915--

20−-- To gain access to a much larger family of encodings, use the

21−-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>

16+-- To make use of a much larger variety of encodings, use the @text-icu@

17+-- package.

2218

2319module Data.Text.Encoding

2420 (

2521 -- * Decoding ByteStrings to Text

26− -- $strict

2722 decodeASCII

28− , decodeLatin1

2923 , decodeUtf8

3024 , decodeUtf16LE

3125 , decodeUtf16BE

3226 , decodeUtf32LE

3327 , decodeUtf32BE

34−

35− -- ** Catchable failure

36− , decodeUtf8'

37−

3828 -- ** Controllable error handling

3929 , decodeUtf8With

4030 , decodeUtf16LEWith

@@ -42,350 +32,39 @@ module Data.Text.Encoding

4232 , decodeUtf32LEWith

4333 , decodeUtf32BEWith

4434

45− -- ** Stream oriented decoding

46− -- $stream

47− , streamDecodeUtf8

48− , streamDecodeUtf8With

49− , Decoding(..)

50−

5135 -- * Encoding Text to ByteStrings

5236 , encodeUtf8

5337 , encodeUtf16LE

5438 , encodeUtf16BE

5539 , encodeUtf32LE

5640 , encodeUtf32BE

57−

58− -- * Encoding Text using ByteString Builders

59− , encodeUtf8Builder

60− , encodeUtf8BuilderEscaped

6141 ) where

62−

63−#if __GLASGOW_HASKELL__ >= 702

64−import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)

65−#else

66−import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)

67−#endif

68−

69−import Control.Exception (evaluate, try)

70−import Control.Monad.ST (runST)

71−import Data.Bits ((.&.))

72−import Data.ByteString as B

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

74−import 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(..))

83−import Foreign.ForeignPtr (withForeignPtr)

84−import 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

92−import 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"

98−

99−-- $strict

100−--

101−-- All of the single-parameter functions for decoding bytestrings

102−-- encoded in one of the Unicode Transformation Formats (UTF) operate

103−-- in a /strict/ mode: each will throw an exception if given invalid

104−-- input.

105−--

106−-- Each function has a variant, whose name is suffixed with -'With',

107−-- that gives greater control over the handling of decoding errors.

108−-- For instance, 'decodeUtf8' will throw an exception, but

109−-- 'decodeUtf8With' allows the programmer to determine what to do on a

110−-- decoding error.

111−

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

113−-- encoded text.

42+

43+import Data.ByteString (ByteString)

44+import qualified Data.Text.Fusion as F

45+import Data.Text.Encoding.Error (OnDecodeError, strictDecode)

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

47+import Data.Text.Internal (Text)

48+

49+-- | Decode a 'ByteString' containing 7-bit ASCII encoded text.

11450decodeASCII :: ByteString -> Text

115−decodeASCII = decodeUtf8

116−{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}

117−

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

51+decodeASCII bs = F.unstream (E.streamASCII bs)

52+{-# INLINE decodeASCII #-}

12953

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

13155decodeUtf8With :: 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

154− where

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

156−{- INLINE[0] decodeUtf8With #-}

157−

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.

56+decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)

57+{-# INLINE decodeUtf8With #-}

21058

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−

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

290−-- to be valid.

291−--

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

293−-- thrown that cannot be caught in pure code. For more control over

294−-- the handling of invalid data, use 'decodeUtf8'' or

295−-- 'decodeUtf8With'.

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

29660decodeUtf8 :: ByteString -> Text

29761decodeUtf8 = decodeUtf8With strictDecode

298−{-# INLINE[0] decodeUtf8 #-}

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

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

301−

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

303−--

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

305−-- exception will be returned, otherwise the decoded text.

306−decodeUtf8' :: ByteString -> Either UnicodeException Text

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

308−{-# INLINE decodeUtf8' #-}

309−

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)

62+{-# INLINE decodeUtf8 #-}

37063

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

37265encodeUtf8 :: 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)

66+encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))

67+{-# INLINE encodeUtf8 #-}

38968

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

39170decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text

@@ -393,10 +72,6 @@ decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)

39372{-# INLINE decodeUtf16LEWith #-}

39473

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

396−--

397−-- If the input contains any invalid little endian UTF-16 data, an

398−-- exception will be thrown. For more control over the handling of

399−-- invalid data, use 'decodeUtf16LEWith'.

40075decodeUtf16LE :: ByteString -> Text

40176decodeUtf16LE = decodeUtf16LEWith strictDecode

40277{-# INLINE decodeUtf16LE #-}

@@ -407,10 +82,6 @@ decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)

40782{-# INLINE decodeUtf16BEWith #-}

40883

40984-- | Decode text from big endian UTF-16 encoding.

410−--

411−-- If the input contains any invalid big endian UTF-16 data, an

412−-- exception will be thrown. For more control over the handling of

413−-- invalid data, use 'decodeUtf16BEWith'.

41485decodeUtf16BE :: ByteString -> Text

41586decodeUtf16BE = decodeUtf16BEWith strictDecode

41687{-# INLINE decodeUtf16BE #-}

@@ -431,10 +102,6 @@ decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)

431102{-# INLINE decodeUtf32LEWith #-}

432103

433104-- | Decode text from little endian UTF-32 encoding.

434−--

435−-- If the input contains any invalid little endian UTF-32 data, an

436−-- exception will be thrown. For more control over the handling of

437−-- invalid data, use 'decodeUtf32LEWith'.

438105decodeUtf32LE :: ByteString -> Text

439106decodeUtf32LE = decodeUtf32LEWith strictDecode

440107{-# INLINE decodeUtf32LE #-}

@@ -445,10 +112,6 @@ decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)

445112{-# INLINE decodeUtf32BEWith #-}

446113

447114-- | Decode text from big endian UTF-32 encoding.

448−--

449−-- If the input contains any invalid big endian UTF-32 data, an

450−-- exception will be thrown. For more control over the handling of

451−-- invalid data, use 'decodeUtf32BEWith'.

452115decodeUtf32BE :: ByteString -> Text

453116decodeUtf32BE = decodeUtf32BEWith strictDecode

454117{-# INLINE decodeUtf32BE #-}

@@ -462,18 +125,3 @@ encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))

462125encodeUtf32BE :: Text -> ByteString

463126encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))

464127{-# INLINE encodeUtf32BE #-}

465−

466−foreign import ccall unsafe "_hs_text_decode_utf8" c_decode_utf8

467− :: MutableByteArray# s -> Ptr CSize

468− -> 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+11−24

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

@@ -63,12 +62,7 @@ import Numeric (showHex)

6362-- use the description provided to construct a more helpful error

6463-- report.

6564type OnError a b = String -> Maybe a -> Maybe b

66−

67−-- | A handler for a decoding error.

6865type OnDecodeError = OnError Word8 Char

69−

70−-- | A handler for an encoding error.

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

7266type OnEncodeError = OnError Char Word8

7367

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

@@ -79,9 +73,7 @@ data UnicodeException =

7973 | EncodeError String (Maybe Char)

8074 -- ^ Tried to encode a character that could not be represented

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

82− deriving (Eq, Typeable)

83−

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

76+ deriving (Typeable)

8577

8678showUnicodeException :: UnicodeException -> String

8779showUnicodeException (DecodeError desc (Just w))

@@ -92,28 +84,23 @@ showUnicodeException (EncodeError desc (Just c))

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

9385showUnicodeException (EncodeError desc Nothing)

9486 = "Cannot encode input: " ++ desc

95−

87+

9688instance Show UnicodeException where

9789 show = showUnicodeException

9890

9991instance Exception UnicodeException

10092

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−

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

106−strictDecode :: OnDecodeError

94+strictDecode :: OnError Word8 Char

10795strictDecode desc c = throw (DecodeError desc c)

10896

10997-- | Replace an invalid input byte with the Unicode replacement

11098-- character U+FFFD.

111−lenientDecode :: OnDecodeError

99+lenientDecode :: OnError Word8 Char

112100lenientDecode _ _ = Just '\xfffd'

113101

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

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

116−strictEncode :: OnEncodeError

103+strictEncode :: OnError Char Word8

117104strictEncode desc c = throw (EncodeError desc c)

118105

119106-- | Ignore an invalid input, substituting nothing in the output.

Data/Text/Internal/Encoding/Fusion.hs → Data/Text/Encoding/Fusion.hsrenamed+18−21

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

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

22

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)

@@ -64,7 +61,6 @@ streamASCII bs = Stream next 0 (maxSize l)

6461 | otherwise = Yield (unsafeChr8 x1) (i+1)

6562 where

6663 x1 = B.unsafeIndex bs i

67−{-# DEPRECATED streamASCII "Do not use this function" #-}

6864{-# INLINE [0] streamASCII #-}

6965

7066-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8

@@ -79,8 +75,9 @@ streamUtf8 onErr bs = Stream next 0 (maxSize l)

7975 | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)

8076 | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)

8177 | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)

82− | otherwise = decodeError "streamUtf8" "UTF-8" onErr (Just x1) (i+1)

78+ | otherwise = decodeError "streamUtf8" "UTF-8" onErr mx (i+1)

8379 where

80+ mx = if i >= l then Nothing else Just x1

8481 x1 = idx i

8582 x2 = idx (i + 1)

8683 x3 = idx (i + 2)

@@ -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/Encoding/Fusion/Common.hsnew file+162

@@ -0,0 +1,162 @@

1+{-# LANGUAGE BangPatterns #-}

2+

3+-- |

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

5+-- Copyright : (c) Tom Harper 2008-2009,

6+-- (c) Bryan O'Sullivan 2009,

7+-- (c) Duncan Coutts 2009

8+--

9+-- License : BSD-style

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

11+-- duncan@haskell.org

12+-- Stability : experimental

13+-- Portability : portable

14+--

15+-- Fusible 'Stream'-oriented functions for converting between 'Text'

16+-- and several common encodings.

17+

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

19+ (

20+ -- * Restreaming

21+ -- Restreaming is the act of converting from one 'Stream'

22+ -- representation to another.

23+ restreamUtf8

24+ , restreamUtf16LE

25+ , restreamUtf16BE

26+ , restreamUtf32LE

27+ , restreamUtf32BE

28+ ) where

29+

30+import Data.Bits ((.&.))

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

32+import Data.Text.Fusion.Internal (M(..), S(..))

33+import Data.Text.UnsafeChar (ord)

34+import Data.Text.UnsafeShift (shiftR)

35+import Data.Word (Word8)

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

37+

38+-- | /O(n)/ Convert a Stream Char into a UTF-8 encoded Stream Word8.

39+restreamUtf8 :: Stream Char -> Stream Word8

40+restreamUtf8 (Stream next0 s0 len) =

41+ Stream next (S s0 N N N) (len*2)

42+ where

43+ {-# INLINE next #-}

44+ next (S s N N N) = case next0 s of

45+ Done -> Done

46+ Skip s' -> Skip (S s' N N N)

47+ Yield x xs

48+ | n <= 0x7F -> Yield c (S xs N N N)

49+ | n <= 0x07FF -> Yield a2 (S xs (J b2) N N)

50+ | n <= 0xFFFF -> Yield a3 (S xs (J b3) (J c3) N)

51+ | otherwise -> Yield a4 (S xs (J b4) (J c4) (J d4))

52+ where

53+ n = ord x

54+ c = fromIntegral n

55+ (a2,b2) = U8.ord2 x

56+ (a3,b3,c3) = U8.ord3 x

57+ (a4,b4,c4,d4) = U8.ord4 x

58+ next (S s (J x2) N N) = Yield x2 (S s N N N)

59+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

60+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

61+ next _ = internalError "restreamUtf8"

62+{-# INLINE restreamUtf8 #-}

63+

64+restreamUtf16BE :: Stream Char -> Stream Word8

65+restreamUtf16BE (Stream next0 s0 len) =

66+ Stream next (S s0 N N N) (len*2)

67+ where

68+ {-# INLINE next #-}

69+ next (S s N N N) = case next0 s of

70+ Done -> Done

71+ Skip s' -> Skip (S s' N N N)

72+ Yield x xs

73+ | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $

74+ S xs (J $ fromIntegral n) N N

75+ | otherwise -> Yield c1 $

76+ S xs (J c2) (J c3) (J c4)

77+ where

78+ n = ord x

79+ n1 = n - 0x10000

80+ c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)

81+ c2 = fromIntegral (n1 `shiftR` 10)

82+ n2 = n1 .&. 0x3FF

83+ c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)

84+ c4 = fromIntegral n2

85+ next (S s (J x2) N N) = Yield x2 (S s N N N)

86+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

87+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

88+ next _ = internalError "restreamUtf16BE"

89+{-# INLINE restreamUtf16BE #-}

90+

91+restreamUtf16LE :: Stream Char -> Stream Word8

92+restreamUtf16LE (Stream next0 s0 len) =

93+ Stream next (S s0 N N N) (len*2)

94+ where

95+ {-# INLINE next #-}

96+ next (S s N N N) = case next0 s of

97+ Done -> Done

98+ Skip s' -> Skip (S s' N N N)

99+ Yield x xs

100+ | n < 0x10000 -> Yield (fromIntegral n) $

101+ S xs (J (fromIntegral $ shiftR n 8)) N N

102+ | otherwise -> Yield c1 $

103+ S xs (J c2) (J c3) (J c4)

104+ where

105+ n = ord x

106+ n1 = n - 0x10000

107+ c2 = fromIntegral (shiftR n1 18 + 0xD8)

108+ c1 = fromIntegral (shiftR n1 10)

109+ n2 = n1 .&. 0x3FF

110+ c4 = fromIntegral (shiftR n2 8 + 0xDC)

111+ c3 = fromIntegral n2

112+ next (S s (J x2) N N) = Yield x2 (S s N N N)

113+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

114+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

115+ next _ = internalError "restreamUtf16LE"

116+{-# INLINE restreamUtf16LE #-}

117+

118+restreamUtf32BE :: Stream Char -> Stream Word8

119+restreamUtf32BE (Stream next0 s0 len) =

120+ Stream next (S s0 N N N) (len*2)

121+ where

122+ {-# INLINE next #-}

123+ next (S s N N N) = case next0 s of

124+ Done -> Done

125+ Skip s' -> Skip (S s' N N N)

126+ Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))

127+ where

128+ n = ord x

129+ c1 = fromIntegral $ shiftR n 24

130+ c2 = fromIntegral $ shiftR n 16

131+ c3 = fromIntegral $ shiftR n 8

132+ c4 = fromIntegral n

133+ next (S s (J x2) N N) = Yield x2 (S s N N N)

134+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

135+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

136+ next _ = internalError "restreamUtf32BE"

137+{-# INLINE restreamUtf32BE #-}

138+

139+restreamUtf32LE :: Stream Char -> Stream Word8

140+restreamUtf32LE (Stream next0 s0 len) =

141+ Stream next (S s0 N N N) (len*2)

142+ where

143+ {-# INLINE next #-}

144+ next (S s N N N) = case next0 s of

145+ Done -> Done

146+ Skip s' -> Skip (S s' N N N)

147+ Yield x xs -> Yield c1 (S xs (J c2) (J c3) (J c4))

148+ where

149+ n = ord x

150+ c4 = fromIntegral $ shiftR n 24

151+ c3 = fromIntegral $ shiftR n 16

152+ c2 = fromIntegral $ shiftR n 8

153+ c1 = fromIntegral n

154+ next (S s (J x2) N N) = Yield x2 (S s N N N)

155+ next (S s (J x2) x3 N) = Yield x2 (S s x3 N N)

156+ next (S s (J x2) x3 x4) = Yield x2 (S s x3 x4 N)

157+ next _ = internalError "restreamUtf32LE"

158+{-# INLINE restreamUtf32LE #-}

159+

160+internalError :: String -> a

161+internalError func =

162+ error $ "Data.Text.Encoding.Fusion.Common." ++ func ++ ": internal error"

Data/Text/Internal/Encoding/Utf16.hs → Data/Text/Encoding/Utf16.hsrenamed+9−12

@@ -1,22 +1,19 @@

1−{-# LANGUAGE MagicHash, BangPatterns #-}

1+{-# LANGUAGE MagicHash #-}

22

33-- |

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

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

5+-- Copyright : (c) Tom Harper 2008-2009,

6+-- (c) Bryan O'Sullivan 2009,

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

@@ -36,7 +33,7 @@ chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))

3633{-# INLINE chr2 #-}

3734

3835validate1 :: Word16 -> Bool

39−validate1 x1 = x1 < 0xD800 || x1 > 0xDFFF

36+validate1 x1 = (x1 >= 0 && x1 < 0xD800) || x1 > 0xDFFF

4037{-# INLINE validate1 #-}

4138

4239validate2 :: Word16 -> Word16 -> Bool

Data/Text/Encoding/Utf32.hsnew file+23

@@ -0,0 +1,23 @@

1+-- |

2+-- Module : Data.Text.Encoding.Utf16

3+-- Copyright : (c) Tom Harper 2008-2009,

4+-- (c) Bryan O'Sullivan 2009,

5+-- (c) Duncan Coutts 2009

6+--

7+-- License : BSD-style

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

9+-- duncan@haskell.org

10+-- Stability : experimental

11+-- Portability : portable

12+--

13+-- Basic UTF-32 validation.

14+module Data.Text.Encoding.Utf32

15+ (

16+ validate

17+ ) where

18+

19+import Data.Word (Word32)

20+

21+validate :: Word32 -> Bool

22+validate x1 = (x1 >= 0x0 && x1 < 0xD800) || (x1 > 0xDFFF && x1 <= 0x10FFFF)

23+{-# INLINE validate #-}

Data/Text/Internal/Encoding/Utf8.hs → Data/Text/Encoding/Utf8.hsrenamed+28−30

@@ -1,22 +1,19 @@

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

1+{-# LANGUAGE CPP, MagicHash #-}

22

33-- |

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

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

5+-- Copyright : (c) Tom Harper 2008-2009,

6+-- (c) Bryan O'Sullivan 2009,

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

@@ -55,7 +48,7 @@ between :: Word8 -- ^ byte to check

5548between x y z = x >= y && x <= z

5649{-# INLINE between #-}

5750

58−ord2 :: Char -> (Word8,Word8)

51+ord2 :: Char -> (Word8,Word8)

5952ord2 c =

6053#if defined(ASSERTS)

6154 assert (n >= 0x80 && n <= 0x07ff)

@@ -66,7 +59,7 @@ ord2 c =

6659 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0

6760 x2 = fromIntegral $ (n .&. 0x3F) + 0x80

6861

69−ord3 :: Char -> (Word8,Word8,Word8)

62+ord3 :: Char -> (Word8,Word8,Word8)

7063ord3 c =

7164#if defined(ASSERTS)

7265 assert (n >= 0x0800 && n <= 0xffff)

@@ -78,7 +71,7 @@ ord3 c =

7871 x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80

7972 x3 = fromIntegral $ (n .&. 0x3F) + 0x80

8073

81−ord4 :: Char -> (Word8,Word8,Word8,Word8)

74+ord4 :: Char -> (Word8,Word8,Word8,Word8)

8275ord4 c =

8376#if defined(ASSERTS)

8477 assert (n >= 0x10000)

@@ -91,7 +84,7 @@ ord4 c =

9184 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80

9285 x4 = fromIntegral $ (n .&. 0x3F) + 0x80

9386

94−chr2 :: Word8 -> Word8 -> Char

87+chr2 :: Word8 -> Word8 -> Char

9588chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))

9689 where

9790 !y1# = word2Int# x1#

@@ -100,7 +93,7 @@ chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))

10093 !z2# = y2# -# 0x80#

10194{-# INLINE chr2 #-}

10295

103−chr3 :: Word8 -> Word8 -> Word8 -> Char

96+chr3 :: Word8 -> Word8 -> Word8 -> Char

10497chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))

10598 where

10699 !y1# = word2Int# x1#

@@ -125,17 +118,20 @@ chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =

125118 !z4# = y4# -# 0x80#

126119{-# INLINE chr4 #-}

127120

128−validate1 :: Word8 -> Bool

129−validate1 x1 = x1 <= 0x7F

121+validate1 :: Word8 -> Bool

122+validate1 x1 = between x1 0x00 0x7F

130123{-# INLINE validate1 #-}

131124

132−validate2 :: Word8 -> Word8 -> Bool

125+validate2 :: Word8 -> Word8 -> Bool

133126validate2 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF

134127{-# INLINE validate2 #-}

135128

136−validate3 :: Word8 -> Word8 -> Word8 -> Bool

129+validate3 :: Word8 -> Word8 -> Word8 -> Bool

137130{-# INLINE validate3 #-}

138−validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4

131+validate3 x1 x2 x3 = validate3_1 ||

132+ validate3_2 ||

133+ validate3_3 ||

134+ validate3_4

139135 where

140136 validate3_1 = (x1 == 0xE0) &&

141137 between x2 0xA0 0xBF &&

@@ -150,10 +146,12 @@ validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4

150146 between x2 0x80 0xBF &&

151147 between x3 0x80 0xBF

152148

153−validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool

149+validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool

154150{-# INLINE validate4 #-}

155−validate4 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3

156− where

151+validate4 x1 x2 x3 x4 = validate4_1 ||

152+ validate4_2 ||

153+ validate4_3

154+ where

157155 validate4_1 = x1 == 0xF0 &&

158156 between x2 0x90 0xBF &&

159157 between x3 0x80 0xBF &&

Data/Text/Foreign.hs+19−96

@@ -1,10 +1,11 @@

1−{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving #-}

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

22-- |

33-- Module : Data.Text.Foreign

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

@@ -15,42 +16,25 @@ module Data.Text.Foreign

1516 (

1617 -- * Interoperability with native code

1718 -- $interop

18− I16

19+

1920 -- * Safe conversion functions

20− , fromPtr

21+ fromPtr

2122 , useAsPtr

22− , asForeignPtr

23− -- ** Encoding as UTF-8

24− , peekCStringLen

25− , withCStringLen

2623 -- * Unsafe conversion code

2724 , lengthWord16

2825 , unsafeCopyToPtr

29− -- * Low-level manipulation

30− -- $lowlevel

31− , dropWord16

32− , takeWord16

3326 ) where

3427

3528#if defined(ASSERTS)

3629import Control.Exception (assert)

3730#endif

38−#if __GLASGOW_HASKELL__ >= 702

39−import Control.Monad.ST.Unsafe (unsafeIOToST)

40−#else

4131import Control.Monad.ST (unsafeIOToST)

42−#endif

43−import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen)

44−import Data.Text.Encoding (decodeUtf8, encodeUtf8)

4532import Data.Text.Internal (Text(..), empty)

46−import Data.Text.Unsafe (lengthWord16)

33+import qualified Data.Text.Array as A

4734import Data.Word (Word16)

48−import Foreign.C.String (CStringLen)

49−import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)

5035import Foreign.Marshal.Alloc (allocaBytes)

5136import Foreign.Ptr (Ptr, castPtr, plusPtr)

5237import Foreign.Storable (peek, poke)

53−import qualified Data.Text.Array as A

5438

5539-- $interop

5640--

@@ -65,23 +49,19 @@ import qualified Data.Text.Array as A

6549-- internal representations, such as UTF-8 or UTF-32, consider using

6650-- the functions in the 'Data.Text.Encoding' module.

6751

68−-- | A type representing a number of UTF-16 code units.

69−newtype I16 = I16 Int

70− deriving (Bounded, Enum, Eq, Integral, Num, Ord, Read, Real, Show)

71−

7252-- | /O(n)/ Create a new 'Text' from a 'Ptr' 'Word16' by copying the

7353-- contents of the array.

7454fromPtr :: Ptr Word16 -- ^ source array

75− -> I16 -- ^ length of source array (in 'Word16' units)

55+ -> Int -- ^ length of source array (in 'Word16' units)

7656 -> IO Text

77−fromPtr _ (I16 0) = return empty

78−fromPtr ptr (I16 len) =

57+fromPtr _ 0 = return empty

58+fromPtr ptr len =

7959#if defined(ASSERTS)

8060 assert (len > 0) $

8161#endif

8262 return $! Text arr 0 len

8363 where

84− arr = A.run (A.new len >>= copy)

64+ arr = A.run (A.unsafeNew len >>= copy)

8565 copy marr = loop ptr 0

8666 where

8767 loop !p !i | i == len = return marr

@@ -89,44 +69,12 @@ fromPtr ptr (I16 len) =

8969 A.unsafeWrite marr i =<< unsafeIOToST (peek p)

9070 loop (p `plusPtr` 2) (i + 1)

9171

92−-- $lowlevel

93−--

94−-- Foreign functions that use UTF-16 internally may return indices in

95−-- units of 'Word16' instead of characters. These functions may

96−-- safely be used with such indices, as they will adjust offsets if

97−-- necessary to preserve the validity of a Unicode string.

98−

99−-- | /O(1)/ Return the prefix of the 'Text' of @n@ 'Word16' units in

100−-- length.

101−--

102−-- If @n@ would cause the 'Text' to end inside a surrogate pair, the

103−-- end of the prefix will be advanced by one additional 'Word16' unit

104−-- to maintain its validity.

105−takeWord16 :: I16 -> Text -> Text

106−takeWord16 (I16 n) t@(Text arr off len)

107− | n <= 0 = empty

108− | n >= len || m >= len = t

109− | otherwise = Text arr off m

110− where

111− m | w < 0xDB00 || w > 0xD8FF = n

112− | otherwise = n+1

113− w = A.unsafeIndex arr (off+n-1)

114−

115−-- | /O(1)/ Return the suffix of the 'Text', with @n@ 'Word16' units

116−-- dropped from its beginning.

117−--

118−-- If @n@ would cause the 'Text' to begin inside a surrogate pair, the

119−-- beginning of the suffix will be advanced by one additional 'Word16'

120−-- unit to maintain its validity.

121−dropWord16 :: I16 -> Text -> Text

122−dropWord16 (I16 n) t@(Text arr off len)

123− | n <= 0 = t

124− | n >= len || m >= len = empty

125− | otherwise = Text arr (off+m) (len-m)

126− where

127− m | w < 0xD800 || w > 0xDBFF = n

128− | otherwise = n+1

129− w = A.unsafeIndex arr (off+n-1)

72+-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This

73+-- is useful for sizing a target array appropriately before using

74+-- 'unsafeCopyToPtr'.

75+lengthWord16 :: Text -> Int

76+lengthWord16 (Text _arr _off len) = len

77+{-# INLINE lengthWord16 #-}

13078

13179-- | /O(n)/ Copy a 'Text' to an array. The array is assumed to be big

13280-- enough to hold the contents of the entire 'Text'.

@@ -141,33 +89,8 @@ unsafeCopyToPtr (Text arr off len) ptr = loop ptr off

14189

14290-- | /O(n)/ Perform an action on a temporary, mutable copy of a

14391-- 'Text'. The copy is freed as soon as the action returns.

144−useAsPtr :: Text -> (Ptr Word16 -> I16 -> IO a) -> IO a

92+useAsPtr :: Text -> (Ptr Word16 -> Int -> IO a) -> IO a

14593useAsPtr t@(Text _arr _off len) action =

14694 allocaBytes (len * 2) $ \buf -> do

14795 unsafeCopyToPtr t buf

148− action (castPtr buf) (fromIntegral len)

149−

150−-- | /O(n)/ Make a mutable copy of a 'Text'.

151−asForeignPtr :: Text -> IO (ForeignPtr Word16, I16)

152−asForeignPtr t@(Text _arr _off len) = do

153− fp <- mallocForeignPtrArray len

154− withForeignPtr fp $ unsafeCopyToPtr t

155− 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

96+ action (castPtr buf) len

Data/Text/Internal/Fusion.hs → Data/Text/Fusion.hsrenamed+41−89

@@ -1,23 +1,20 @@

11{-# LANGUAGE BangPatterns, MagicHash #-}

22

33-- |

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

4+-- Module : Data.Text.Fusion

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

6−-- (c) Bryan O'Sullivan 2009-2010,

6+-- (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 : 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(..)

@@ -37,9 +34,6 @@ module Data.Text.Internal.Fusion

3734 -- ** Scans

3835 , reverseScanr

3936

40− -- ** Accumulating maps

41− , mapAccumL

42−

4337 -- ** Generation and unfolding

4438 , unfoldrN

4539

@@ -54,21 +48,21 @@ import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,

5448 fromIntegral, otherwise)

5549import Data.Bits ((.&.))

5650import 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)

51+import Data.Text.UnsafeChar (ord, unsafeChr, unsafeWrite)

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

6053import 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

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

55+import Data.Text.Fusion.Internal

56+import Data.Text.Fusion.Size

6457import qualified Data.Text.Internal as I

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

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

59+import qualified Prelude as P

6660

6761default(Int)

6862

6963-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.

7064stream :: Text -> Stream Char

71−stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)

65+stream (Text arr off len) = Stream next off (maxSize len)

7266 where

7367 !end = off+len

7468 next !i

@@ -83,7 +77,7 @@ stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)

8377-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate

8478-- backwards.

8579reverseStream :: Text -> Stream Char

86−reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)

80+reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)

8781 where

8882 {-# INLINE next #-}

8983 next !i

@@ -97,36 +91,21 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `sh

9791

9892-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.

9993unstream :: 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

94+unstream (Stream next0 s0 len) = I.textP (P.fst a) 0 (P.snd a)

95+ where

96+ mlen = upperBound 4 len

97+ a = A.run2 (A.unsafeNew mlen >>= (\arr -> loop arr mlen s0 0))

98+ loop arr !top !s !i

99+ | i + 1 >= top = case next0 s of

100+ Done -> return (arr, i)

101+ _ -> do

102+ let top' = (top `shiftL` 1) + 1

103+ arr' <- A.unsafeNew top'

104+ A.copy arr arr' >> loop arr' top' s i

105+ | otherwise = case next0 s of

106+ Done -> return (arr, i)

107+ Skip s' -> loop arr top s' i

108+ Yield x s' -> unsafeWrite arr i x >>= loop arr top s'

130109{-# INLINE [0] unstream #-}

131110{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}

132111

@@ -142,19 +121,19 @@ length = S.lengthI

142121reverse :: Stream Char -> Text

143122reverse (Stream next s len0)

144123 | isEmpty len0 = I.empty

145− | otherwise = I.text arr off' len'

124+ | otherwise = I.textP arr off' len'

146125 where

147126 len0' = upperBound 4 (larger len0 4)

148− (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')

127+ (arr, (off', len')) = A.run2 (A.unsafeNew len0' >>= loop s (len0'-1) len0')

149128 loop !s0 !i !len marr =

150129 case next s0 of

151130 Done -> return (marr, (j, len-j))

152131 where j = i + 1

153132 Skip s1 -> loop s1 i len marr

154− Yield x s1 | i < least -> {-# SCC "reverse/resize" #-} do

133+ Yield x s1 | i < least -> do

155134 let newLen = len `shiftL` 1

156− marr' <- A.new newLen

157− A.copyM marr' (newLen-len) marr 0 len

135+ marr' <- A.unsafeNew newLen

136+ A.unsafeCopy marr 0 marr' (newLen-len) len

158137 write s1 (len+i) newLen marr'

159138 | otherwise -> write s1 i len marr

160139 where n = ord x

@@ -176,15 +155,15 @@ reverse (Stream next s len0)

176155-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with

177156-- the input and result reversed.

178157reverseScanr :: (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

158+reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low

180159 where

181160 {-# 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

161+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)

162+ next (S2 :*: z :*: s) = case next0 s of

163+ Yield x s' -> let !x' = f x z

164+ in Yield x' (S2 :*: x' :*: s')

165+ Skip s' -> Skip (S2 :*: z :*: s')

166+ Done -> Done

188167{-# INLINE reverseScanr #-}

189168

190169-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed

@@ -215,30 +194,3 @@ findIndex = S.findIndexI

215194countChar :: Char -> Stream Char -> Int

216195countChar = S.countCharI

217196{-# INLINE [0] countChar #-}

218−

219−-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a

220−-- function to each element of a 'Text', passing an accumulating

221−-- parameter from left to right, and returns a final 'Text'.

222−mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)

223−mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)

224− where

225− (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)

226− where mlen = upperBound 4 len

227− outer arr top = loop

228− where

229− loop !z !s !i =

230− case next0 s of

231− Done -> return (arr, (z,i))

232− Skip s' -> loop z s' i

233− Yield x s'

234− | j >= top -> {-# SCC "mapAccumL/resize" #-} do

235− let top' = (top + 1) `shiftL` 1

236− arr' <- A.new top'

237− A.copyM arr' 0 arr 0 top

238− outer arr' top' z s i

239− | otherwise -> do d <- unsafeWrite arr i c

240− loop z' s' (i+d)

241− where (z',c) = f z x

242− j | ord c < 0x10000 = i

243− | otherwise = i + 1

244−{-# 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−173

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

@@ -33,7 +29,6 @@ module Data.Text.Internal.Fusion.Common

3329 , init

3430 , null

3531 , lengthI

36− , compareLengthI

3732 , isSingleton

3833

3934 -- * Transformations

@@ -45,7 +40,6 @@ module Data.Text.Internal.Fusion.Common

4540 -- $case

4641 , toCaseFold

4742 , toLower

48− , toTitle

4943 , toUpper

5044

5145 -- ** Justification

@@ -71,6 +65,9 @@ module Data.Text.Internal.Fusion.Common

7165 -- ** Scans

7266 , scanl

7367

68+ -- ** Accumulating maps

69+ -- , mapAccumL

70+

7471 -- ** Generation and unfolding

7572 , replicateCharI

7673 , replicateI

@@ -102,25 +99,20 @@ module Data.Text.Internal.Fusion.Common

10299 ) where

103100

104101import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),

105− Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),

106− (&&), fromIntegral, otherwise)

102+ Ord(..), String, (.), ($), (+), (-), (*), (++), (&&),

103+ fromIntegral, otherwise)

107104import qualified Data.List as L

108105import qualified Prelude as P

109−import Data.Bits (shiftL)

110−import Data.Char (isLetter)

111106import 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(..))

107+import Data.Text.Fusion.Internal

108+import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, upperMapping)

109+import Data.Text.Fusion.Size

118110

119111singleton :: Char -> Stream Char

120112singleton c = Stream next False 1

121113 where next False = Yield c True

122114 next True = Done

123−{-# INLINE [0] singleton #-}

115+{-# INLINE singleton #-}

124116

125117streamList :: [a] -> Stream a

126118{-# INLINE [0] streamList #-}

@@ -138,35 +130,6 @@ unstreamList (Stream next s0 _len) = unfold s0

138130

139131{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}

140132

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−

170133-- ----------------------------------------------------------------------------

171134-- * Basic stream functions

172135

@@ -175,7 +138,7 @@ data C s = C0 !s

175138

176139-- | /O(n)/ Adds a character to the front of a Stream Char.

177140cons :: Char -> Stream Char -> Stream Char

178−cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

141+cons w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

179142 where

180143 next (C1 s) = Yield w (C0 s)

181144 next (C0 s) = case next0 s of

@@ -184,9 +147,6 @@ cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

184147 Yield x s' -> Yield x (C0 s')

185148{-# INLINE [0] cons #-}

186149

187−data Snoc a = N

188− | J !a

189−

190150-- | /O(n)/ Adds a character to the end of a stream.

191151snoc :: Stream Char -> Char -> Stream Char

192152snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)

@@ -198,8 +158,8 @@ snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)

198158 next N = Done

199159{-# INLINE [0] snoc #-}

200160

201−data E l r = L !l

202− | R !r

161+data E l r = L {-# UNPACK #-} !l

162+ | R {-# UNPACK #-} !r

203163

204164-- | /O(n)/ Appends one Stream to the other.

205165append :: Stream Char -> Stream Char -> Stream Char

@@ -224,13 +184,9 @@ head (Stream next s0 _len) = loop_head s0

224184 loop_head !s = case next s of

225185 Yield x _ -> x

226186 Skip s' -> loop_head s'

227− Done -> head_empty

187+ Done -> streamError "head" "Empty stream"

228188{-# INLINE [0] head #-}

229189

230−head_empty :: a

231−head_empty = streamError "head" "Empty stream"

232−{-# NOINLINE head_empty #-}

233−

234190-- | /O(1)/ Returns the first character and remainder of a 'Stream

235191-- Char', or 'Nothing' if empty. Subject to array fusion.

236192uncons :: Stream Char -> Maybe (Char, Stream Char)

@@ -310,26 +266,6 @@ lengthI (Stream next s0 _len) = loop_length 0 s0

310266 Yield _ s' -> loop_length (z + 1) s'

311267{-# INLINE[0] lengthI #-}

312268

313−-- | /O(n)/ Compares the count of characters in a string to a number.

314−-- Subject to fusion.

315−--

316−-- This function gives the same answer as comparing against the result

317−-- 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.

320−compareLengthI :: Integral a => Stream Char -> a -> Ordering

321−compareLengthI (Stream next s0 len) n =

322− case compareSize len (fromIntegral n) of

323− Just o -> o

324− Nothing -> loop_cmp 0 s0

325− where

326− loop_cmp !z s = case next s of

327− Done -> compare z n

328− Skip s' -> loop_cmp z s'

329− Yield _ s' | z > n -> GT

330− | otherwise -> loop_cmp (z + 1) s'

331−{-# INLINE[0] compareLengthI #-}

332−

333269-- | /O(n)/ Indicate whether a string contains exactly one element.

334270isSingleton :: Stream Char -> Bool

335271isSingleton (Stream next s0 _len) = loop 0 s0

@@ -439,54 +375,17 @@ toLower :: Stream Char -> Stream Char

439375toLower = caseConvert lowerMapping

440376{-# INLINE [0] toLower #-}

441377

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−

479378justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

480379justifyLeftI k c (Stream next0 s0 len) =

481− Stream next (Just1 0 s0) (larger (fromIntegral k) len)

380+ Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)

482381 where

483− next (Just1 n s) =

382+ next (s :*: S1 :*: n) =

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

384+ Done -> next (s :*: S2 :*: n)

385+ Skip s' -> Skip (s' :*: S1 :*: n)

386+ Yield x s' -> Yield x (s' :*: S1 :*: n+1)

387+ next (s :*: S2 :*: n)

388+ | n < k = Yield c (s :*: S2 :*: n+1)

490389 | otherwise = Done

491390 {-# INLINE next #-}

492391{-# INLINE [0] justifyLeftI #-}

@@ -593,7 +492,7 @@ concatMap f = foldr (append . f) empty

593492{-# INLINE [0] concatMap #-}

594493

595494-- | /O(n)/ any @p @xs determines if any character in the stream

596−-- @xs@ satisfies the predicate @p@.

495+-- @xs@ satisifes the predicate @p@.

597496any :: (Char -> Bool) -> Stream Char -> Bool

598497any p (Stream next0 s0 _len) = loop_any s0

599498 where

@@ -605,7 +504,7 @@ any p (Stream next0 s0 _len) = loop_any s0

605504{-# INLINE [0] any #-}

606505

607506-- | /O(n)/ all @p @xs determines if all characters in the 'Text'

608−-- @xs@ satisfy the predicate @p@.

507+-- @xs@ satisify the predicate @p@.

609508all :: (Char -> Bool) -> Stream Char -> Bool

610509all p (Stream next0 s0 _len) = loop_all s0

611510 where

@@ -654,27 +553,50 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0

654553-- * Building streams

655554

656555scanl :: (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

556+scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low

658557 where

659558 {-# 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

559+ next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)

560+ next (S2 :*: z :*: s) = case next0 s of

561+ Yield x s' -> let !x' = f z x

562+ in Yield x' (S2 :*: x' :*: s')

563+ Skip s' -> Skip (S2 :*: z :*: s')

564+ Done -> Done

666565{-# INLINE [0] scanl #-}

667566

567+-- -----------------------------------------------------------------------------

568+-- ** Accumulating maps

569+

570+{-

571+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a

572+-- function to each element of a stream, passing an accumulating

573+-- parameter from left to right, and returns a final stream.

574+--

575+-- /Note/: Unlike the version over lists, this function does not

576+-- return a final value for the accumulator, because the nature of

577+-- streams precludes it.

578+mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b

579+mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f

580+ where

581+ {-# INLINE next #-}

582+ next (s :*: z) = case next0 s of

583+ Yield x s' -> let (z',y) = f z x

584+ in Yield y (s' :*: z')

585+ Skip s' -> Skip (s' :*: z)

586+ Done -> Done

587+{-# INLINE [0] mapAccumL #-}

588+-}

589+

668590-- -----------------------------------------------------------------------------

669591-- ** Generating and unfolding streams

670592

671593replicateCharI :: Integral a => a -> Char -> Stream Char

672−replicateCharI !n !c

594+replicateCharI n c

673595 | n < 0 = empty

674596 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low

675597 where

676− next !i | i >= n = Done

677− | otherwise = Yield c (i + 1)

598+ next i | i >= n = Done

599+ | otherwise = Yield c (i + 1)

678600{-# INLINE [0] replicateCharI #-}

679601

680602data RI s = RI !s {-# UNPACK #-} !Int64

@@ -739,27 +661,24 @@ take n0 (Stream next0 s0 len) =

739661 Yield x s' -> Yield x ((n-1) :*: s')

740662{-# INLINE [0] take #-}

741663

742−data Drop a s = NS !s

743− | JS !a !s

744−

745664-- | /O(n)/ drop n, applied to a stream, returns the suffix of the

746665-- stream after the first @n@ characters, or the empty stream if @n@

747666-- is greater than the length of the stream.

748667drop :: Integral a => a -> Stream Char -> Stream Char

749668drop n0 (Stream next0 s0 len) =

750− Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))

669+ Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))

751670 where

752671 {-# INLINE next #-}

753− next (JS n s)

754− | n <= 0 = Skip (NS s)

672+ next (J n :*: s)

673+ | n <= 0 = Skip (N :*: s)

755674 | otherwise = case next0 s of

756675 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

676+ Skip s' -> Skip (J n :*: s')

677+ Yield _ s' -> Skip (J (n-1) :*: s')

678+ next (N :*: s) = case next0 s of

760679 Done -> Done

761− Skip s' -> Skip (NS s')

762− Yield x s' -> Yield x (NS s')

680+ Skip s' -> Skip (N :*: s')

681+ Yield x s' -> Yield x (N :*: s')

763682{-# INLINE [0] drop #-}

764683

765684-- | takeWhile, applied to a predicate @p@ and a stream, returns the

@@ -777,18 +696,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

777696

778697-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

779698dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

780−dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high

699+dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high

781700 where

782701 {-# INLINE next #-}

783− next (L s) = case next0 s of

702+ next (S1 :*: s) = case next0 s of

784703 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

704+ Skip s' -> Skip (S1 :*: s')

705+ Yield x s' | p x -> Skip (S1 :*: s')

706+ | otherwise -> Yield x (S2 :*: s')

707+ next (S2 :*: s) = case next0 s of

789708 Done -> Done

790− Skip s' -> Skip (R s')

791− Yield x s' -> Yield x (R s')

709+ Skip s' -> Skip (S2 :*: s')

710+ Yield x s' -> Yield x (S2 :*: s')

792711{-# INLINE [0] dropWhile #-}

793712

794713-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns

@@ -804,6 +723,7 @@ isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

804723 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

805724 loop (next1 s1') (next2 s2')

806725{-# INLINE [0] isPrefixOf #-}

726+{-# SPECIALISE isPrefixOf :: Stream Char -> Stream Char -> Bool #-}

807727

808728-- ----------------------------------------------------------------------------

809729-- * Searching

@@ -895,25 +815,21 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0

895815-------------------------------------------------------------------------------

896816-- * Zipping

897817

898−-- | Strict triple.

899−data Zip a b m = Z1 !a !b

900− | Z2 !a !b !m

901−

902818-- | zipWith generalises 'zip' by zipping with the function given as

903819-- the first argument, instead of a tupling function.

904820zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b

905821zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =

906− Stream next (Z1 sa0 sb0) (smaller len1 len2)

822+ Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)

907823 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')

824+ next (sa :*: sb :*: N) = case next0 sa of

825+ Done -> Done

826+ Skip sa' -> Skip (sa' :*: sb :*: N)

827+ Yield a sa' -> Skip (sa' :*: sb :*: J a)

828+

829+ next (sa' :*: sb :*: J a) = case next1 sb of

830+ Done -> Done

831+ Skip sb' -> Skip (sa' :*: sb' :*: J a)

832+ Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)

917833{-# INLINE [0] zipWith #-}

918834

919835-- | /O(n)/ The 'countCharI' function returns the number of times the

@@ -929,7 +845,7 @@ countCharI a (Stream next s0 _len) = loop 0 s0

929845{-# INLINE [0] countCharI #-}

930846

931847streamError :: String -> String -> a

932−streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg

848+streamError func msg = P.error $ "Data.Text.Fusion.Common." ++ func ++ ": " ++ msg

933849

934850emptyError :: String -> a

935851emptyError func = internalError func "Empty input"

Data/Text/Internal/Fusion/Types.hs → Data/Text/Fusion/Internal.hsrenamed+26−28

@@ -1,66 +1,62 @@

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,

6−-- (c) Duncan Coutts 2009,

7−-- (c) Jasper Van der Jeugt 2011

6+-- (c) Duncan Coutts 2009

87--

98-- License : BSD-style

10−-- Maintainer : bos@serpentine.com

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

10+-- duncan@haskell.org

1111-- Stability : experimental

1212-- Portability : GHC

1313--

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

1814-- Core stream fusion functionality for text.

1915

20−module Data.Text.Internal.Fusion.Types

16+module Data.Text.Fusion.Internal

2117 (

2218 CC(..)

19+ , M(..)

20+ , M8

2321 , PairS(..)

24− , Scan(..)

25− , RS(..)

22+ , S(..)

2623 , Step(..)

2724 , Stream(..)

25+ , Switch(..)

2826 , empty

2927 ) where

3028

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

29+import Data.Text.Fusion.Size

3230import Data.Word (Word8)

3331

3432-- | Specialised tuple for case conversion.

3533data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

3634

37−-- | Restreaming state.

38−data RS s

39− = RS0 !s

40− | RS1 !s {-# UNPACK #-} !Word8

41− | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

42− | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

35+-- | Specialised, strict Maybe-like type.

36+data M a = N

37+ | J {-# UNPACK #-} !a

38+

39+type M8 = M Word8

40+

41+-- Restreaming state.

42+data S s = S {-# UNPACK #-} !s

43+ {-# UNPACK #-} !M8 {-# UNPACK #-} !M8 {-# UNPACK #-} !M8

4344

44−-- | Strict pair.

45−data PairS a b = !a :*: !b

46− -- deriving (Eq, Ord, Show)

4745infixl 2 :*:

46+data PairS a b = {-# UNPACK #-} !a :*: {-# UNPACK #-} !b

47+ deriving (Eq, Ord, Show)

4848

49−-- | An intermediate result in a scan.

50−data Scan s = Scan1 {-# UNPACK #-} !Char !s

51− | Scan2 {-# UNPACK #-} !Char !s

49+-- | Allow a function over a stream to switch between two states.

50+data Switch = S1 | S2

5251

53−-- | Intermediate result in a processing pipeline.

5452data Step s a = Done

5553 | Skip !s

5654 | Yield !a !s

5755

58−{-

5956instance (Show a) => Show (Step s a)

6057 where show Done = "Done"

6158 show (Skip _) = "Skip"

6259 show (Yield x _) = "Yield " ++ show x

63−-}

6460

6561instance (Eq a) => Eq (Stream a) where

6662 (==) = eq

@@ -84,7 +80,7 @@ data Stream a =

8480 forall s. Stream

8581 (s -> Step s a) -- stepper function

8682 !s -- current state

87− !Size -- size hint

83+ {-# UNPACK #-} !Size -- size hint

8884

8985-- | /O(n)/ Determines if two streams are equal.

9086eq :: (Eq a) => Stream a -> Stream a -> Bool

@@ -99,6 +95,7 @@ eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

9995 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

10096 loop (next1 s1') (next2 s2')

10197{-# INLINE [0] eq #-}

98+{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}

10299

103100cmp :: (Ord a) => Stream a -> Stream a -> Ordering

104101cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

@@ -114,6 +111,7 @@ cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

114111 EQ -> loop (next1 s1') (next2 s2')

115112 other -> other

116113{-# INLINE [0] cmp #-}

114+{-# SPECIALISE cmp :: Stream Char -> Stream Char -> Ordering #-}

117115

118116-- | The empty stream.

119117empty :: Stream a

Data/Text/Fusion/Size.hsnew file+140

@@ -0,0 +1,140 @@

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

20+ , maxSize

21+ , unknownSize

22+ , smaller

23+ , larger

24+ , toMax

25+ , upperBound

26+ , lowerBound

27+ , isEmpty

28+ ) where

29+

30+#if defined(ASSERTS)

31+import Control.Exception (assert)

32+#endif

33+

34+data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.

35+ | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.

36+ | Unknown -- ^ Unknown size.

37+ deriving (Eq, Show)

38+

39+exactSize :: Int -> Size

40+exactSize n =

41+#if defined(ASSERTS)

42+ assert (n >= 0)

43+#endif

44+ Exact n

45+{-# INLINE exactSize #-}

46+

47+maxSize :: Int -> Size

48+maxSize n =

49+#if defined(ASSERTS)

50+ assert (n >= 0)

51+#endif

52+ Max n

53+{-# INLINE maxSize #-}

54+

55+unknownSize :: Size

56+unknownSize = Unknown

57+{-# INLINE unknownSize #-}

58+

59+instance Num Size where

60+ (+) = addSize

61+ (-) = subtractSize

62+ (*) = mulSize

63+

64+ fromInteger = f where f = Exact . fromInteger

65+ {-# INLINE f #-}

66+

67+addSize :: Size -> Size -> Size

68+addSize (Exact m) (Exact n) = Exact (m+n)

69+addSize (Exact m) (Max n) = Max (m+n)

70+addSize (Max m) (Exact n) = Max (m+n)

71+addSize (Max m) (Max n) = Max (m+n)

72+addSize _ _ = Unknown

73+{-# INLINE addSize #-}

74+

75+subtractSize :: Size -> Size -> Size

76+subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)

77+subtractSize (Exact m) (Max _) = Max m

78+subtractSize (Max m) (Exact n) = Max (max (m-n) 0)

79+subtractSize a@(Max _) (Max _) = a

80+subtractSize a@(Max _) Unknown = a

81+subtractSize _ _ = Unknown

82+{-# INLINE subtractSize #-}

83+

84+mulSize :: Size -> Size -> Size

85+mulSize (Exact m) (Exact n) = Exact (m*n)

86+mulSize (Exact m) (Max n) = Max (m*n)

87+mulSize (Max m) (Exact n) = Max (m*n)

88+mulSize (Max m) (Max n) = Max (m*n)

89+mulSize _ _ = Unknown

90+{-# INLINE mulSize #-}

91+

92+-- | Minimum of two size hints.

93+smaller :: Size -> Size -> Size

94+smaller (Exact m) (Exact n) = Exact (m `min` n)

95+smaller (Exact m) (Max n) = Max (m `min` n)

96+smaller (Exact m) Unknown = Max m

97+smaller (Max m) (Exact n) = Max (m `min` n)

98+smaller (Max m) (Max n) = Max (m `min` n)

99+smaller a@(Max _) Unknown = a

100+smaller Unknown (Exact n) = Max n

101+smaller Unknown (Max n) = Max n

102+smaller Unknown Unknown = Unknown

103+{-# INLINE smaller #-}

104+

105+-- | Maximum of two size hints.

106+larger :: Size -> Size -> Size

107+larger (Exact m) (Exact n) = Exact (m `max` n)

108+larger a@(Exact m) b@(Max n) | m >= n = a

109+ | otherwise = b

110+larger a@(Max m) b@(Exact n) | n >= m = b

111+ | otherwise = a

112+larger (Max m) (Max n) = Max (m `max` n)

113+larger _ _ = Unknown

114+{-# INLINE larger #-}

115+

116+-- | Convert a size hint to an upper bound.

117+toMax :: Size -> Size

118+toMax (Exact n) = Max n

119+toMax a@(Max _) = a

120+toMax Unknown = Unknown

121+{-# INLINE toMax #-}

122+

123+-- | Compute the minimum size from a size hint.

124+lowerBound :: Size -> Int

125+lowerBound (Exact n) = n

126+lowerBound _ = 0

127+{-# INLINE lowerBound #-}

128+

129+-- | Compute the maximum size from a size hint, if possible.

130+upperBound :: Int -> Size -> Int

131+upperBound _ (Exact n) = n

132+upperBound _ (Max n) = n

133+upperBound k _ = k

134+{-# INLINE upperBound #-}

135+

136+isEmpty :: Size -> Bool

137+isEmpty (Exact n) = n <= 0

138+isEmpty (Max n) = n <= 0

139+isEmpty _ = False

140+{-# INLINE isEmpty #-}

Data/Text/IO.hs+47−97

@@ -1,26 +1,17 @@

1−{-# LANGUAGE BangPatterns, CPP, RecordWildCards, ScopedTypeVariables #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-}

4−#endif

1+{-# LANGUAGE BangPatterns, CPP, RecordWildCards #-}

52-- |

63-- Module : Data.Text.IO

4+-- Copyright : (c) Bryan O'Sullivan 2009,

5+-- (c) Simon Marlow 2009

96-- License : BSD-style

107-- Maintainer : bos@serpentine.com

118-- Stability : experimental

129-- Portability : GHC

1310--

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

15−--

16−-- Skip past the synopsis for some important notes on performance and

17−-- portability across different versions of GHC.

1812

1913module Data.Text.IO

2014 (

21− -- * Performance

22− -- $performance

23−

2415 -- * Locale support

2516 -- $locale

2617 -- * File-at-a-time operations

@@ -29,7 +20,6 @@ module Data.Text.IO

2920 , appendFile

3021 -- * Operations on handles

3122 , hGetContents

32− , hGetChunk

3323 , hGetLine

3424 , hPutStr

3525 , hPutStrLn

@@ -42,44 +32,30 @@ module Data.Text.IO

4232 ) where

4333

4434import Data.Text (Text)

45−import Prelude hiding (appendFile, getContents, getLine, interact,

46− putStr, putStrLn, readFile, writeFile)

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

36+ putStrLn, readFile, writeFile)

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

4838 withFile)

49−import qualified Control.Exception as E

50−import Control.Monad (liftM2, when)

39+#if __GLASGOW_HASKELL__ <= 610

40+import qualified Data.ByteString.Char8 as B

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

42+#else

43+import Control.Exception (throw)

5144import Data.IORef (readIORef, writeIORef)

5245import 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)

46+import Data.Text.Fusion (stream)

47+import Data.Text.Fusion.Internal (Step(..), Stream(..))

48+import Data.Text.IO.Internal (hGetLineWith, readChunk)

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

5750 RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,

5851 writeCharBuf)

59−import GHC.IO.Exception (IOException(ioe_type), IOErrorType(InappropriateType))

6052import GHC.IO.Handle.Internals (augmentIOError, hClose_help, wantReadableHandle,

6153 wantWritableHandle)

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

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

64− HandleType(..), Newline(..))

65−import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)

56+ Newline(..))

6657import System.IO.Error (isEOFError)

67−

68−-- $performance

69−-- #performance#

70−--

71−-- The functions in this module obey the runtime system's locale,

72−-- character set encoding, and line ending conversion settings.

73−--

74−-- If you know in advance that you will be working with data that has

75−-- a specific encoding (e.g. UTF-8), and your application is highly

76−-- performance sensitive, you may find that it is faster to perform

77−-- I\/O with bytestrings and to encode and decode yourself than to use

78−-- the functions in this module.

79−--

80−-- Whether this will hold depends on the version of GHC you are using,

81−-- the platform you are working on, the data you are working with, and

82−-- the encodings you are using, so be sure to test for yourself.

58+#endif

8359

8460-- | The 'readFile' function reads a file and returns the contents of

8561-- the file as a string. The entire file is read strictly, as with

@@ -96,30 +72,6 @@ writeFile p = withFile p WriteMode . flip hPutStr

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

9773appendFile p = withFile p AppendMode . flip hPutStr

9874

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−

12375-- | Read the remaining contents of a 'Handle' as a string. The

12476-- 'Handle' is closed once the contents have been read, or if an

12577-- exception is thrown.

@@ -132,47 +84,44 @@ hGetChunk h = wantReadableHandle "hGetChunk" h readSingleChunk

13284-- result to construct its result. For files more than a half of

13385-- available RAM in size, this may result in memory exhaustion.

13486hGetContents :: Handle -> IO Text

135−hGetContents h = do

136− chooseGoodBuffering h

137− wantReadableHandle "hGetContents" h readAll

87+#if __GLASGOW_HASKELL__ <= 610

88+hGetContents = fmap decodeUtf8 . B.hGetContents

89+#else

90+hGetContents h = wantReadableHandle "hGetContents" h $ \hh -> do

91+ (hh',ts) <- readAll hh

92+ return (hh',T.concat ts)

13893 where

13994 readAll hh@Handle__{..} = do

95+ buf <- readIORef haCharBuffer

14096 let readChunks = do

141− buf <- readIORef haCharBuffer

142− t <- readChunk hh buf `E.catch` catchError "hGetContents" h hh

143− if T.null t

144− then return [t]

145− else (t:) `fmap` readChunks

146− ts <- readChunks

147− (hh', _) <- hClose_help hh

148− return (hh'{haType=ClosedHandle}, T.concat ts)

149−

150−-- | Use a more efficient buffer size if we're reading in

151−-- block-buffered mode with the default buffer size. When we can

152−-- determine the size of the handle we're reading, set the buffer size

153−-- to that, so that we can read the entire file in one chunk.

154−-- Otherwise, use a buffer size of at least 16KB.

155−chooseGoodBuffering :: Handle -> IO ()

156−chooseGoodBuffering h = do

157− bufMode <- hGetBuffering h

158− case bufMode of

159− BlockBuffering Nothing -> do

160− d <- E.catch (liftM2 (-) (hFileSize h) (hTell h)) $ \(e::IOException) ->

161− if ioe_type e == InappropriateType

162− then return 16384 -- faster than the 2KB default

163− else E.throwIO e

164− when (d > 0) . hSetBuffering h . BlockBuffering . Just . fromIntegral $ d

165− _ -> return ()

166−

97+ t <- readChunk hh buf

98+ (hh',ts) <- readAll hh

99+ return (hh', t:ts)

100+ readChunks `catch` \e -> do

101+ (hh', _) <- hClose_help hh

102+ if isEOFError e

103+ then return $ if isEmptyBuffer buf

104+ then (hh', [])

105+ else (hh', [T.singleton '\r'])

106+ else throw (augmentIOError e "hGetContents" h)

107+#endif

108+

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

168110hGetLine :: Handle -> IO Text

111+#if __GLASGOW_HASKELL__ <= 610

112+hGetLine = fmap decodeUtf8 . B.hGetLine

113+#else

169114hGetLine = hGetLineWith T.concat

115+#endif

170116

171117-- | Write a string to a handle.

172118hPutStr :: Handle -> Text -> IO ()

119+#if __GLASGOW_HASKELL__ <= 610

120+hPutStr h = B.hPutStr h . encodeUtf8

121+#else

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

174123hPutStr h t = do

175− (buffer_mode, nl) <-

124+ (buffer_mode, nl) <-

176125 wantWritableHandle "hPutStr" h $ \h_ -> do

177126 bmode <- getSpareBuffer h_

178127 return (bmode, haOutputNL h_)

@@ -254,7 +203,7 @@ writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0

254203

255204-- This function is completely lifted from GHC.IO.Handle.Text.

256205getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)

257−getSpareBuffer Handle__{haCharBuffer=ref,

206+getSpareBuffer Handle__{haCharBuffer=ref,

258207 haBuffers=spare_ref,

259208 haBufferMode=mode}

260209 = do

@@ -275,10 +224,11 @@ getSpareBuffer Handle__{haCharBuffer=ref,

275224-- This function is completely lifted from GHC.IO.Handle.Text.

276225commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool

277226 -> IO CharBuffer

278−commitBuffer hdl !raw !sz !count flush release =

227+commitBuffer hdl !raw !sz !count flush release =

279228 wantWritableHandle "commitAndReleaseBuffer" hdl $

280229 commitBuffer' raw sz count flush release

281230{-# INLINE commitBuffer #-}

231+#endif

282232

283233-- | Write a string to a handle, followed by a newline.

284234hPutStrLn :: Handle -> Text -> IO ()

@@ -315,8 +265,8 @@ putStrLn = hPutStrLn stdout

315265-- Beginning with GHC 6.12, text I\/O is performed using the system or

316266-- handle's current locale and line ending conventions.

317267--

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

319−-- support locale-sensitive I\/O or line ending conversion. On these

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

269+-- support/ locale-sensitive I\/O or line ending conversion. On these

320270-- versions of GHC, functions in this library all use UTF-8. What

321271-- does this mean in practice?

322272--

Data/Text/Internal/IO.hs → Data/Text/IO/Internal.hsrenamed+19−21

@@ -1,31 +1,29 @@

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

22-- |

3−-- Module : Data.Text.Internal.IO

3+-- Module : Data.Text.IO.Internal

4+-- Copyright : (c) Bryan O'Sullivan 2009,

5+-- (c) Simon Marlow 2009

66-- License : BSD-style

77-- Maintainer : bos@serpentine.com

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

2422import Data.IORef (readIORef, writeIORef)

2523import 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)

24+import Data.Text.Fusion (unstream)

25+import Data.Text.Fusion.Internal (Step(..), Stream(..))

26+import Data.Text.Fusion.Size (exactSize, maxSize)

2927import Data.Text.Unsafe (inlinePerformIO)

3028import Foreign.Storable (peekElemOff)

3129import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,

@@ -46,8 +44,7 @@ hGetLineWith f h = wantReadableHandle_ "hGetLine" h go

4644 go hh@Handle__{..} = readIORef haCharBuffer >>= fmap f . hGetLineLoop hh []

4745

4846hGetLineLoop :: Handle__ -> [Text] -> CharBuffer -> IO [Text]

49−hGetLineLoop hh@Handle__{..} = go where

50− go ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do

47+hGetLineLoop hh@Handle__{..} ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do

5148 let findEOL raw r | r == w = return (False, w)

5249 | otherwise = do

5350 (c,r') <- readCharBuf raw r

@@ -75,18 +72,18 @@ hGetLineLoop hh@Handle__{..} = go where

7572 let pre | isEmptyBuffer buf1 = T.empty

7673 | otherwise = T.singleton '\r'

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

78− let str = reverse . filter (not . T.null) $ pre:t:ts

79− if null str

75+ let str = reverse $ pre:t:ts

76+ if all T.null str

8077 then ioe_EOF

8178 else return str

82− Just new_buf -> go (t:ts) new_buf

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

8380

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

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

8683maybeFillReadBuffer handle_ buf

87− = E.catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->

88− if isEOFError e

89− then return Nothing

84+ = catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->

85+ if isEOFError e

86+ then return Nothing

9087 else ioError e

9188

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

@@ -108,7 +105,7 @@ unpack_nl !buf !r !w

108105 | otherwise = withRawBuffer buf $ go

109106 where

110107 go pbuf = do

111− let !t = unstream (Stream next r (maxSize (w-r)))

108+ let t = unstream (Stream next r (maxSize (w-r)))

112109 w' = w - 1

113110 return $ if ix w' == '\r'

114111 then (t,w')

@@ -164,3 +161,4 @@ readChunk hh@Handle__{..} buf = do

164161

165162sizeError :: String -> a

166163sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"

164+#endif

Data/Text/Internal.hs+19−133

@@ -1,48 +1,29 @@

1−{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}

2−{-# OPTIONS_HADDOCK not-home #-}

1+{-# LANGUAGE CPP, DeriveDataTypeable #-}

32

43-- |

54-- Module : Data.Text.Internal

5+-- Copyright : (c) Tom Harper 2008-2009,

6+-- (c) Bryan O'Sullivan 2009,

7+-- (c) Duncan Coutts 2009

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

15−-- A module containing private 'Text' internals. This exposes the

16−-- 'Text' representation and low level construction functions.

17−-- Modules which extend the 'Text' system may need to use this module.

18−--

19−-- You should not use this module unless you are determined to monkey

20−-- with the internals, as the functions here do just about nothing to

21−-- preserve data invariants. You have been warned!

22−

23−#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)

24−#include "MachDeps.h"

25−#endif

15+-- Semi-public internals. Most users should not need to use this

16+-- module.

2617

2718module Data.Text.Internal

2819 (

2920 -- * Types

30− -- $internals

3121 Text(..)

3222 -- * Construction

3323 , text

3424 , textP

35− -- * Safety

36− , safe

3725 -- * Code that must be here for accessibility

3826 , empty

39− , empty_

40− -- * Utilities

41− , firstf

42− -- * Checked multiplication

43− , mul

44− , mul32

45− , mul64

4627 -- * Debugging

4728 , showText

4829 ) where

@@ -50,22 +31,19 @@ module Data.Text.Internal

5031#if defined(ASSERTS)

5132import Control.Exception (assert)

5233#endif

53−import Data.Bits

54−import Data.Int (Int32, Int64)

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

56−import Data.Typeable (Typeable)

5734import qualified Data.Text.Array as A

35+import Data.Typeable (Typeable)

5836

5937-- | A space efficient, packed, unboxed Unicode text type.

6038data 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)

39+ {-# UNPACK #-} !A.Array -- payload

40+ {-# UNPACK #-} !Int -- offset

41+ {-# UNPACK #-} !Int -- length

6442 deriving (Typeable)

6543

6644-- | Smart constructor.

67−text_ :: A.Array -> Int -> Int -> Text

68−text_ arr off len =

45+text :: A.Array -> Int -> Int -> Text

46+text arr off len =

6947#if defined(ASSERTS)

7048 let c = A.unsafeIndex arr off

7149 alen = A.length arr

@@ -75,114 +53,22 @@ text_ arr off len =

7553 assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $

7654#endif

7755 Text arr off len

78−{-# INLINE text_ #-}

56+{-# INLINE text #-}

7957

8058-- | /O(1)/ The empty 'Text'.

8159empty :: Text

8260empty = Text A.empty 0 0

8361{-# INLINE [1] empty #-}

8462

85−-- | A non-inlined version of 'empty'.

86−empty_ :: Text

87−empty_ = Text A.empty 0 0

88−{-# NOINLINE empty_ #-}

89−

9063-- | Construct a 'Text' without invisibly pinning its byte array in

9164-- 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−

9765textP :: A.Array -> Int -> Int -> Text

98−{-# DEPRECATED textP "Use text instead" #-}

99−textP = text

66+textP arr off len | len == 0 = empty

67+ | otherwise = text arr off len

68+{-# INLINE textP #-}

10069

10170-- | A useful 'show'-like function for debugging purposes.

10271showText :: Text -> String

10372showText (Text arr off len) =

104− "Text " ++ show (A.toList arr off len) ++ ' ' :

73+ "Text " ++ (show . take (off+len) . A.toList) arr ++ ' ' :

10574 show off ++ ' ' : show len

106−

107−-- | Map a 'Char' to a 'Text'-safe value.

108−--

109−-- UTF-16 surrogate code points are not included in the set of Unicode

110−-- scalar values, but are unfortunately admitted as valid 'Char'

111−-- values by Haskell. They cannot be represented in a 'Text'. This

112−-- function remaps those code points to the Unicode replacement

113−-- character (U+FFFD, \'�\'), and leaves other code points

114−-- unchanged.

115−safe :: Char -> Char

116−safe c

117− | ord c .&. 0x1ff800 /= 0xd800 = c

118− | otherwise = '\xfffd'

119−{-# INLINE [0] safe #-}

120−

121−-- | Apply a function to the first element of an optional pair.

122−firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)

123−firstf f (Just (a, b)) = Just (f a, b)

124−firstf _ 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/Functions.hsdeleted−40

@@ -1,40 +0,0 @@

1−{-# LANGUAGE MagicHash #-}

2−

3−-- |

4−-- Module : Data.Text.Internal.Builder.Functions

6−--

7−-- License : BSD-style

8−-- Maintainer : bos@serpentine.com

9−-- Stability : experimental

10−-- Portability : GHC

11−--

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−-- Useful functions and combinators.

17−

18−module Data.Text.Internal.Builder.Functions

19− (

20− (<>)

21− , i2d

22− ) where

23−

24−import Data.Monoid (mappend)

25−import Data.Text.Lazy.Builder (Builder)

26−import GHC.Base (chr#,ord#,(+#),Int(I#),Char(C#))

27−import Prelude ()

28−

29−-- | Unsafe conversion for decimal digits.

30−{-# INLINE i2d #-}

31−i2d :: Int -> Char

32−i2d (I# i#) = C# (chr# (ord# '0'# +# i#))

33−

34−-- | The normal 'mappend' function with right associativity instead of

35−-- left.

36−(<>) :: Builder -> Builder -> Builder

37−(<>) = mappend

38−{-# INLINE (<>) #-}

39−

40−infixr 4 <>

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/Encoding/Fusion/Common.hsdeleted−123

@@ -1,123 +0,0 @@

1−{-# LANGUAGE BangPatterns #-}

2−

3−-- |

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

5−-- Copyright : (c) Tom Harper 2008-2009,

6−-- (c) Bryan O'Sullivan 2009,

7−-- (c) Duncan Coutts 2009,

8−-- (c) Jasper Van der Jeugt 2011

9−--

10−-- License : BSD-style

11−-- Maintainer : bos@serpentine.com

12−-- Stability : experimental

13−-- Portability : portable

14−--

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

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

17−--

18−-- Fusible 'Stream'-oriented functions for converting between 'Text'

19−-- and several common encodings.

20−

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

22− (

23− -- * Restreaming

24− -- Restreaming is the act of converting from one 'Stream'

25− -- representation to another.

26− restreamUtf16LE

27− , restreamUtf16BE

28− , restreamUtf32LE

29− , restreamUtf32BE

30− ) where

31−

32−import 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)

37−import Data.Word (Word8)

38−

39−restreamUtf16BE :: Stream Char -> Stream Word8

40−restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

41− where

42− next (RS0 s) = case next0 s of

43− Done -> Done

44− Skip s' -> Skip (RS0 s')

45− Yield x s'

46− | n < 0x10000 -> Yield (fromIntegral $ n `shiftR` 8) $

47− RS1 s' (fromIntegral n)

48− | otherwise -> Yield c1 $ RS3 s' c2 c3 c4

49− where

50− n = ord x

51− n1 = n - 0x10000

52− c1 = fromIntegral (n1 `shiftR` 18 + 0xD8)

53− c2 = fromIntegral (n1 `shiftR` 10)

54− n2 = n1 .&. 0x3FF

55− c3 = fromIntegral (n2 `shiftR` 8 + 0xDC)

56− c4 = fromIntegral n2

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 restreamUtf16BE #-}

62−

63−restreamUtf16LE :: Stream Char -> Stream Word8

64−restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

65− where

66− next (RS0 s) = case next0 s of

67− Done -> Done

68− Skip s' -> Skip (RS0 s')

69− Yield x s'

70− | n < 0x10000 -> Yield (fromIntegral n) $

71− RS1 s' (fromIntegral $ shiftR n 8)

72− | otherwise -> Yield c1 $ RS3 s' c2 c3 c4

73− where

74− n = ord x

75− n1 = n - 0x10000

76− c2 = fromIntegral (shiftR n1 18 + 0xD8)

77− c1 = fromIntegral (shiftR n1 10)

78− n2 = n1 .&. 0x3FF

79− c4 = fromIntegral (shiftR n2 8 + 0xDC)

80− c3 = fromIntegral n2

81− next (RS1 s x2) = Yield x2 (RS0 s)

82− next (RS2 s x2 x3) = Yield x2 (RS1 s x3)

83− next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)

84− {-# INLINE next #-}

85−{-# INLINE restreamUtf16LE #-}

86−

87−restreamUtf32BE :: Stream Char -> Stream Word8

88−restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

89− where

90− next (RS0 s) = case next0 s of

91− Done -> Done

92− Skip s' -> Skip (RS0 s')

93− Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)

94− where

95− n = ord x

96− c1 = fromIntegral $ shiftR n 24

97− c2 = fromIntegral $ shiftR n 16

98− c3 = fromIntegral $ shiftR n 8

99− c4 = fromIntegral n

100− next (RS1 s x2) = Yield x2 (RS0 s)

101− next (RS2 s x2 x3) = Yield x2 (RS1 s x3)

102− next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)

103− {-# INLINE next #-}

104−{-# INLINE restreamUtf32BE #-}

105−

106−restreamUtf32LE :: Stream Char -> Stream Word8

107−restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)

108− where

109− next (RS0 s) = case next0 s of

110− Done -> Done

111− Skip s' -> Skip (RS0 s')

112− Yield x s' -> Yield c1 (RS3 s' c2 c3 c4)

113− where

114− n = ord x

115− c4 = fromIntegral $ shiftR n 24

116− c3 = fromIntegral $ shiftR n 16

117− c2 = fromIntegral $ shiftR n 8

118− c1 = fromIntegral n

119− next (RS1 s x2) = Yield x2 (RS0 s)

120− next (RS2 s x2 x3) = Yield x2 (RS1 s x3)

121− next (RS3 s x2 x3 x4) = Yield x2 (RS2 s x3 x4)

122− {-# INLINE next #-}

123−{-# INLINE restreamUtf32LE #-}

Data/Text/Internal/Encoding/Utf32.hsdeleted−26

@@ -1,26 +0,0 @@

1−-- |

2−-- Module : Data.Text.Internal.Encoding.Utf32

6−--

7−-- License : BSD-style

8−-- Maintainer : bos@serpentine.com

9−-- Stability : experimental

10−-- Portability : portable

11−--

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−-- Basic UTF-32 validation.

17−module Data.Text.Internal.Encoding.Utf32

18− (

19− validate

20− ) where

21−

22−import Data.Word (Word32)

23−

24−validate :: Word32 -> Bool

25−validate x1 = x1 < 0xD800 || (x1 > 0xDFFF && x1 <= 0x10FFFF)

26−{-# INLINE validate #-}

Data/Text/Internal/Functions.hsdeleted−31

@@ -1,31 +0,0 @@

1−{-# LANGUAGE CPP, DeriveDataTypeable #-}

2−

3−-- |

4−-- Module : Data.Text.Internal.Functions

5−-- Copyright : 2010 Bryan O'Sullivan

6−--

7−-- License : BSD-style

8−-- Maintainer : bos@serpentine.com

9−-- Stability : experimental

10−-- Portability : GHC

11−--

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−-- Useful functions.

17−

18−module Data.Text.Internal.Functions

19− (

20− intersperse

21− ) where

22−

23−-- | A lazier version of Data.List.intersperse. The other version

24−-- causes space leaks!

25−intersperse :: a -> [a] -> [a]

26−intersperse _ [] = []

27−intersperse sep (x:xs) = x : go xs

28− where

29− go [] = []

30− go (y:ys) = sep : y: go ys

31−{-# INLINE intersperse #-}

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/Lazy/Encoding/Fusion.hsdeleted−324

@@ -1,324 +0,0 @@

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

2−

3−-- |

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

6−--

7−-- License : BSD-style

8−-- Maintainer : bos@serpentine.com

9−-- Stability : experimental

10−-- Portability : portable

11−--

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−-- Fusible 'Stream'-oriented functions for converting between lazy

17−-- 'Text' and several common encodings.

18−

19−module Data.Text.Internal.Lazy.Encoding.Fusion

20− (

21− -- * Streaming

22− -- streamASCII

23− streamUtf8

24− , streamUtf16LE

25− , streamUtf16BE

26− , streamUtf32LE

27− , streamUtf32BE

28−

29− -- * Unstreaming

30− , unstream

31−

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

33− ) where

34−

35−import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)

36−import qualified Data.ByteString as B

37−import qualified Data.ByteString.Unsafe as B

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

39−import 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)

44−import 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)

49−import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

50−import Foreign.Storable (pokeByteOff)

51−import Data.ByteString.Internal (mallocByteString, memcpy)

52−#if defined(ASSERTS)

53−import Control.Exception (assert)

54−#endif

55−import qualified Data.ByteString.Internal as B

56−

57−data S = S0

58− | S1 {-# UNPACK #-} !Word8

59− | S2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

60− | S3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

61− | S4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

62−

63−data T = T !ByteString !S {-# UNPACK #-} !Int

64−

65−-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using

66−-- UTF-8 encoding.

67−streamUtf8 :: OnDecodeError -> ByteString -> Stream Char

68−streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize

69− where

70− next (T bs@(Chunk ps _) S0 i)

71− | i < len && U8.validate1 a =

72− Yield (unsafeChr8 a) (T bs S0 (i+1))

73− | i + 1 < len && U8.validate2 a b =

74− Yield (U8.chr2 a b) (T bs S0 (i+2))

75− | i + 2 < len && U8.validate3 a b c =

76− Yield (U8.chr3 a b c) (T bs S0 (i+3))

77− | i + 3 < len && U8.validate4 a b c d =

78− Yield (U8.chr4 a b c d) (T bs S0 (i+4))

79− where len = B.length ps

80− a = B.unsafeIndex ps i

81− b = B.unsafeIndex ps (i+1)

82− c = B.unsafeIndex ps (i+2)

83− d = B.unsafeIndex ps (i+3)

84− next st@(T bs s i) =

85− case s of

86− S1 a | U8.validate1 a -> Yield (unsafeChr8 a) es

87− S2 a b | U8.validate2 a b -> Yield (U8.chr2 a b) es

88− S3 a b c | U8.validate3 a b c -> Yield (U8.chr3 a b c) es

89− S4 a b c d | U8.validate4 a b c d -> Yield (U8.chr4 a b c d) es

90− _ -> consume st

91− where es = T bs S0 i

92− consume (T bs@(Chunk ps rest) s i)

93− | i >= B.length ps = consume (T rest s 0)

94− | otherwise =

95− case s of

96− S0 -> next (T bs (S1 x) (i+1))

97− S1 a -> next (T bs (S2 a x) (i+1))

98− S2 a b -> next (T bs (S3 a b x) (i+1))

99− S3 a b c -> next (T bs (S4 a b c x) (i+1))

100− S4 a b c d -> decodeError "streamUtf8" "UTF-8" onErr (Just a)

101− (T bs (S3 b c d) (i+1))

102− where x = B.unsafeIndex ps i

103− consume (T Empty S0 _) = Done

104− consume st = decodeError "streamUtf8" "UTF-8" onErr Nothing st

105−{-# INLINE [0] streamUtf8 #-}

106−

107−-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

108−-- endian UTF-16 encoding.

109−streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char

110−streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

111− where

112− next (T bs@(Chunk ps _) S0 i)

113− | i + 1 < len && U16.validate1 x1 =

114− Yield (unsafeChr x1) (T bs S0 (i+2))

115− | i + 3 < len && U16.validate2 x1 x2 =

116− Yield (U16.chr2 x1 x2) (T bs S0 (i+4))

117− where len = B.length ps

118− x1 = c (idx i) (idx (i + 1))

119− x2 = c (idx (i + 2)) (idx (i + 3))

120− c w1 w2 = w1 + (w2 `shiftL` 8)

121− idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16

122− next st@(T bs s i) =

123− case s of

124− S2 w1 w2 | U16.validate1 (c w1 w2) ->

125− Yield (unsafeChr (c w1 w2)) es

126− S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->

127− Yield (U16.chr2 (c w1 w2) (c w3 w4)) es

128− _ -> consume st

129− where es = T bs S0 i

130− c :: Word8 -> Word8 -> Word16

131− c w1 w2 = fromIntegral w1 + (fromIntegral w2 `shiftL` 8)

132− consume (T bs@(Chunk ps rest) s i)

133− | i >= B.length ps = consume (T rest s 0)

134− | otherwise =

135− case s of

136− S0 -> next (T bs (S1 x) (i+1))

137− S1 w1 -> next (T bs (S2 w1 x) (i+1))

138− S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))

139− S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))

140− S4 w1 w2 w3 w4 -> decodeError "streamUtf16LE" "UTF-16LE" onErr (Just w1)

141− (T bs (S3 w2 w3 w4) (i+1))

142− where x = B.unsafeIndex ps i

143− consume (T Empty S0 _) = Done

144− consume st = decodeError "streamUtf16LE" "UTF-16LE" onErr Nothing st

145−{-# INLINE [0] streamUtf16LE #-}

146−

147−-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

148−-- endian UTF-16 encoding.

149−streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char

150−streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

151− where

152− next (T bs@(Chunk ps _) S0 i)

153− | i + 1 < len && U16.validate1 x1 =

154− Yield (unsafeChr x1) (T bs S0 (i+2))

155− | i + 3 < len && U16.validate2 x1 x2 =

156− Yield (U16.chr2 x1 x2) (T bs S0 (i+4))

157− where len = B.length ps

158− x1 = c (idx i) (idx (i + 1))

159− x2 = c (idx (i + 2)) (idx (i + 3))

160− c w1 w2 = (w1 `shiftL` 8) + w2

161− idx = fromIntegral . B.unsafeIndex ps :: Int -> Word16

162− next st@(T bs s i) =

163− case s of

164− S2 w1 w2 | U16.validate1 (c w1 w2) ->

165− Yield (unsafeChr (c w1 w2)) es

166− S4 w1 w2 w3 w4 | U16.validate2 (c w1 w2) (c w3 w4) ->

167− Yield (U16.chr2 (c w1 w2) (c w3 w4)) es

168− _ -> consume st

169− where es = T bs S0 i

170− c :: Word8 -> Word8 -> Word16

171− c w1 w2 = (fromIntegral w1 `shiftL` 8) + fromIntegral w2

172− consume (T bs@(Chunk ps rest) s i)

173− | i >= B.length ps = consume (T rest s 0)

174− | otherwise =

175− case s of

176− S0 -> next (T bs (S1 x) (i+1))

177− S1 w1 -> next (T bs (S2 w1 x) (i+1))

178− S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))

179− S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))

180− S4 w1 w2 w3 w4 -> decodeError "streamUtf16BE" "UTF-16BE" onErr (Just w1)

181− (T bs (S3 w2 w3 w4) (i+1))

182− where x = B.unsafeIndex ps i

183− consume (T Empty S0 _) = Done

184− consume st = decodeError "streamUtf16BE" "UTF-16BE" onErr Nothing st

185−{-# INLINE [0] streamUtf16BE #-}

186−

187−-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big

188−-- endian UTF-32 encoding.

189−streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char

190−streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

191− where

192− next (T bs@(Chunk ps _) S0 i)

193− | i + 3 < len && U32.validate x =

194− Yield (unsafeChr32 x) (T bs S0 (i+4))

195− where len = B.length ps

196− x = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4

197− x1 = idx i

198− x2 = idx (i+1)

199− x3 = idx (i+2)

200− x4 = idx (i+3)

201− idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32

202− next st@(T bs s i) =

203− case s of

204− S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->

205− Yield (unsafeChr32 (c w1 w2 w3 w4)) es

206− _ -> consume st

207− where es = T bs S0 i

208− c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32

209− c w1 w2 w3 w4 = shifted

210− where

211− shifted = shiftL x1 24 + shiftL x2 16 + shiftL x3 8 + x4

212− x1 = fromIntegral w1

213− x2 = fromIntegral w2

214− x3 = fromIntegral w3

215− x4 = fromIntegral w4

216− consume (T bs@(Chunk ps rest) s i)

217− | i >= B.length ps = consume (T rest s 0)

218− | otherwise =

219− case s of

220− S0 -> next (T bs (S1 x) (i+1))

221− S1 w1 -> next (T bs (S2 w1 x) (i+1))

222− S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))

223− S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))

224− S4 w1 w2 w3 w4 -> decodeError "streamUtf32BE" "UTF-32BE" onErr (Just w1)

225− (T bs (S3 w2 w3 w4) (i+1))

226− where x = B.unsafeIndex ps i

227− consume (T Empty S0 _) = Done

228− consume st = decodeError "streamUtf32BE" "UTF-32BE" onErr Nothing st

229−{-# INLINE [0] streamUtf32BE #-}

230−

231−-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little

232−-- endian UTF-32 encoding.

233−streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char

234−streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize

235− where

236− next (T bs@(Chunk ps _) S0 i)

237− | i + 3 < len && U32.validate x =

238− Yield (unsafeChr32 x) (T bs S0 (i+4))

239− where len = B.length ps

240− x = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1

241− x1 = idx i

242− x2 = idx (i+1)

243− x3 = idx (i+2)

244− x4 = idx (i+3)

245− idx = fromIntegral . B.unsafeIndex ps :: Int -> Word32

246− next st@(T bs s i) =

247− case s of

248− S4 w1 w2 w3 w4 | U32.validate (c w1 w2 w3 w4) ->

249− Yield (unsafeChr32 (c w1 w2 w3 w4)) es

250− _ -> consume st

251− where es = T bs S0 i

252− c :: Word8 -> Word8 -> Word8 -> Word8 -> Word32

253− c w1 w2 w3 w4 = shifted

254− where

255− shifted = shiftL x4 24 + shiftL x3 16 + shiftL x2 8 + x1

256− x1 = fromIntegral w1

257− x2 = fromIntegral w2

258− x3 = fromIntegral w3

259− x4 = fromIntegral w4

260− consume (T bs@(Chunk ps rest) s i)

261− | i >= B.length ps = consume (T rest s 0)

262− | otherwise =

263− case s of

264− S0 -> next (T bs (S1 x) (i+1))

265− S1 w1 -> next (T bs (S2 w1 x) (i+1))

266− S2 w1 w2 -> next (T bs (S3 w1 w2 x) (i+1))

267− S3 w1 w2 w3 -> next (T bs (S4 w1 w2 w3 x) (i+1))

268− S4 w1 w2 w3 w4 -> decodeError "streamUtf32LE" "UTF-32LE" onErr (Just w1)

269− (T bs (S3 w2 w3 w4) (i+1))

270− where x = B.unsafeIndex ps i

271− consume (T Empty S0 _) = Done

272− consume st = decodeError "streamUtf32LE" "UTF-32LE" onErr Nothing st

273−{-# INLINE [0] streamUtf32LE #-}

274−

275−-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.

276−unstreamChunks :: Int -> Stream Word8 -> ByteString

277−unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)

278− where chunk s1 len1 = unsafeDupablePerformIO $ do

279− let len = max 4 (min len1 chunkSize)

280− mallocByteString len >>= loop len 0 s1

281− where

282− loop !n !off !s fp = case next s of

283− Done | off == 0 -> return Empty

284− | otherwise -> return $! Chunk (trimUp fp off) Empty

285− Skip s' -> loop n off s' fp

286− Yield x s'

287− | off == chunkSize -> do

288− let !newLen = n - off

289− return $! Chunk (trimUp fp off) (chunk s newLen)

290− | off == n -> realloc fp n off s' x

291− | otherwise -> do

292− withForeignPtr fp $ \p -> pokeByteOff p off x

293− loop n (off+1) s' fp

294− {-# NOINLINE realloc #-}

295− realloc fp n off s x = do

296− let n' = min (n+n) chunkSize

297− fp' <- copy0 fp n n'

298− withForeignPtr fp' $ \p -> pokeByteOff p off x

299− loop n' (off+1) s fp'

300− trimUp fp off = B.PS fp 0 off

301− copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)

302− copy0 !src !srcLen !destLen =

303−#if defined(ASSERTS)

304− assert (srcLen <= destLen) $

305−#endif

306− do

307− dest <- mallocByteString destLen

308− withForeignPtr src $ \src' ->

309− withForeignPtr dest $ \dest' ->

310− memcpy dest' src' (fromIntegral srcLen)

311− return dest

312−

313−-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.

314−unstream :: Stream Word8 -> ByteString

315−unstream = unstreamChunks defaultChunkSize

316−

317−decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8

318− -> s -> Step s Char

319−decodeError func kind onErr mb i =

320− case onErr desc mb of

321− Nothing -> Skip i

322− Just c -> Yield c i

323− where desc = "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Invalid " ++

324− kind ++ " stream"

Data/Text/Internal/Lazy/Fusion.hsdeleted−120

@@ -1,120 +0,0 @@

1−{-# LANGUAGE BangPatterns #-}

2−-- |

3−-- Module : Data.Text.Lazy.Fusion

5−--

6−-- License : BSD-style

7−-- Maintainer : bos@serpentine.com

8−-- Stability : experimental

9−-- Portability : GHC

10−--

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

15−-- Core stream fusion functionality for text.

16−

17−module Data.Text.Internal.Lazy.Fusion

18− (

19− stream

20− , unstream

21− , unstreamChunks

22− , length

23− , unfoldrN

24− , index

25− , countChar

26− ) where

27−

28−import 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

34−import qualified Data.Text.Internal as I

35−import qualified Data.Text.Array as A

36−import Data.Text.Internal.Unsafe.Char (unsafeWrite)

37−import Data.Text.Internal.Unsafe.Shift (shiftL)

38−import Data.Text.Unsafe (Iter(..), iter)

39−import Data.Int (Int64)

40−

41−default(Int64)

42−

43−-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.

44−stream :: Text -> Stream Char

45−stream text = Stream next (text :*: 0) unknownSize

46− where

47− next (Empty :*: _) = Done

48− next (txt@(Chunk t@(I.Text _ _ len) ts) :*: i)

49− | i >= len = next (ts :*: 0)

50− | otherwise = Yield c (txt :*: i+d)

51− where Iter c d = iter t i

52−{-# INLINE [0] stream #-}

53−

54−-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given

55−-- chunk size.

56−unstreamChunks :: Int -> Stream Char -> Text

57−unstreamChunks !chunkSize (Stream next s0 len0)

58− | isEmpty len0 = Empty

59− | otherwise = outer s0

60− where

61− outer so = {-# SCC "unstreamChunks/outer" #-}

62− case next so of

63− Done -> Empty

64− 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')

87−{-# INLINE [0] unstreamChunks #-}

88−

89−-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using

90−-- 'defaultChunkSize'.

91−unstream :: Stream Char -> Text

92−unstream = unstreamChunks defaultChunkSize

93−{-# INLINE [0] unstream #-}

94−

95−-- | /O(n)/ Returns the number of characters in a text.

96−length :: Stream Char -> Int64

97−length = S.lengthI

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

99−

100−{-# RULES "LAZY STREAM stream/unstream fusion" forall s.

101− stream (unstream s) = s #-}

102−

103−-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed

104−-- value. However, the length of the result is limited by the

105−-- first argument to 'unfoldrN'. This function is more efficient than

106−-- 'unfoldr' when the length of the result is known.

107−unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char

108−unfoldrN n = S.unfoldrNI n

109−{-# INLINE [0] unfoldrN #-}

110−

111−-- | /O(n)/ stream index (subscript) operator, starting from 0.

112−index :: Stream Char -> Int64 -> Char

113−index = S.indexI

114−{-# INLINE [0] index #-}

115−

116−-- | /O(n)/ The 'count' function returns the number of times the query

117−-- element appears in the given stream.

118−countChar :: Char -> Stream Char -> Int64

119−countChar = S.countCharI

120−{-# INLINE [0] countChar #-}

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/Internal/Unsafe.hsdeleted−56

@@ -1,56 +0,0 @@

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

2−{-# OPTIONS_HADDOCK not-home #-}

3−

4−-- |

5−-- Module : Data.Text.Internal.Unsafe

7−-- License : BSD-style

8−-- Maintainer : bos@serpentine.com

9−-- Stability : experimental

10−-- Portability : portable

11−--

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

19− (

20− inlineInterleaveST

21− , inlinePerformIO

22− ) where

23−

24−import GHC.ST (ST(..))

25−#if defined(__GLASGOW_HASKELL__)

26−import GHC.IO (IO(IO))

27−import GHC.Base (realWorld#)

28−#endif

29−

30−

31−-- | Just like unsafePerformIO, but we inline it. Big performance gains as

32−-- it exposes lots of things to further inlining. /Very unsafe/. In

33−-- particular, you should do no memory allocation inside an

34−-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.

35−--

36−{-# INLINE inlinePerformIO #-}

37−inlinePerformIO :: IO a -> a

38−#if defined(__GLASGOW_HASKELL__)

39−inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r

40−#else

41−inlinePerformIO = unsafePerformIO

42−#endif

43−

44−-- | Allow an 'ST' computation to be deferred lazily. When passed an

45−-- action of type 'ST' @s@ @a@, the action will only be performed when

46−-- the value of @a@ is demanded.

47−--

48−-- This function is identical to the normal unsafeInterleaveST, but is

49−-- inlined and hence faster.

50−--

51−-- /Note/: This operation is highly unsafe, as it can introduce

52−-- externally visible non-determinism into an 'ST' action.

53−inlineInterleaveST :: ST s a -> ST s a

54−inlineInterleaveST (ST m) = ST $ \ s ->

55− let r = case m s of (# _, res #) -> res in (# s, r #)

56−{-# INLINE inlineInterleaveST #-}

Data/Text/Lazy.hs+240−649

@@ -1,56 +1,37 @@

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

5+-- Copyright : (c) Bryan O'Sullivan 2009

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

1913-- A time and space-efficient implementation of Unicode text using

20−-- lists of packed arrays.

21−--

22−-- /Note/: Read below the synopsis for important notes on the use of

23−-- this module.

24−--

25−-- The representation used by this module is suitable for high

14+-- lists of packed arrays. This representation is suitable for high

2615-- performance use and for streaming large quantities of data. It

2716-- provides a means to manipulate a large body of text without

2817-- requiring that the entire content be resident in memory.

2918--

3019-- Some operations, such as 'concat', 'append', 'reverse' and 'cons',

31−-- have better time complexity than their "Data.Text" equivalents, due

32−-- to the underlying representation being a list of chunks. For other

33−-- operations, lazy 'Text's are usually within a few percent of strict

34−-- ones, but often with better heap usage if used in a streaming

35−-- fashion. For data larger than available memory, or if you have

36−-- tight memory constraints, this module will be the only option.

20+-- have better complexity than their "Data.Text" equivalents, due to

21+-- optimisations resulting from the list spine structure. And for

22+-- other operations lazy 'Text's are usually within a few percent of

23+-- strict ones, but with better heap usage. For data larger than

24+-- available memory, or if you have tight memory constraints, this

25+-- module will be the only option.

3726--

3827-- This module is intended to be imported @qualified@, to avoid name

3928-- clashes with "Prelude" functions. eg.

4029--

41−-- > import qualified Data.Text.Lazy as L

30+-- > import qualified Data.Text.Lazy as B

4231

4332module Data.Text.Lazy

4433 (

45− -- * Fusion

46− -- $fusion

47−

48− -- * Acceptable data

49− -- $replacement

50−

51− -- * Types

5234 Text

53−

5435 -- * Creation and elimination

5536 , pack

5637 , unpack

@@ -58,10 +39,6 @@ module Data.Text.Lazy

5839 , empty

5940 , fromChunks

6041 , toChunks

61− , toStrict

62− , fromStrict

63− , foldrChunks

64− , foldlChunks

6542

6643 -- * Basic interface

6744 , cons

@@ -74,7 +51,6 @@ module Data.Text.Lazy

7451 , init

7552 , null

7653 , length

77− , compareLength

7854

7955 -- * Transformations

8056 , map

@@ -89,7 +65,6 @@ module Data.Text.Lazy

8965 , toCaseFold

9066 , toLower

9167 , toUpper

92− , toTitle

9368

9469 -- ** Justification

9570 , justifyLeft

@@ -125,10 +100,7 @@ module Data.Text.Lazy

125100 , mapAccumR

126101

127102 -- ** Generation and unfolding

128− , repeat

129103 , replicate

130− , cycle

131− , iterate

132104 , unfoldr

133105 , unfoldrN

134106

@@ -136,11 +108,8 @@ module Data.Text.Lazy

136108

137109 -- ** Breaking strings

138110 , take

139− , takeEnd

140111 , drop

141− , dropEnd

142112 , takeWhile

143− , takeWhileEnd

144113 , dropWhile

145114 , dropWhileEnd

146115 , dropAround

@@ -148,10 +117,10 @@ module Data.Text.Lazy

148117 , stripStart

149118 , stripEnd

150119 , splitAt

151− , span

152− , breakOn

153− , breakOnEnd

120+ , spanBy

154121 , break

122+ , breakEnd

123+ , breakBy

155124 , group

156125 , groupBy

157126 , inits

@@ -159,8 +128,8 @@ module Data.Text.Lazy

159128

160129 -- ** Breaking into many substrings

161130 -- $split

162− , splitOn

163131 , split

132+ , splitBy

164133 , chunksOf

165134 -- , breakSubstring

166135

@@ -176,18 +145,17 @@ module Data.Text.Lazy

176145 , isInfixOf

177146

178147 -- ** View patterns

179− , stripPrefix

180− , stripSuffix

181− , commonPrefixes

148+ , prefixed

149+ , suffixed

182150

183151 -- * Searching

184152 , filter

185153 , find

186− , breakOnAll

187− , partition

154+ , findBy

155+ , partitionBy

188156

189157 -- , findSubstring

190−

158+

191159 -- * Indexing

192160 , index

193161 , count

@@ -201,9 +169,9 @@ module Data.Text.Lazy

201169 ) where

202170

203171import Prelude (Char, Bool(..), Maybe(..), String,

204− Eq(..), Ord(..), Ordering(..), Read(..), Show(..),

205− (&&), (||), (+), (-), (.), ($), (++),

206− error, flip, fmap, fromIntegral, not, otherwise, quot)

172+ Eq(..), Ord(..), Read(..), Show(..),

173+ (&&), (+), (-), (.), ($), (++),

174+ div, error, flip, fromIntegral, not, otherwise)

207175import qualified Prelude as P

208176#if defined(HAVE_DEEPSEQ)

209177import Control.DeepSeq (NFData(..))

@@ -211,129 +179,32 @@ import Control.DeepSeq (NFData(..))

211179import Data.Int (Int64)

212180import qualified Data.List as L

213181import 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(..))

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

183+#if __GLASGOW_HASKELL__ >= 612

184+import Data.Data (mkNoRepType)

185+#else

186+import Data.Data (mkNorepType)

220187#endif

188+import Data.Monoid (Monoid(..))

221189import Data.String (IsString(..))

222190import qualified Data.Text as T

223191import qualified Data.Text.Internal as T

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

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

225193import 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

247−

248−-- $fusion

249−--

250−-- Most of the functions in this module are subject to /fusion/,

251−-- meaning that a pipeline of such functions will usually allocate at

252−-- most one 'Text' value.

253−--

254−-- As an example, consider the following pipeline:

255−--

256−-- > import Data.Text.Lazy as T

257−-- > import Data.Text.Lazy.Encoding as E

258−-- > import Data.ByteString.Lazy (ByteString)

259−-- >

260−-- > countChars :: ByteString -> Int

261−-- > countChars = T.length . T.toUpper . E.decodeUtf8

262−--

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

264−-- allocate one 'ByteString' value, and two 'Text' values. However,

265−-- when a module is compiled with optimisation enabled under GHC, the

266−-- two intermediate 'Text' values will be optimised away, and the

267−-- function will be compiled down to a single loop over the source

268−-- 'ByteString'.

269−--

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

271−-- phrase \"Subject to fusion\".

272−

273−-- $replacement

274−--

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

276−-- in §3.9, definition D76 of the Unicode 5.2 standard:

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

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

279−-- inclusive. Haskell implementations admit all Unicode code points

280−-- (§3.4, definition D10) as 'Char' values, including code points

281−-- from this invalid range. This means that there are some 'Char'

282−-- values that are not valid Unicode scalar values, and the functions

283−-- in this module must handle those cases.

284−--

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

286−-- more 'Char' values. Those functions will substitute 'Char' values

287−-- that are not valid Unicode scalar values with the replacement

288−-- character \"�\" (U+FFFD). Functions that perform this

289−-- inspection and replacement are documented with the phrase

290−-- \"Performs replacement on invalid scalar values\".

291−--

292−-- (One reason for this policy of replacement is that internally, a

293−-- 'Text' value is represented as packed UTF-16 data. Values in the

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

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

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

297−-- measure. For details, see Unicode Technical Report 36, §3.5:

298−-- <http://unicode.org/reports/tr36#Deletion_of_Noncharacters>)

299−

300−equal :: Text -> Text -> Bool

301−equal Empty Empty = True

302−equal Empty _ = False

303−equal _ Empty = False

304−equal (Chunk a as) (Chunk b bs) =

305− case compare lenA lenB of

306− LT -> a == (T.takeWord16 lenA b) &&

307− as `equal` Chunk (T.dropWord16 lenA b) bs

308− EQ -> a == b && as `equal` bs

309− GT -> T.takeWord16 lenB a == b &&

310− Chunk (T.dropWord16 lenB a) as `equal` bs

311− where lenA = T.lengthWord16 a

312− lenB = T.lengthWord16 b

194+import qualified Data.Text.Lazy.Fusion as S

195+import Data.Text.Fusion.Internal (PairS(..))

196+import Data.Text.Lazy.Fusion (stream, unstream)

197+import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldlChunks, foldrChunks)

198+import Data.Text.Internal (textP)

199+import Data.Text.Lazy.Search (indices)

313200

314201instance Eq Text where

315− (==) = equal

202+ t1 == t2 = stream t1 == stream t2

316203 {-# INLINE (==) #-}

317204

318205instance Ord Text where

319− compare = compareText

320−

321−compareText :: Text -> Text -> Ordering

322−compareText Empty Empty = EQ

323−compareText Empty _ = LT

324−compareText _ Empty = GT

325−compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0

326− where

327− outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0

328− where

329− go !i !j

330− | i >= lenA = compareText as (chunk (T.Text arrB (offB+j) (lenB-j)) bs)

331− | j >= lenB = compareText (chunk (T.Text arrA (offA+i) (lenA-i)) as) bs

332− | a < b = LT

333− | a > b = GT

334− | otherwise = go (i+di) (j+dj)

335− where T.Iter a di = T.iter ta i

336− T.Iter b dj = T.iter tb j

206+ compare t1 t2 = compare (stream t1) (stream t2)

207+ {-# INLINE compare #-}

337208

338209instance Show Text where

339210 showsPrec p ps r = showsPrec p (unpack ps) r

@@ -341,108 +212,43 @@ instance Show Text where

341212instance Read Text where

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

343214

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−

352215instance Monoid Text where

353216 mempty = empty

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

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

356−#else

357217 mappend = append

358−#endif

359218 mconcat = concat

360219

361220instance IsString Text where

362221 fromString = pack

363222

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−

371223#if defined(HAVE_DEEPSEQ)

372224instance NFData Text where

373225 rnf Empty = ()

374226 rnf (Chunk _ ts) = rnf ts

375227#endif

376228

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'

390229instance Data Text where

391230 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

231+ toConstr _ = error "Data.Text.Lazy.Text.toConstr"

232+ gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"

233+#if __GLASGOW_HASKELL__ >= 612

234+ dataTypeOf _ = mkNoRepType "Data.Text.Lazy.Text"

235+#else

236+ dataTypeOf _ = mkNorepType "Data.Text.Lazy.Text"

402237#endif

403238

404−packConstr :: Constr

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

406−

407−textDataType :: DataType

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

409−

410239-- | /O(n)/ Convert a 'String' into a 'Text'.

411240--

412−-- Subject to fusion. Performs replacement on invalid scalar values.

241+-- This function is subject to array fusion.

413242pack :: String -> Text

414−pack = unstream . S.streamList . L.map safe

243+pack s = unstream (S.streamList s)

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

416245

417246-- | /O(n)/ Convert a 'Text' into a 'String'.

418−-- Subject to fusion.

247+-- Subject to array fusion.

419248unpack :: Text -> String

420249unpack t = S.unstreamList (stream t)

421250{-# INLINE [1] unpack #-}

422251

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−

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

445−-- Performs replacement on invalid scalar values.

446252singleton :: Char -> Text

447253singleton c = Chunk (T.singleton c) Empty

448254{-# INLINE [1] singleton #-}

@@ -462,28 +268,10 @@ fromChunks cs = L.foldr chunk Empty cs

462268toChunks :: Text -> [T.Text]

463269toChunks cs = foldrChunks (:) [] cs

464270

465−-- | /O(n)/ Convert a lazy 'Text' into a strict 'T.Text'.

466−toStrict :: Text -> T.Text

467−toStrict t = T.concat (toChunks t)

468−{-# INLINE [1] toStrict #-}

469−

470−-- | /O(c)/ Convert a strict 'T.Text' into a lazy 'Text'.

471−fromStrict :: T.Text -> Text

472−fromStrict t = chunk t Empty

473−{-# INLINE [1] fromStrict #-}

474−

475−-- -----------------------------------------------------------------------------

476−-- * Basic functions

477−

478−-- | /O(n)/ Adds a character to the front of a 'Text'. This function

479−-- is more costly than its 'List' counterpart because it requires

480−-- copying a new array. Subject to fusion.

481271cons :: Char -> Text -> Text

482272cons c t = Chunk (T.singleton c) t

483273{-# INLINE [1] cons #-}

484274

485−infixr 5 `cons`

486−

487275{-# RULES

488276"LAZY TEXT cons -> fused" [~1] forall c t.

489277 cons c t = unstream (S.cons c (stream t))

@@ -491,8 +279,6 @@ infixr 5 `cons`

491279 unstream (S.cons c (stream t)) = cons c t

492280 #-}

493281

494−-- | /O(n)/ Adds a character to the end of a 'Text'. This copies the

495−-- entire array in the process, unless fused. Subject to fusion.

496282snoc :: Text -> Char -> Text

497283snoc t c = foldrChunks Chunk (singleton c) t

498284{-# INLINE [1] snoc #-}

@@ -504,7 +290,8 @@ snoc t c = foldrChunks Chunk (singleton c) t

504290 unstream (S.snoc (stream t) c) = snoc t c

505291 #-}

506292

507−-- | /O(n\/c)/ Appends one 'Text' to another. Subject to fusion.

293+-- | /O(n\/c)/ Appends one 'Text' to another. Subject to array

294+-- fusion.

508295append :: Text -> Text -> Text

509296append xs ys = foldrChunks Chunk ys xs

510297{-# INLINE [1] append #-}

@@ -517,22 +304,22 @@ append xs ys = foldrChunks Chunk ys xs

517304 #-}

518305

519306-- | /O(1)/ Returns the first character and rest of a 'Text', or

520−-- 'Nothing' if empty. Subject to fusion.

307+-- 'Nothing' if empty. Subject to array fusion.

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

522−uncons Empty = Nothing

523−uncons (Chunk t ts) = Just (T.unsafeHead t, ts')

524− where ts' | T.compareLength t 1 == EQ = ts

525− | otherwise = Chunk (T.unsafeTail t) ts

309+uncons Empty = Nothing

310+uncons (Chunk t ts) =

311+ Just (T.unsafeHead t,

312+ if T.length t == 1 then ts else Chunk (T.unsafeTail t) ts)

526313{-# INLINE uncons #-}

527314

528315-- | /O(1)/ Returns the first character of a 'Text', which must be

529−-- non-empty. Subject to fusion.

316+-- non-empty. Subject to array fusion.

530317head :: Text -> Char

531318head t = S.head (stream t)

532319{-# INLINE head #-}

533320

534321-- | /O(1)/ Returns all characters after the head of a 'Text', which

535−-- must be non-empty. Subject to fusion.

322+-- must be non-empty. Subject to array fusion.

536323tail :: Text -> Text

537324tail (Chunk t ts) = chunk (T.tail t) ts

538325tail Empty = emptyError "tail"

@@ -545,8 +332,8 @@ tail Empty = emptyError "tail"

545332 unstream (S.tail (stream t)) = tail t

546333 #-}

547334

548−-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must

549−-- be non-empty. Subject to fusion.

335+-- | /O(1)/ Returns all but the last character of a 'Text', which must

336+-- be non-empty. Subject to array fusion.

550337init :: Text -> Text

551338init (Chunk t0 ts0) = go t0 ts0

552339 where go t (Chunk t' ts) = Chunk t (go t' ts)

@@ -561,7 +348,7 @@ init Empty = emptyError "init"

561348 unstream (S.init (stream t)) = init t

562349 #-}

563350

564−-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to

351+-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to array

565352-- fusion.

566353null :: Text -> Bool

567354null Empty = True

@@ -581,8 +368,8 @@ isSingleton :: Text -> Bool

581368isSingleton = S.isSingleton . stream

582369{-# INLINE isSingleton #-}

583370

584−-- | /O(n\/c)/ Returns the last character of a 'Text', which must be

585−-- non-empty. Subject to fusion.

371+-- | /O(1)/ Returns the last character of a 'Text', which must be

372+-- non-empty. Subject to array fusion.

586373last :: Text -> Char

587374last Empty = emptyError "last"

588375last (Chunk t ts) = go t ts

@@ -597,8 +384,6 @@ last (Chunk t ts) = go t ts

597384 S.last (stream t) = last t

598385 #-}

599386

600−-- | /O(n)/ Returns the number of characters in a 'Text'.

601−-- Subject to fusion.

602387length :: Text -> Int64

603388length = foldlChunks go 0

604389 where go l t = l + fromIntegral (T.length t)

@@ -611,46 +396,27 @@ length = foldlChunks go 0

611396 S.length (stream t) = length t

612397 #-}

613398

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

615−-- Subject to fusion.

616−--

617−-- This function gives the same answer as comparing against the result

618−-- of 'length', but can short circuit if the count of characters is

619−-- greater than the number, and hence be more efficient.

620−compareLength :: Text -> Int64 -> Ordering

621−compareLength t n = S.compareLengthI (stream t) n

622−{-# INLINE [1] compareLength #-}

623−

624−-- We don't apply those otherwise appealing length-to-compareLength

625−-- rewrite rules here, because they can change the strictness

626−-- properties of code.

627−

628399-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to

629−-- each element of @t@. Subject to fusion. Performs replacement on

630−-- invalid scalar values.

400+-- each element of @t@. Subject to array fusion.

631401map :: (Char -> Char) -> Text -> Text

632−map f t = unstream (S.map (safe . f) (stream t))

402+map f t = unstream (S.map f (stream t))

633403{-# INLINE [1] map #-}

634404

635405-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of

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

637407-- argument between each element of the list.

638408intercalate :: Text -> [Text] -> Text

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

409+intercalate t = concat . (L.intersperse t)

640410{-# INLINE intercalate #-}

641411

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

643−-- between the characters of a 'Text'. Subject to fusion. Performs

644−-- replacement on invalid scalar values.

645−intersperse :: Char -> Text -> Text

646−intersperse c t = unstream (S.intersperse (safe c) (stream t))

413+-- between the characters of a 'Text'. Subject to array fusion.

414+intersperse :: Char -> Text -> Text

415+intersperse c t = unstream (S.intersperse c (stream t))

647416{-# INLINE intersperse #-}

648417

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

650−-- specified fill character on the right. Subject to fusion. Performs

651−-- replacement on invalid scalar values.

652−--

653−-- Examples:

419+-- specified fill character on the right. Subject to fusion. Examples:

654420--

655421-- > justifyLeft 7 'x' "foo" == "fooxxxx"

656422-- > justifyLeft 3 'x' "foobar" == "foobar"

@@ -669,10 +435,7 @@ justifyLeft k c t

669435 #-}

670436

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

672−-- specified fill character on the left. Performs replacement on

673−-- invalid scalar values.

674−--

675−-- Examples:

438+-- specified fill character on the left. Examples:

676439--

677440-- > justifyRight 7 'x' "bar" == "xxxxbar"

678441-- > justifyRight 3 'x' "foobar" == "foobar"

@@ -683,11 +446,8 @@ justifyRight k c t

683446 where len = length t

684447{-# INLINE justifyRight #-}

685448

686−-- | /O(n)/ Center a string to the given length, using the specified

687−-- fill character on either side. Performs replacement on invalid

688−-- scalar values.

689−--

690−-- Examples:

449+-- | /O(n)/ Center a string to the given length, using the

450+-- specified fill character on either side. Examples:

691451--

692452-- > center 8 'x' "HS" = "xxxHSxxx"

693453center :: Int64 -> Char -> Text -> Text

@@ -696,7 +456,7 @@ center k c t

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

697457 where len = length t

698458 d = k - len

699− r = d `quot` 2

459+ r = d `div` 2

700460 l = d - r

701461{-# INLINE center #-}

702462

@@ -715,38 +475,12 @@ reverse = rev Empty

715475 where rev a Empty = a

716476 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts

717477

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"

738−--

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

740−-- 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.

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

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

480+ -> Text -- ^ Replacement text

481+ -> Text -- ^ Input text

746482 -> Text

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

748− -> Text

749−replace s d = intercalate d . splitOn s

483+replace s d = intercalate d . split s

750484{-# INLINE replace #-}

751485

752486-- ----------------------------------------------------------------------------

@@ -761,10 +495,9 @@ replace s d = intercalate d . splitOn s

761495-- functions may map one input character to two or three output

762496-- characters.

763497

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.

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

499+-- useful for performing caseless (or case insensitive) string

500+-- comparisons.

768501--

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

770503--

@@ -781,70 +514,45 @@ toCaseFold t = unstream (S.toCaseFold (stream t))

781514{-# INLINE [0] toCaseFold #-}

782515

783516-- | /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).

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

518+-- For instance, the Latin capital letter I with dot above (U+0130)

519+-- maps to the sequence Latin small letter i (U+0069) followed by

520+-- combining dot above (U+0307).

790521toLower :: Text -> Text

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

792523{-# INLINE toLower #-}

793524

794525-- | /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

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

527+-- For instance, the German eszett (U+00DF) maps to the two-letter

799528-- sequence SS.

800529toUpper :: Text -> Text

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

802531{-# INLINE toUpper #-}

803532

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−

827533-- | /O(n)/ 'foldl', applied to a binary operator, a starting value

828534-- (typically the left-identity of the operator), and a 'Text',

829535-- reduces the 'Text' using the binary operator, from left to right.

830−-- Subject to fusion.

831−foldl :: (a -> Char -> a) -> a -> Text -> a

536+-- Subject to array fusion.

537+foldl :: (b -> Char -> b) -> b -> Text -> b

832538foldl f z t = S.foldl f z (stream t)

833539{-# INLINE foldl #-}

834540

835541-- | /O(n)/ A strict version of 'foldl'.

836−-- Subject to fusion.

837−foldl' :: (a -> Char -> a) -> a -> Text -> a

542+-- Subject to array fusion.

543+foldl' :: (b -> Char -> b) -> b -> Text -> b

838544foldl' f z t = S.foldl' f z (stream t)

839545{-# INLINE foldl' #-}

840546

841547-- | /O(n)/ A variant of 'foldl' that has no starting value argument,

842−-- and thus must be applied to a non-empty 'Text'. Subject to fusion.

548+-- and thus must be applied to a non-empty 'Text'. Subject to array

549+-- fusion.

843550foldl1 :: (Char -> Char -> Char) -> Text -> Char

844551foldl1 f t = S.foldl1 f (stream t)

845552{-# INLINE foldl1 #-}

846553

847−-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.

554+-- | /O(n)/ A strict version of 'foldl1'.

555+-- Subject to array fusion.

848556foldl1' :: (Char -> Char -> Char) -> Text -> Char

849557foldl1' f t = S.foldl1' f (stream t)

850558{-# INLINE foldl1' #-}

@@ -852,13 +560,13 @@ foldl1' f t = S.foldl1' f (stream t)

852560-- | /O(n)/ 'foldr', applied to a binary operator, a starting value

853561-- (typically the right-identity of the operator), and a 'Text',

854562-- reduces the 'Text' using the binary operator, from right to left.

855−-- Subject to fusion.

856−foldr :: (Char -> a -> a) -> a -> Text -> a

563+-- Subject to array fusion.

564+foldr :: (Char -> b -> b) -> b -> Text -> b

857565foldr f z t = S.foldr f z (stream t)

858566{-# INLINE foldr #-}

859567

860−-- | /O(n)/ A variant of 'foldr' that has no starting value argument,

861−-- and thus must be applied to a non-empty 'Text'. Subject to

568+-- | /O(n)/ A variant of 'foldr' that has no starting value argument, and

569+-- thust must be applied to a non-empty 'Text'. Subject to array

862570-- fusion.

863571foldr1 :: (Char -> Char -> Char) -> Text -> Char

864572foldr1 f t = S.foldr1 f (stream t)

@@ -881,32 +589,32 @@ concatMap f = concat . foldr ((:) . f) []

881589{-# INLINE concatMap #-}

882590

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

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

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

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

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

887595{-# INLINE any #-}

888596

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

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

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

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

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

893601{-# INLINE all #-}

894602

895603-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which

896−-- must be non-empty. Subject to fusion.

604+-- must be non-empty. Subject to array fusion.

897605maximum :: Text -> Char

898606maximum t = S.maximum (stream t)

899607{-# INLINE maximum #-}

900608

901609-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which

902−-- must be non-empty. Subject to fusion.

610+-- must be non-empty. Subject to array fusion.

903611minimum :: Text -> Char

904612minimum t = S.minimum (stream t)

905613{-# INLINE minimum #-}

906614

907615-- | /O(n)/ 'scanl' is similar to 'foldl', but returns a list of

908−-- successive reduced values from the left. Subject to fusion.

909−-- Performs replacement on invalid scalar values.

616+-- successive reduced values from the left. This function is subject

617+-- to array fusion.

910618--

911619-- > scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]

912620--

@@ -914,13 +622,11 @@ minimum t = S.minimum (stream t)

914622--

915623-- > last (scanl f z xs) == foldl f z xs.

916624scanl :: (Char -> Char -> Char) -> Char -> Text -> Text

917−scanl f z t = unstream (S.scanl g z (stream t))

918− where g a b = safe (f a b)

625+scanl f z t = unstream (S.scanl f z (stream t))

919626{-# INLINE scanl #-}

920627

921628-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting

922−-- value argument. Subject to fusion. Performs replacement on

923−-- invalid scalar values.

629+-- value argument. This function is subject to array fusion.

924630--

925631-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]

926632scanl1 :: (Char -> Char -> Char) -> Text -> Text

@@ -929,83 +635,51 @@ scanl1 f t0 = case uncons t0 of

929635 Just (t,ts) -> scanl f t ts

930636{-# INLINE scanl1 #-}

931637

932−-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs

933−-- replacement on invalid scalar values.

638+-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'.

934639--

935640-- > scanr f v == reverse . scanl (flip f) v . reverse

936641scanr :: (Char -> Char -> Char) -> Char -> Text -> Text

937−scanr f v = reverse . scanl g v . reverse

938− where g a b = safe (f b a)

642+scanr f v = reverse . scanl (flip f) v . reverse

939643

940644-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting

941−-- value argument. Performs replacement on invalid scalar values.

645+-- value argument.

942646scanr1 :: (Char -> Char -> Char) -> Text -> Text

943647scanr1 f t | null t = empty

944648 | otherwise = scanr f (last t) (init t)

945649

946−-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a

650+-- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a

947651-- function to each element of a 'Text', passing an accumulating

948−-- parameter from left to right, and returns a final 'Text'. Performs

949−-- replacement on invalid scalar values.

652+-- parameter from left to right, and returns a final 'Text'.

950653mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)

951−mapAccumL f = go

952− where

953− go z (Chunk c cs) = (z'', Chunk c' cs')

954− where (z', c') = T.mapAccumL f z c

955− (z'', cs') = go z' cs

956− go z Empty = (z, Empty)

957−{-# INLINE mapAccumL #-}

654+mapAccumL f s t = case uncons t of

655+ Nothing -> (s, empty)

656+ Just (x, xs) -> (s'', cons y ys)

657+ where (s', y ) = f s x

658+ (s'',ys) = mapAccumL f s' xs

958659

959660-- | The 'mapAccumR' function behaves like a combination of 'map' and

960−-- a strict 'foldr'; it applies a function to each element of a

961−-- 'Text', passing an accumulating parameter from right to left, and

962−-- returning a final value of this accumulator together with the new

963−-- 'Text'. Performs replacement on invalid scalar values.

661+-- 'foldr'; it applies a function to each element of a 'Text', passing

662+-- an accumulating parameter from right to left, and returning a final

663+-- value of this accumulator together with the new 'Text'.

964664mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)

965−mapAccumR f = go

966− where

967− go z (Chunk c cs) = (z'', Chunk c' cs')

968− where (z'', c') = T.mapAccumR f z' c

969− (z', cs') = go z cs

970− go z Empty = (z, Empty)

971−{-# INLINE mapAccumR #-}

972−

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

665+mapAccumR f s t = case uncons t of

666+ Nothing -> (s, empty)

667+ Just (x, xs) -> (s'', cons y ys)

668+ where (s'',y ) = f s' x

669+ (s', ys) = mapAccumR f s xs

978670

979671-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input

980672-- @t@ repeated @n@ times.

981673replicate :: Int64 -> Text -> Text

982−replicate n t

983− | null t || n <= 0 = empty

984− | isSingleton t = replicateChar n (head t)

985− | otherwise = concat (rep 0)

986− where rep !i | i >= n = []

987− | 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

674+replicate n t = concat (rep 0)

675+ where rep i | i >= n = []

676+ | otherwise = t : rep (i+1)

677+{-# INLINE replicate #-}

1004678

1005679-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the

1006680-- value of every element. Subject to fusion.

1007681replicateChar :: Int64 -> Char -> Text

1008−replicateChar n c = unstream (S.replicateCharI n (safe c))

682+replicateChar n c = unstream (S.replicateCharI n c)

1009683{-# INLINE replicateChar #-}

1010684

1011685{-# RULES

@@ -1018,10 +692,9 @@ replicateChar n c = unstream (S.replicateCharI n (safe c))

1018692-- 'Text' from a seed value. The function takes the element and

1019693-- returns 'Nothing' if it is done producing the 'Text', otherwise

1020694-- 'Just' @(a,b)@. In this case, @a@ is the next 'Char' in the

1021−-- string, and @b@ is the seed value for further production. Performs

1022−-- replacement on invalid scalar values.

1023−unfoldr :: (a -> Maybe (Char,a)) -> a -> Text

1024−unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)

695+-- string, and @b@ is the seed value for further production.

696+unfoldr :: (a -> Maybe (Char,a)) -> a -> Text

697+unfoldr f s = unstream (S.unfoldr f s)

1025698{-# INLINE unfoldr #-}

1026699

1027700-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed

@@ -1029,9 +702,8 @@ unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)

1029702-- first argument to 'unfoldrN'. This function is more efficient than

1030703-- 'unfoldr' when the maximum length of the result is known and

1031704-- correct, otherwise its performance is similar to 'unfoldr'.

1032−-- Performs replacement on invalid scalar values.

1033−unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Text

1034−unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)

705+unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Text

706+unfoldrN n f s = unstream (S.unfoldrN n f s)

1035707{-# INLINE unfoldrN #-}

1036708

1037709-- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the

@@ -1055,22 +727,6 @@ take i t0 = take' i t0

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

1056728 #-}

1057729

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−

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

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

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

@@ -1080,7 +736,7 @@ drop i t0

1080736 | otherwise = drop' i t0

1081737 where drop' 0 ts = ts

1082738 drop' _ Empty = Empty

1083− drop' n (Chunk t ts)

739+ drop' n (Chunk t ts)

1084740 | n < len = Chunk (T.drop (fromIntegral n) t) ts

1085741 | otherwise = drop' (n - len) ts

1086742 where len = fromIntegral (T.length t)

@@ -1093,23 +749,6 @@ drop i t0

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

1094750 #-}

1095751

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−

1113752-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'

1114753-- values dropped, or the empty 'Text' if @n@ is greater than the

1115754-- number of 'Word16' values present.

@@ -1120,14 +759,14 @@ dropWords i t0

1120759 where drop' 0 ts = ts

1121760 drop' _ Empty = Empty

1122761 drop' n (Chunk (T.Text arr off len) ts)

1123− | n < len' = chunk (text arr (off+n') (len-n')) ts

762+ | n < len' = chunk (textP arr (off+n') (len-n')) ts

1124763 | otherwise = drop' (n - len') ts

1125764 where len' = fromIntegral len

1126765 n' = fromIntegral n

1127766

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

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

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

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

768+-- the longest prefix (possibly empty) of elements that satisfy @p@.

769+-- This function is subject to array fusion.

1131770takeWhile :: (Char -> Bool) -> Text -> Text

1132771takeWhile p t0 = takeWhile' t0

1133772 where takeWhile' Empty = Empty

@@ -1144,23 +783,9 @@ takeWhile p t0 = takeWhile' t0

1144783"LAZY TEXT takeWhile -> unfused" [1] forall p t.

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

1146785 #-}

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 #-}

1161786

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

1163−-- 'takeWhile' @p@ @t@. Subject to fusion.

788+-- 'takeWhile' @p@ @t@. This function is subject to array fusion.

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

1165790dropWhile p t0 = dropWhile' t0

1166791 where dropWhile' Empty = Empty

@@ -1176,11 +801,9 @@ dropWhile p t0 = dropWhile' t0

1176801"LAZY TEXT dropWhile -> unfused" [1] forall p t.

1177802 unstream (S.dropWhile p (stream t)) = dropWhile p t

1178803 #-}

1179−

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

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

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

1182806-- @t@.

1183−--

1184807-- Examples:

1185808--

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

@@ -1197,7 +820,7 @@ dropWhileEnd p = go

1197820{-# INLINE dropWhileEnd #-}

1198821

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

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

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

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

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

1203826dropAround p = dropWhile p . dropWhileEnd p

@@ -1247,8 +870,8 @@ splitAtWord _ Empty = empty :*: empty

1247870splitAtWord x (Chunk c@(T.Text arr off len) cs)

1248871 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs

1249872 in Chunk c h :*: t

1250− | otherwise = chunk (text arr off y) empty :*:

1251− chunk (text arr (off+y) (len-y)) cs

873+ | otherwise = chunk (textP arr off y) empty :*:

874+ chunk (textP arr (off+y) (len-y)) cs

1252875 where y = fromIntegral x

1253876

1254877-- | /O(n+m)/ Find the first instance of @needle@ (which must be

@@ -1258,16 +881,16 @@ splitAtWord x (Chunk c@(T.Text arr off len) cs)

1258881--

1259882-- Examples:

1260883--

1261−-- > breakOn "::" "a::b::c" ==> ("a", "::b::c")

1262−-- > breakOn "/" "foobar" ==> ("foobar", "")

884+-- > break "::" "a::b::c" ==> ("a", "::b::c")

885+-- > break "/" "foobar" ==> ("foobar", "")

1263886--

1264887-- Laws:

1265888--

1266889-- > append prefix match == haystack

1267−-- > where (prefix, match) = breakOn needle haystack

890+-- > where (prefix, match) = break needle haystack

1268891--

1269892-- If you need to break a string by a substring repeatedly (e.g. you

1270−-- want to break on every instance of a substring), use 'breakOnAll'

893+-- want to break on every instance of a substring), use 'find'

1271894-- instead, as it has lower startup overhead.

1272895--

1273896-- This function is strict in its first argument, and lazy in its

@@ -1275,25 +898,25 @@ splitAtWord x (Chunk c@(T.Text arr off len) cs)

1275898--

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

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

1278−breakOn :: Text -> Text -> (Text, Text)

1279−breakOn pat src

1280− | null pat = emptyError "breakOn"

901+break :: Text -> Text -> (Text, Text)

902+break pat src

903+ | null pat = emptyError "break"

1281904 | otherwise = case indices pat src of

1282905 [] -> (src, empty)

1283906 (x:_) -> let h :*: t = splitAtWord x src

1284907 in (h, t)

1285908

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

909+-- | /O(n+m)/ Similar to 'break', but searches from the end of the string.

1287910--

1288911-- The first element of the returned tuple is the prefix of @haystack@

1289912-- up to and including the last match of @needle@. The second is the

1290913-- remainder of @haystack@, following the match.

1291914--

1292−-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")

1293−breakOnEnd :: Text -> Text -> (Text, Text)

1294−breakOnEnd pat src = let (a,b) = breakOn (reverse pat) (reverse src)

915+-- > breakEnd "::" "a::b::c" ==> ("a::b::", "c")

916+breakEnd :: Text -> Text -> (Text, Text)

917+breakEnd pat src = let (a,b) = break (reverse pat) (reverse src)

1295918 in (reverse b, reverse a)

1296−{-# INLINE breakOnEnd #-}

919+{-# INLINE breakEnd #-}

1297920

1298921-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in

1299922-- @haystack@. Each element of the returned list consists of a pair:

@@ -1304,9 +927,9 @@ breakOnEnd pat src = let (a,b) = breakOn (reverse pat) (reverse src)

1304927--

1305928-- Examples:

1306929--

1307−-- > breakOnAll "::" ""

930+-- > find "::" ""

1308931-- > ==> []

1309−-- > breakOnAll "/" "a/b/c/"

932+-- > find "/" "a/b/c/"

1310933-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]

1311934--

1312935-- This function is strict in its first argument, and lazy in its

@@ -1316,11 +939,11 @@ breakOnEnd pat src = let (a,b) = breakOn (reverse pat) (reverse src)

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

1317940--

1318941-- The @needle@ parameter may not be empty.

1319−breakOnAll :: Text -- ^ @needle@ to search for

1320− -> Text -- ^ @haystack@ in which to search

1321− -> [(Text, Text)]

1322−breakOnAll pat src

1323− | null pat = emptyError "breakOnAll"

942+find :: Text -- ^ @needle@ to search for

943+ -> Text -- ^ @haystack@ in which to search

944+ -> [(Text, Text)]

945+find pat src

946+ | null pat = emptyError "find"

1324947 | otherwise = go 0 empty src (indices pat src)

1325948 where

1326949 go !n p s (x:xs) = let h :*: t = splitAtWord (x-n) s

@@ -1328,10 +951,10 @@ breakOnAll pat src

1328951 in (h',t) : go x h' t xs

1329952 go _ _ _ _ = []

1330953

1331−-- | /O(n)/ 'break' is like 'span', but the prefix returned is over

954+-- | /O(n)/ 'breakBy' is like 'spanBy', but the prefix returned is over

1332955-- elements that fail the predicate @p@.

1333−break :: (Char -> Bool) -> Text -> (Text, Text)

1334−break p t0 = break' t0

956+breakBy :: (Char -> Bool) -> Text -> (Text, Text)

957+breakBy p t0 = break' t0

1335958 where break' Empty = (empty, empty)

1336959 break' c@(Chunk t ts) =

1337960 case T.findIndex p t of

@@ -1341,13 +964,13 @@ break p t0 = break' t0

1341964 | otherwise -> let (a,b) = T.splitAt n t

1342965 in (Chunk a Empty, Chunk b ts)

1343966

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

967+-- | /O(n)/ 'spanBy', applied to a predicate @p@ and text @t@, returns

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

1346969-- of @t@ of elements that satisfy @p@, and whose second is the

1347970-- remainder of the list.

1348−span :: (Char -> Bool) -> Text -> (Text, Text)

1349−span p = break (not . p)

1350−{-# INLINE span #-}

971+spanBy :: (Char -> Bool) -> Text -> (Text, Text)

972+spanBy p = breakBy (not . p)

973+{-# INLINE spanBy #-}

1351974

1352975-- | The 'group' function takes a 'Text' and returns a list of 'Text's

1353976-- such that the concatenation of the result is equal to the argument.

@@ -1366,7 +989,7 @@ group = groupBy (==)

1366989groupBy :: (Char -> Char -> Bool) -> Text -> [Text]

1367990groupBy _ Empty = []

1368991groupBy eq (Chunk t ts) = cons x ys : groupBy eq zs

1369− where (ys,zs) = span (eq x) xs

992+ where (ys,zs) = spanBy (eq x) xs

1370993 x = T.unsafeHead t

1371994 xs = chunk (T.unsafeTail t) ts

1372995

@@ -1392,49 +1015,43 @@ tails ts@(Chunk t ts')

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

13931016-- are slices of the original.

13941017

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.

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

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

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

13991021--

14001022-- Examples:

14011023--

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

1403−-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]

1404−-- > splitOn "x" "x" == ["",""]

1405−--

1024+-- > split "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]

1025+-- > split "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]

1026+-- > split "x" "x" == ["",""]

1027+--

14061028-- and

14071029--

1408−-- > intercalate s . splitOn s == id

1409−-- > splitOn (singleton c) == split (==c)

1410−--

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

1030+-- > intercalate s . split s == id

1031+-- > split (singleton c) == splitBy (==c)

14121032--

14131033-- This function is strict in its first argument, and lazy in its

14141034-- second.

14151035--

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

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

1423− -> [Text]

1424−splitOn pat src

1425− | null pat = emptyError "splitOn"

1426− | isSingleton pat = split (== head pat) src

1038+split :: Text -- ^ Text to split on

1039+ -> Text -- ^ Input text

1040+ -> [Text]

1041+split pat src

1042+ | null pat = emptyError "split"

1043+ | isSingleton pat = splitBy (== head pat) src

14271044 | otherwise = go 0 (indices pat src) src

14281045 where

14291046 go _ [] cs = [cs]

14301047 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs

14311048 in h : go (x+l) xs (dropWords l t)

14321049 l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat

1433−{-# INLINE [1] splitOn #-}

1050+{-# INLINE [1] split #-}

14341051

14351052{-# RULES

1436−"LAZY TEXT splitOn/singleton -> split/==" [~1] forall c t.

1437− splitOn (singleton c) t = split (==c) t

1053+"LAZY TEXT split/singleton -> splitBy/==" [~1] forall c t.

1054+ split (singleton c) t = splitBy (==c) t

14381055 #-}

14391056

14401057-- | /O(n)/ Splits a 'Text' into components delimited by separators,

@@ -1442,16 +1059,16 @@ splitOn pat src

14421059-- resulting components do not contain the separators. Two adjacent

14431060-- separators result in an empty component in the output. eg.

14441061--

1445−-- > split (=='a') "aabbaca" == ["","","bb","c",""]

1446−-- > split (=='a') [] == [""]

1447−split :: (Char -> Bool) -> Text -> [Text]

1448−split _ Empty = [Empty]

1449−split p (Chunk t0 ts0) = comb [] (T.split p t0) ts0

1062+-- > splitBy (=='a') "aabbaca" == ["","","bb","c",""]

1063+-- > splitBy (=='a') [] == [""]

1064+splitBy :: (Char -> Bool) -> Text -> [Text]

1065+splitBy _ Empty = [Empty]

1066+splitBy p (Chunk t0 ts0) = comb [] (T.splitBy p t0) ts0

14501067 where comb acc (s:[]) Empty = revChunks (s:acc) : []

1451− comb acc (s:[]) (Chunk t ts) = comb (s:acc) (T.split p t) ts

1068+ comb acc (s:[]) (Chunk t ts) = comb (s:acc) (T.splitBy p t) ts

14521069 comb acc (s:ss) ts = revChunks (s:acc) : comb [] ss ts

1453− comb _ [] _ = impossibleError "split"

1454−{-# INLINE split #-}

1070+ comb _ [] _ = impossibleError "splitBy"

1071+{-# INLINE splitBy #-}

14551072

14561073-- | /O(n)/ Splits a 'Text' into components of length @k@. The last

14571074-- element may be shorter than the other chunks, depending on the

@@ -1471,14 +1088,14 @@ chunksOf k = go

14711088-- newline 'Char's. The resulting strings do not contain newlines.

14721089lines :: Text -> [Text]

14731090lines Empty = []

1474−lines t = let (l,t') = break ((==) '\n') t

1091+lines t = let (l,t') = breakBy ((==) '\n') t

14751092 in l : if null t' then []

14761093 else lines (tail t')

14771094

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

14791096-- representing white space.

14801097words :: Text -> [Text]

1481−words = L.filter (not . null) . split isSpace

1098+words = L.filter (not . null) . splitBy isSpace

14821099{-# INLINE words #-}

14831100

14841101-- | /O(n)/ Joins lines, after appending a terminating newline to

@@ -1493,7 +1110,8 @@ unwords = intercalate (singleton ' ')

14931110{-# INLINE unwords #-}

14941111

14951112-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns

1496−-- 'True' iff the first is a prefix of the second. Subject to fusion.

1113+-- 'True' iff the first is a prefix of the second. This function is

1114+-- subject to fusion.

14971115isPrefixOf :: Text -> Text -> Bool

14981116isPrefixOf Empty _ = True

14991117isPrefixOf _ Empty = False

@@ -1545,77 +1163,51 @@ isInfixOf needle haystack

15451163-------------------------------------------------------------------------------

15461164-- * View patterns

15471165

1548−-- | /O(n)/ Return the suffix of the second string if its prefix

1549−-- matches the entire first string.

1166+-- | /O(n)/ Returns the suffix of the second string if its prefix

1167+-- matches the first.

15501168--

15511169-- Examples:

15521170--

1553−-- > stripPrefix "foo" "foobar" == Just "bar"

1554−-- > stripPrefix "" "baz" == Just "baz"

1555−-- > stripPrefix "foo" "quux" == Nothing

1171+-- > prefixed "foo" "foobar" == Just "bar"

1172+-- > prefixed "foo" "quux" == Nothing

15561173--

15571174-- This is particularly useful with the @ViewPatterns@ extension to

15581175-- GHC, as follows:

15591176--

15601177-- > {-# LANGUAGE ViewPatterns #-}

1561−-- > import Data.Text.Lazy as T

1178+-- > import Data.Text as T

15621179-- >

15631180-- > fnordLength :: Text -> Int

1564−-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf

1565−-- > fnordLength _ = -1

1566−stripPrefix :: Text -> Text -> Maybe Text

1567−stripPrefix p t

1568− | null p = Just t

1569− | otherwise = case commonPrefixes p t of

1570− Just (_,c,r) | null c -> Just r

1571− _ -> Nothing

1572−

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

1574−-- and return it, along with the suffixes of each string at which they

1575−-- no longer match.

1576−--

1577−-- If the strings do not have a common prefix or either one is empty,

1578−-- this function returns 'Nothing'.

1579−--

1580−-- Examples:

1581−--

1582−-- > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux")

1583−-- > commonPrefixes "veeble" "fetzer" == Nothing

1584−-- > commonPrefixes "" "baz" == Nothing

1585−commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)

1586−commonPrefixes Empty _ = Nothing

1587−commonPrefixes _ Empty = Nothing

1588−commonPrefixes a0 b0 = Just (go a0 b0 [])

1589− where

1590− go t0@(Chunk x xs) t1@(Chunk y ys) ps

1591− = case T.commonPrefixes x y of

1592− Just (p,a,b)

1593− | T.null a -> go xs (chunk b ys) (p:ps)

1594− | T.null b -> go (chunk a xs) ys (p:ps)

1595− | otherwise -> (fromChunks (L.reverse (p:ps)),chunk a xs, chunk b ys)

1596− Nothing -> (fromChunks (L.reverse ps),t0,t1)

1597− go t0 t1 ps = (fromChunks (L.reverse ps),t0,t1)

1598−

1599−-- | /O(n)/ Return the prefix of the second string if its suffix

1600−-- matches the entire first string.

1181+-- > fnordLength (prefixed "fnord" -> Just suf) = T.length suf

1182+-- > fnordLength _ = -1

1183+prefixed :: Text -> Text -> Maybe Text

1184+-- Yes, this could be much more efficient.

1185+prefixed p t

1186+ | p `isPrefixOf` t = Just (drop (length p) t)

1187+ | otherwise = Nothing

1188+

1189+-- | /O(n)/ Returns the prefix of the second string if its suffix

1190+-- matches the first.

16011191--

16021192-- Examples:

16031193--

1604−-- > stripSuffix "bar" "foobar" == Just "foo"

1605−-- > stripSuffix "" "baz" == Just "baz"

1606−-- > stripSuffix "foo" "quux" == Nothing

1194+-- > suffixed "bar" "foobar" == Just "foo"

1195+-- > suffixed "foo" "quux" == Nothing

16071196--

16081197-- This is particularly useful with the @ViewPatterns@ extension to

16091198-- GHC, as follows:

16101199--

16111200-- > {-# LANGUAGE ViewPatterns #-}

1612−-- > import Data.Text.Lazy as T

1201+-- > import Data.Text as T

16131202-- >

16141203-- > quuxLength :: Text -> Int

1615−-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre

1616−-- > quuxLength _ = -1

1617−stripSuffix :: Text -> Text -> Maybe Text

1618−stripSuffix p t = reverse `fmap` stripPrefix (reverse p) (reverse t)

1204+-- > quuxLength (suffixed "quux" -> Just pre) = T.length pre

1205+-- > quuxLength _ = -1

1206+suffixed :: Text -> Text -> Maybe Text

1207+-- Yes, this could be much more efficient.

1208+suffixed p t

1209+ | p `isSuffixOf` t = Just (take (length t - length p) t)

1210+ | otherwise = Nothing

16191211

16201212-- | /O(n)/ 'filter', applied to a predicate and a 'Text',

16211213-- returns a 'Text' containing those characters that satisfy the

@@ -1624,21 +1216,21 @@ filter :: (Char -> Bool) -> Text -> Text

16241216filter p t = unstream (S.filter p (stream t))

16251217{-# INLINE filter #-}

16261218

1627−-- | /O(n)/ The 'find' function takes a predicate and a 'Text', and

1219+-- | /O(n)/ The 'findBy' function takes a predicate and a 'Text', and

16281220-- returns the first element in matching the predicate, or 'Nothing'

16291221-- if there is no such element.

1630−find :: (Char -> Bool) -> Text -> Maybe Char

1631−find p t = S.findBy p (stream t)

1632−{-# INLINE find #-}

1222+findBy :: (Char -> Bool) -> Text -> Maybe Char

1223+findBy p t = S.findBy p (stream t)

1224+{-# INLINE findBy #-}

16331225

1634−-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',

1226+-- | /O(n)/ The 'partitionBy' function takes a predicate and a 'Text',

16351227-- and returns the pair of 'Text's with elements which do and do not

16361228-- satisfy the predicate, respectively; i.e.

16371229--

1638−-- > partition p t == (filter p t, filter (not . p) t)

1639−partition :: (Char -> Bool) -> Text -> (Text, Text)

1640−partition p t = (filter p t, filter (not . p) t)

1641−{-# INLINE partition #-}

1230+-- > partitionBy p t == (filter p t, filter (not . p) t)

1231+partitionBy :: (Char -> Bool) -> Text -> (Text, Text)

1232+partitionBy p t = (filter p t, filter (not . p) t)

1233+{-# INLINE partitionBy #-}

16421234

16431235-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.

16441236index :: Text -> Int64 -> Char

@@ -1665,7 +1257,8 @@ count pat src

16651257 #-}

16661258

16671259-- | /O(n)/ The 'countChar' function returns the number of times the

1668−-- query element appears in the given 'Text'. Subject to fusion.

1260+-- query element appears in the given 'Text'. This function is subject

1261+-- to fusion.

16691262countChar :: Char -> Text -> Int64

16701263countChar c t = S.countChar c (stream t)

16711264

@@ -1679,10 +1272,8 @@ zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)

16791272

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

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

1682−-- Performs replacement on invalid scalar values.

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

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

1685− where g a b = safe (f a b)

1276+zipWith f t1 t2 = unstream (S.zipWith f (stream t1) (stream t2))

16861277{-# INLINE [0] zipWith #-}

16871278

16881279revChunks :: [T.Text] -> Text

Data/Text/Lazy/Builder.hs+300−31

@@ -1,42 +1,17 @@

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

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-}

4−#endif

52

63-----------------------------------------------------------------------------

74-- |

85-- Module : Data.Text.Lazy.Builder

11−-- License : BSD-style (see LICENSE)

12−--

6+-- Copyright : Johan Tibell

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

1612--

17−-- Efficient construction of lazy @Text@ values. The principal

18−-- operations on a @Builder@ are @singleton@, @fromText@, and

19−-- @fromLazyText@, which construct new builders, and 'mappend', which

20−-- concatenates two builders.

21−--

22−-- To get maximum performance when building lazy @Text@ values using a

23−-- builder, associate @mappend@ calls to the right. For example,

24−-- prefer

25−--

26−-- > singleton 'a' `mappend` (singleton 'b' `mappend` singleton 'c')

27−--

28−-- to

13+-- Efficient construction of lazy texts.

2914--

30−-- > singleton 'a' `mappend` singleton 'b' `mappend` singleton 'c'

31−--

32−-- as the latter associates @mappend@ to the left. Or, equivalently,

33−-- prefer

34−--

35−-- > singleton 'a' <> singleton 'b' <> singleton 'c'

36−--

37−-- since the '<>' from recent versions of 'Data.Monoid' associates

38−-- to the right.

39−

4015-----------------------------------------------------------------------------

4116

4217module Data.Text.Lazy.Builder

@@ -49,10 +24,304 @@ module Data.Text.Lazy.Builder

4924 , singleton

5025 , fromText

5126 , fromLazyText

52− , fromString

5327

5428 -- * Flushing the buffer state

5529 , flush

5630 ) where

5731

58−import Data.Text.Internal.Builder

32+#if defined(ASSERTS)

33+import Control.Exception (assert)

34+#endif

35+import Control.Monad.ST (ST, runST)

36+import Data.Bits ((.&.))

37+import Data.Char (ord)

38+import Data.Monoid (Monoid(..))

39+import Data.Text.Internal (Text(..))

40+import Data.Text.Lazy.Internal (smallChunkSize)

41+import Data.Text.Unsafe (inlineInterleaveST)

42+import Data.Text.UnsafeShift (shiftR)

43+import Prelude hiding (map, putChar)

44+

45+import qualified Data.String as String

46+import qualified Data.Text as S

47+import qualified Data.Text.Array as A

48+import qualified Data.Text.Lazy as L

49+

50+------------------------------------------------------------------------

51+

52+-- | A 'Builder' is an efficient way to build lazy 'L.Text's. There

53+-- are several functions for constructing 'Builder's, but only one to

54+-- inspect them: to extract any data, you have to turn them into lazy

55+-- 'L.Text's using 'toLazyText'.

56+--

57+-- Internally, a 'Builder' constructs a lazy 'L.Text' by filling byte

58+-- arrays piece by piece. As each buffer is filled, it is \'popped\'

59+-- off, to become a new chunk of the resulting lazy 'L.Text'. All

60+-- this is hidden from the user of the 'Builder'.

61+newtype Builder = Builder {

62+ -- Invariant (from Data.Text.Lazy):

63+ -- The lists include no null Texts.

64+ runBuilder :: forall s. (Buffer s -> ST s [S.Text])

65+ -> Buffer s

66+ -> ST s [S.Text]

67+ }

68+

69+instance Monoid Builder where

70+ mempty = empty

71+ {-# INLINE mempty #-}

72+ mappend = append

73+ {-# INLINE mappend #-}

74+

75+instance String.IsString Builder where

76+ fromString = fromString

77+ {-# INLINE fromString #-}

78+

79+instance Show Builder where

80+ show = L.unpack . toLazyText

81+

82+------------------------------------------------------------------------

83+

84+-- | /O(1)./ The empty Builder, satisfying

85+--

86+-- * @'toLazyText' 'empty' = 'L.empty'@

87+--

88+empty :: Builder

89+empty = Builder id

90+{-# INLINE empty #-}

91+

92+-- | /O(1)./ A Builder taking a single character, satisfying

93+--

94+-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@

95+--

96+singleton :: Char -> Builder

97+singleton c = putChar c

98+{-# INLINE singleton #-}

99+

100+------------------------------------------------------------------------

101+

102+-- | /O(1)./ The concatenation of two Builders, an associative

103+-- operation with identity 'empty', satisfying

104+--

105+-- * @'toLazyText' ('append' x y) = 'L.append' ('toLazyText' x) ('toLazyText' y)@

106+--

107+append :: Builder -> Builder -> Builder

108+append (Builder f) (Builder g) = Builder (f . g)

109+{-# INLINE [0] append #-}

110+

111+-- TODO: Experiment to find the right threshold.

112+copyLimit :: Int

113+copyLimit = 128

114+

115+-- This function attempts to merge small Texts instead of treating the

116+-- text as its own chunk. We may not always want this.

117+

118+-- | /O(1)./ A Builder taking a 'S.Text', satisfying

119+--

120+-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@

121+--

122+fromText :: S.Text -> Builder

123+fromText t@(Text arr off l)

124+ | S.null t = empty

125+ | l <= copyLimit = writeN l $ \marr o -> unsafeCopy arr off marr o l

126+ | otherwise = flush `append` mapBuilder (t :)

127+{-# INLINE [1] fromText #-}

128+

129+{-# RULES

130+"fromText/pack" forall s .

131+ fromText (S.pack s) = fromString s

132+ #-}

133+

134+-- | /O(1)./ A Builder taking a 'String', satisfying

135+--

136+-- * @'toLazyText' ('fromString' s) = 'L.fromChunks' [S.pack s]@

137+--

138+fromString :: String -> Builder

139+fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->

140+ let loop !marr !o !u !l [] = k (Buffer marr o u l)

141+ loop marr o u l s@(c:cs)

142+ | l <= 1 = do

143+ arr <- A.unsafeFreeze marr

144+ let !t = Text arr o u

145+ marr' <- A.unsafeNew chunkSize

146+ ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)

147+ return $ t : ts

148+ | otherwise = do

149+ n <- unsafeWrite marr (o+u) c

150+ loop marr o (u+n) (l-n) cs

151+ in loop p0 o0 u0 l0 str

152+ where

153+ chunkSize = smallChunkSize

154+{-# INLINE fromString #-}

155+

156+-- | /O(1)./ A Builder taking a lazy 'L.Text', satisfying

157+--

158+-- * @'toLazyText' ('fromLazyText' t) = t@

159+--

160+fromLazyText :: L.Text -> Builder

161+fromLazyText ts = flush `append` mapBuilder (L.toChunks ts ++)

162+{-# INLINE fromLazyText #-}

163+

164+------------------------------------------------------------------------

165+

166+-- Our internal buffer type

167+data Buffer s = Buffer {-# UNPACK #-} !(A.MArray s)

168+ {-# UNPACK #-} !Int -- offset

169+ {-# UNPACK #-} !Int -- used units

170+ {-# UNPACK #-} !Int -- length left

171+

172+------------------------------------------------------------------------

173+

174+-- | /O(n)./ Extract a lazy 'L.Text' from a 'Builder' with a default

175+-- buffer size. The construction work takes place if and when the

176+-- relevant part of the lazy 'L.Text' is demanded.

177+toLazyText :: Builder -> L.Text

178+toLazyText = toLazyTextWith smallChunkSize

179+

180+-- | /O(n)./ Extract a lazy 'L.Text' from a 'Builder', using the given

181+-- size for the initial buffer. The construction work takes place if

182+-- and when the relevant part of the lazy 'L.Text' is demanded.

183+--

184+-- If the initial buffer is too small to hold all data, subsequent

185+-- buffers will be the default buffer size.

186+toLazyTextWith :: Int -> Builder -> L.Text

187+toLazyTextWith chunkSize m = L.fromChunks . runST $

188+ newBuffer chunkSize >>= runBuilder (m `append` flush) (const (return []))

189+

190+-- | /O(1)./ Pop the 'S.Text' we have constructed so far, if any,

191+-- yielding a new chunk in the result lazy 'L.Text'.

192+flush :: Builder

193+flush = Builder $ \ k buf@(Buffer p o u l) ->

194+ if u == 0

195+ then k buf

196+ else do arr <- A.unsafeFreeze p

197+ let !b = Buffer p (o+u) 0 l

198+ !t = Text arr o u

199+ ts <- inlineInterleaveST (k b)

200+ return $! t : ts

201+

202+------------------------------------------------------------------------

203+

204+-- | Sequence an ST operation on the buffer

205+withBuffer :: (forall s. Buffer s -> ST s (Buffer s)) -> Builder

206+withBuffer f = Builder $ \k buf -> f buf >>= k

207+{-# INLINE withBuffer #-}

208+

209+-- | Get the size of the buffer

210+withSize :: (Int -> Builder) -> Builder

211+withSize f = Builder $ \ k buf@(Buffer _ _ _ l) ->

212+ runBuilder (f l) k buf

213+

214+-- | Map the resulting list of texts.

215+mapBuilder :: ([S.Text] -> [S.Text]) -> Builder

216+mapBuilder f = Builder (fmap f .)

217+

218+------------------------------------------------------------------------

219+

220+putChar :: Char -> Builder

221+putChar c

222+ | n < 0x10000 = writeN 1 $ \marr o -> A.unsafeWrite marr o (fromIntegral n)

223+ | otherwise = writeN 2 $ \marr o -> do

224+ A.unsafeWrite marr o lo

225+ A.unsafeWrite marr (o+1) hi

226+ where n = ord c

227+ m = n - 0x10000

228+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800

229+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00

230+{-# INLINE putChar #-}

231+

232+------------------------------------------------------------------------

233+

234+-- | Ensure that there are at least @n@ many elements available.

235+ensureFree :: Int -> Builder

236+ensureFree !n = withSize $ \ l ->

237+ if n <= l

238+ then empty

239+ else flush `append'` withBuffer (const (newBuffer (max n smallChunkSize)))

240+{-# INLINE [0] ensureFree #-}

241+

242+-- | Ensure that @n@ many elements are available, and then use @f@ to

243+-- write some elements into the memory.

244+writeN :: Int -> (forall s. A.MArray s -> Int -> ST s ()) -> Builder

245+writeN n f = ensureFree n `append'` withBuffer (writeNBuffer n f)

246+{-# INLINE [0] writeN #-}

247+

248+writeNBuffer :: Int -> (A.MArray s -> Int -> ST s ()) -> (Buffer s)

249+ -> ST s (Buffer s)

250+writeNBuffer n f (Buffer p o u l) = do

251+ f p (o+u)

252+ return $! Buffer p o (u+n) (l-n)

253+{-# INLINE writeNBuffer #-}

254+

255+newBuffer :: Int -> ST s (Buffer s)

256+newBuffer size = do

257+ arr <- A.unsafeNew size

258+ return $! Buffer arr 0 0 size

259+{-# INLINE newBuffer #-}

260+

261+-- | Unsafely copy the elements of an array.

262+unsafeCopy :: A.Array -> Int -> A.MArray s -> Int -> Int -> ST s ()

263+unsafeCopy src sidx dest didx count =

264+#if defined(ASSERTS)

265+ assert (sidx + count <= A.length src) .

266+ assert (didx + count <= A.length dest) $

267+#endif

268+ copy_loop sidx didx 0

269+ where

270+ copy_loop !i !j !c

271+ | c >= count = return ()

272+ | otherwise = do A.unsafeWrite dest j (A.unsafeIndex src i)

273+ copy_loop (i+1) (j+1) (c+1)

274+{-# INLINE unsafeCopy #-}

275+

276+-- Write a character to the array, starting at the specified offset

277+-- @i@. Returns the number of elements written.

278+unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int

279+unsafeWrite marr i c

280+ | n < 0x10000 = do

281+#if defined(ASSERTS)

282+ assert (i >= 0) . assert (i < A.length marr) $ return ()

283+#endif

284+ A.unsafeWrite marr i (fromIntegral n)

285+ return 1

286+ | otherwise = do

287+#if defined(ASSERTS)

288+ assert (i >= 0) . assert (i < A.length marr - 1) $ return ()

289+#endif

290+ A.unsafeWrite marr i lo

291+ A.unsafeWrite marr (i+1) hi

292+ return 2

293+ where n = ord c

294+ m = n - 0x10000

295+ lo = fromIntegral $ (m `shiftR` 10) + 0xD800

296+ hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00

297+{-# INLINE unsafeWrite #-}

298+

299+------------------------------------------------------------------------

300+-- Some nice rules for Builder

301+

302+-- This function makes GHC understand that 'writeN' and 'ensureFree'

303+-- are *not* recursive in the precense of the rewrite rules below.

304+-- This is not needed with GHC 6.14+.

305+append' :: Builder -> Builder -> Builder

306+append' (Builder f) (Builder g) = Builder (f . g)

307+{-# INLINE append' #-}

308+

309+{-# RULES

310+

311+"append/writeN" forall a b (f::forall s. A.MArray s -> Int -> ST s ())

312+ (g::forall s. A.MArray s -> Int -> ST s ()) ws.

313+ append (writeN a f) (append (writeN b g) ws) =

314+ append (writeN (a+b) (\marr o -> f marr o >> g marr (o+a))) ws

315+

316+"writeN/writeN" forall a b (f::forall s. A.MArray s -> Int -> ST s ())

317+ (g::forall s. A.MArray s -> Int -> ST s ()).

318+ append (writeN a f) (writeN b g) =

319+ writeN (a+b) (\marr o -> f marr o >> g marr (o+a))

320+

321+"ensureFree/ensureFree" forall a b .

322+ append (ensureFree a) (ensureFree b) = ensureFree (max a b)

323+

324+"flush/flush"

325+ append flush flush = flush

326+

327+ #-}

Data/Text/Lazy/Builder/Int.hsdeleted−262

@@ -1,262 +0,0 @@

1−{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,

2− UnboxedTuples #-}

3−#if __GLASGOW_HASKELL__ >= 702

4−{-# LANGUAGE Trustworthy #-}

5−#endif

6−

7−-- Module: Data.Text.Lazy.Builder.Int

10−-- License: BSD-style

11−-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>

12−-- Stability: experimental

13−-- Portability: portable

14−--

15−-- Efficiently write an integral value to a 'Builder'.

16−

17−module Data.Text.Lazy.Builder.Int

18− (

19− decimal

20− , hexadecimal

21− ) where

22−

23−import Data.Int (Int8, Int16, Int32, Int64)

24−import 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

30−import Data.Word (Word, Word8, Word16, Word32, Word64)

31−import GHC.Base (quotInt, remInt)

32−import GHC.Num (quotRemInteger)

33−import GHC.Types (Int(..))

34−import Control.Monad.ST

35−

36−#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

41−# else

42−# error "You need to use either GMP or integer-simple."

43−# endif

44−#endif

45−

46−#if defined(INTEGER_GMP) || defined(INTEGER_SIMPLE)

47−# define PAIR(a,b) (# a,b #)

48−#else

49−# define PAIR(a,b) (a,b)

50−#endif

51−

52−decimal :: 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 #-}

63−{-# 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

161−

162−hexadecimal :: Integral a => a -> Builder

163−{-# SPECIALIZE hexadecimal :: Int -> Builder #-}

164−{-# SPECIALIZE hexadecimal :: Int8 -> Builder #-}

165−{-# SPECIALIZE hexadecimal :: Int16 -> Builder #-}

166−{-# SPECIALIZE hexadecimal :: Int32 -> Builder #-}

167−{-# SPECIALIZE hexadecimal :: Int64 -> Builder #-}

168−{-# SPECIALIZE hexadecimal :: Word -> Builder #-}

169−{-# SPECIALIZE hexadecimal :: Word8 -> Builder #-}

170−{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}

171−{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}

172−{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}

173−{-# RULES "hexadecimal/Integer"

174− hexadecimal = hexInteger :: Integer -> Builder #-}

175−hexadecimal i

176− | i < 0 = error hexErrMsg

177− | otherwise = go i

178− where

179− go n | n < 16 = hexDigit n

180− | 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

187−

188−hexErrMsg :: String

189−hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"

190−

191−hexDigit :: Integral a => a -> Builder

192−hexDigit n

193− | n <= 9 = singleton $! i2d (fromIntegral n)

194− | otherwise = singleton $! toEnum (fromIntegral n + 87)

195−{-# INLINE hexDigit #-}

196−

197−data T = T !Integer !Int

198−

199−integer :: Int -> Integer -> Builder

200−#ifdef INTEGER_GMP

201−integer 10 (S# i#) = decimal (I# i#)

202−integer 16 (S# i#) = hexadecimal (I# i#)

203−#endif

204−integer base i

205− | i < 0 = singleton '-' <> go (-i)

206− | otherwise = go i

207− where

208− go n | n < maxInt = int (fromInteger n)

209− | otherwise = putH (splitf (maxInt * maxInt) n)

210−

211− splitf p n

212− | p > n = [n]

213− | otherwise = splith p (splitf (p*p) n)

214−

215− splith p (n:ns) = case n `quotRemInteger` p of

216− PAIR(q,r) | q > 0 -> q : r : splitb p ns

217− | otherwise -> r : splitb p ns

218− splith _ _ = error "splith: the impossible happened."

219−

220− splitb p (n:ns) = case n `quotRemInteger` p of

221− PAIR(q,r) -> q : r : splitb p ns

222− splitb _ _ = []

223−

224− T maxInt10 maxDigits10 =

225− until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)

226− where mi = fromIntegral (maxBound :: Int)

227− T maxInt16 maxDigits16 =

228− until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1)

229− where mi = fromIntegral (maxBound :: Int)

230−

231− fstT (T a _) = a

232−

233− maxInt | base == 10 = maxInt10

234− | otherwise = maxInt16

235− maxDigits | base == 10 = maxDigits10

236− | otherwise = maxDigits16

237−

238− putH (n:ns) = case n `quotRemInteger` maxInt of

239− PAIR(x,y)

240− | q > 0 -> int q <> pblock r <> putB ns

241− | otherwise -> int r <> putB ns

242− where q = fromInteger x

243− r = fromInteger y

244− putH _ = error "putH: the impossible happened"

245−

246− putB (n:ns) = case n `quotRemInteger` maxInt of

247− PAIR(x,y) -> pblock q <> pblock r <> putB ns

248− where q = fromInteger x

249− r = fromInteger y

250− putB _ = Data.Monoid.mempty

251−

252− int :: Int -> Builder

253− int x | base == 10 = decimal x

254− | otherwise = hexadecimal x

255−

256− pblock = loop maxDigits

257− where

258− loop !d !n

259− | d == 1 = hexDigit n

260− | otherwise = loop (d-1) q <> hexDigit r

261− where q = n `quotInt` base

262− r = n `remInt` base

Data/Text/Lazy/Builder/RealFloat.hsdeleted−242

@@ -1,242 +0,0 @@

1−{-# LANGUAGE CPP, OverloadedStrings #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-}

4−#endif

5−

6−-- |

7−-- Module: Data.Text.Lazy.Builder.RealFloat

8−-- Copyright: (c) The University of Glasgow 1994-2002

9−-- License: see libraries/base/LICENSE

10−--

11−-- Write a floating point value to a 'Builder'.

12−

13−module Data.Text.Lazy.Builder.RealFloat

14− (

15− FPFormat(..)

16− , realFloat

17− , formatRealFloat

18− ) where

19−

20−import Data.Array.Base (unsafeAt)

21−import Data.Array.IArray

22−import Data.Text.Internal.Builder.Functions ((<>), i2d)

23−import Data.Text.Lazy.Builder.Int (decimal)

24−import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)

25−import Data.Text.Lazy.Builder

26−import qualified Data.Text as T

27−

28−-- | Control the rendering of floating point numbers.

29−data FPFormat = Exponent

30− -- ^ Scientific notation (e.g. @2.3e123@).

31− | Fixed

32− -- ^ Standard decimal notation.

33− | Generic

34− -- ^ Use decimal notation for values between @0.1@ and

35− -- @9,999,999@, and scientific notation otherwise.

36− deriving (Enum, Read, Show)

37−

38−-- | Show a signed 'RealFloat' value to full precision,

39−-- using standard decimal notation for arguments whose absolute value lies

40−-- between @0.1@ and @9,999,999@, and scientific notation otherwise.

41−realFloat :: (RealFloat a) => a -> Builder

42−{-# SPECIALIZE realFloat :: Float -> Builder #-}

43−{-# SPECIALIZE realFloat :: Double -> Builder #-}

44−realFloat x = formatRealFloat Generic Nothing x

45−

46−formatRealFloat :: (RealFloat a) =>

47− FPFormat

48− -> Maybe Int -- ^ Number of decimal places to render.

49− -> a

50− -> Builder

51−{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Float -> Builder #-}

52−{-# SPECIALIZE formatRealFloat :: FPFormat -> Maybe Int -> Double -> Builder #-}

53−formatRealFloat fmt decs x

54− | isNaN x = "NaN"

55− | isInfinite x = if x < 0 then "-Infinity" else "Infinity"

56− | x < 0 || isNegativeZero x = singleton '-' <> doFmt fmt (floatToDigits (-x))

57− | otherwise = doFmt fmt (floatToDigits x)

58− where

59− doFmt format (is, e) =

60− let ds = map i2d is in

61− case format of

62− Generic ->

63− doFmt (if e < 0 || e > 7 then Exponent else Fixed)

64− (is,e)

65− Exponent ->

66− case decs of

67− Nothing ->

68− let show_e' = decimal (e-1) in

69− case ds of

70− "0" -> "0.0e0"

71− [d] -> singleton d <> ".0e" <> show_e'

72− (d:ds') -> singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> show_e'

73− [] -> error "formatRealFloat/doFmt/Exponent: []"

74− Just dec ->

75− let dec' = max dec 1 in

76− case is of

77− [0] -> "0." <> fromText (T.replicate dec' "0") <> "e0"

78− _ ->

79− let

80− (ei,is') = roundTo (dec'+1) is

81− (d:ds') = map i2d (if ei > 0 then init is' else is')

82− in

83− singleton d <> singleton '.' <> fromString ds' <> singleton 'e' <> decimal (e-1+ei)

84− Fixed ->

85− let

86− mk0 ls = case ls of { "" -> "0" ; _ -> fromString ls}

87− in

88− case decs of

89− Nothing

90− | e <= 0 -> "0." <> fromText (T.replicate (-e) "0") <> fromString ds

91− | otherwise ->

92− let

93− f 0 s rs = mk0 (reverse s) <> singleton '.' <> mk0 rs

94− f n s "" = f (n-1) ('0':s) ""

95− f n s (r:rs) = f (n-1) (r:s) rs

96− in

97− f e "" ds

98− Just dec ->

99− let dec' = max dec 0 in

100− if e >= 0 then

101− let

102− (ei,is') = roundTo (dec' + e) is

103− (ls,rs) = splitAt (e+ei) (map i2d is')

104− in

105− mk0 ls <> (if null rs then "" else singleton '.' <> fromString rs)

106− else

107− let

108− (ei,is') = roundTo dec' (replicate (-e) 0 ++ is)

109− d:ds' = map i2d (if ei > 0 then is' else 0:is')

110− in

111− singleton d <> (if null ds' then "" else singleton '.' <> fromString ds')

112−

113−

114−-- Based on "Printing Floating-Point Numbers Quickly and Accurately"

115−-- by R.G. Burger and R.K. Dybvig in PLDI 96.

116−-- This version uses a much slower logarithm estimator. It should be improved.

117−

118−-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,

119−-- and returns a list of digits and an exponent.

120−-- In particular, if @x>=0@, and

121−--

122−-- > floatToDigits base x = ([d1,d2,...,dn], e)

123−--

124−-- then

125−--

126−-- (1) @n >= 1@

127−--

128−-- (2) @x = 0.d1d2...dn * (base**e)@

129−--

130−-- (3) @0 <= di <= base-1@

131−

132−floatToDigits :: (RealFloat a) => a -> ([Int], Int)

133−{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}

134−{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}

135−floatToDigits 0 = ([0], 0)

136−floatToDigits x =

137− let

138− (f0, e0) = decodeFloat x

139− (minExp0, _) = floatRange x

140− p = floatDigits x

141− b = floatRadix x

142− minExp = minExp0 - p -- the real minimum exponent

143− -- Haskell requires that f be adjusted so denormalized numbers

144− -- will have an impossibly low exponent. Adjust for this.

145− (f, e) =

146− let n = minExp - e0 in

147− if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)

148− (r, s, mUp, mDn) =

149− if e >= 0 then

150− let be = expt b e in

151− if f == expt b (p-1) then

152− (f*be*b*2, 2*b, be*b, be) -- according to Burger and Dybvig

153− else

154− (f*be*2, 2, be, be)

155− else

156− if e > minExp && f == expt b (p-1) then

157− (f*b*2, expt b (-e+1)*2, b, 1)

158− else

159− (f*2, expt b (-e)*2, 1, 1)

160− k :: Int

161− k =

162− let

163− k0 :: Int

164− k0 =

165− if b == 2 then

166− -- logBase 10 2 is very slightly larger than 8651/28738

167− -- (about 5.3558e-10), so if log x >= 0, the approximation

168− -- k1 is too small, hence we add one and need one fixup step less.

169− -- If log x < 0, the approximation errs rather on the high side.

170− -- That is usually more than compensated for by ignoring the

171− -- fractional part of logBase 2 x, but when x is a power of 1/2

172− -- or slightly larger and the exponent is a multiple of the

173− -- denominator of the rational approximation to logBase 10 2,

174− -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,

175− -- we get a leading zero-digit we don't want.

176− -- With the approximation 3/10, this happened for

177− -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.

178− -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x

179− -- for IEEE-ish floating point types with exponent fields

180− -- <= 17 bits and mantissae of several thousand bits, earlier

181− -- convergents to logBase 10 2 would fail for long double.

182− -- Using quot instead of div is a little faster and requires

183− -- fewer fixup steps for negative lx.

184− let lx = p - 1 + e0

185− k1 = (lx * 8651) `quot` 28738

186− in if lx >= 0 then k1 + 1 else k1

187− else

188− -- f :: Integer, log :: Float -> Float,

189− -- ceiling :: Float -> Int

190− ceiling ((log (fromInteger (f+1) :: Float) +

191− fromIntegral e * log (fromInteger b)) /

192− log 10)

193−--WAS: fromInt e * log (fromInteger b))

194−

195− fixup n =

196− if n >= 0 then

197− if r + mUp <= expt 10 n * s then n else fixup (n+1)

198− else

199− if expt 10 (-n) * (r + mUp) <= s then n else fixup (n+1)

200− in

201− fixup k0

202−

203− gen ds rn sN mUpN mDnN =

204− let

205− (dn, rn') = (rn * 10) `quotRem` sN

206− mUpN' = mUpN * 10

207− mDnN' = mDnN * 10

208− in

209− case (rn' < mDnN', rn' + mUpN' > sN) of

210− (True, False) -> dn : ds

211− (False, True) -> dn+1 : ds

212− (True, True) -> if rn' * 2 < sN then dn : ds else dn+1 : ds

213− (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'

214−

215− rds =

216− if k >= 0 then

217− gen [] r (s * expt 10 k) mUp mDn

218− else

219− let bk = expt 10 (-k) in

220− gen [] (r * bk) s (mUp * bk) (mDn * bk)

221− in

222− (map fromIntegral (reverse rds), k)

223−

224−-- Exponentiation with a cache for the most common numbers.

225−minExpt, maxExpt :: Int

226−minExpt = 0

227−maxExpt = 1100

228−

229−expt :: Integer -> Int -> Integer

230−expt base n

231− | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n

232− | base == 10 && n <= maxExpt10 = expts10 `unsafeAt` n

233− | otherwise = base^n

234−

235−expts :: Array Int Integer

236−expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]

237−

238−maxExpt10 :: Int

239−maxExpt10 = 324

240−

241−expts10 :: Array Int Integer

242−expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]

Data/Text/Lazy/Encoding.hs+30−215

@@ -1,240 +1,55 @@

1−{-# LANGUAGE BangPatterns,CPP #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-}

4−#endif

51-- |

62-- Module : Data.Text.Lazy.Encoding

3+-- Copyright : (c) Bryan O'Sullivan 2009

84--

95-- License : BSD-style

10−-- Maintainer : bos@serpentine.com

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

7+-- duncan@haskell.org

118-- Stability : experimental

129-- Portability : portable

1310--

1411-- Functions for converting lazy 'Text' values to and from lazy

1512-- 'ByteString', using several standard encodings.

1613--

17−-- To gain access to a much larger variety of encodings, use the

18−-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>

14+-- To make use of a much larger variety of encodings, use the @text-icu@

15+-- package.

1916

2017module Data.Text.Lazy.Encoding

2118 (

2219 -- * Decoding ByteStrings to Text

23− -- $strict

24− decodeASCII

25− , decodeLatin1

26− , decodeUtf8

27− , decodeUtf16LE

28− , decodeUtf16BE

29− , decodeUtf32LE

30− , decodeUtf32BE

31−

32− -- ** Catchable failure

33− , decodeUtf8'

34−

35− -- ** Controllable error handling

20+ -- decodeASCII

21+ decodeUtf8

3622 , decodeUtf8With

37− , decodeUtf16LEWith

38− , decodeUtf16BEWith

39− , decodeUtf32LEWith

40− , decodeUtf32BEWith

23+ --, decodeUtf16LE

24+ --, decodeUtf16BE

25+ --, decodeUtf32LE

26+ --, decodeUtf32BE

4127

4228 -- * Encoding Text to ByteStrings

4329 , encodeUtf8

44− , encodeUtf16LE

45− , encodeUtf16BE

46− , encodeUtf32LE

47− , encodeUtf32BE

48−

49− -- * Encoding Text using ByteString Builders

50− , encodeUtf8Builder

51− , encodeUtf8BuilderEscaped

30+ --, encodeUtf16LE

31+ --, encodeUtf16BE

32+ --, encodeUtf32LE

33+ --, encodeUtf32BE

5234 ) where

5335

54−import Control.Exception (evaluate, try)

55−import Data.Monoid (Monoid(..))

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

57−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)

58−import Data.Word (Word8)

59−import 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

63−import qualified Data.ByteString.Lazy as B

64−import qualified Data.ByteString.Lazy.Internal as B

65−import qualified Data.ByteString.Unsafe as B

66−import qualified Data.Text as T

67−import 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)

71−

72−-- $strict

73−--

74−-- All of the single-parameter functions for decoding bytestrings

75−-- encoded in one of the Unicode Transformation Formats (UTF) operate

76−-- in a /strict/ mode: each will throw an exception if given invalid

77−-- input.

78−--

79−-- Each function has a variant, whose name is suffixed with -'With',

80−-- that gives greater control over the handling of decoding errors.

81−-- For instance, 'decodeUtf8' will throw an exception, but

82−-- 'decodeUtf8With' allows the programmer to determine what to do on a

83−-- decoding error.

84−

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

86−-- encoded text.

87−decodeASCII :: B.ByteString -> Text

88−decodeASCII = decodeUtf8

89−{-# DEPRECATED decodeASCII "Use decodeUtf8 instead" #-}

90−

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

36+import Data.ByteString.Lazy (ByteString)

37+import Data.Text.Encoding.Error (OnDecodeError, strictDecode)

38+import Data.Text.Lazy (Text)

39+import qualified Data.Text.Lazy.Fusion as F

40+import qualified Data.Text.Lazy.Encoding.Fusion as E

9441

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

96−decodeUtf8With :: 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)

100− 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

109− desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"

110−decodeUtf8With _ _ = empty

43+decodeUtf8With :: OnDecodeError -> ByteString -> Text

44+decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)

45+{-# INLINE decodeUtf8With #-}

11146

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

113−-- to be valid.

114−--

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

116−-- thrown that cannot be caught in pure code. For more control over

117−-- the handling of invalid data, use 'decodeUtf8'' or

118−-- 'decodeUtf8With'.

119−decodeUtf8 :: B.ByteString -> Text

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

48+decodeUtf8 :: ByteString -> Text

12049decodeUtf8 = decodeUtf8With strictDecode

121−{-# INLINE[0] decodeUtf8 #-}

122−

123−-- This rule seems to cause performance loss.

124−{- RULES "LAZY STREAM stream/decodeUtf8' fusion" [1]

125− forall bs. F.stream (decodeUtf8' bs) = E.streamUtf8 strictDecode bs #-}

126−

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

128−--

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

130−-- exception will be returned, otherwise the decoded text.

131−--

132−-- /Note/: this function is /not/ lazy, as it must decode its entire

133−-- input before it can return a result. If you need lazy (streaming)

134−-- decoding, use 'decodeUtf8With' in lenient mode.

135−decodeUtf8' :: B.ByteString -> Either UnicodeException Text

136−decodeUtf8' bs = unsafeDupablePerformIO $ do

137− let t = decodeUtf8 bs

138− try (evaluate (rnf t `seq` t))

139− where

140− rnf Empty = ()

141− rnf (Chunk _ ts) = rnf ts

142−{-# INLINE decodeUtf8' #-}

143−

144−encodeUtf8 :: 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

165−

166−-- | Decode text from little endian UTF-16 encoding.

167−decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text

168−decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)

169−{-# INLINE decodeUtf16LEWith #-}

170−

171−-- | Decode text from little endian UTF-16 encoding.

172−--

173−-- If the input contains any invalid little endian UTF-16 data, an

174−-- exception will be thrown. For more control over the handling of

175−-- invalid data, use 'decodeUtf16LEWith'.

176−decodeUtf16LE :: B.ByteString -> Text

177−decodeUtf16LE = decodeUtf16LEWith strictDecode

178−{-# INLINE decodeUtf16LE #-}

179−

180−-- | Decode text from big endian UTF-16 encoding.

181−decodeUtf16BEWith :: OnDecodeError -> B.ByteString -> Text

182−decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)

183−{-# INLINE decodeUtf16BEWith #-}

184−

185−-- | Decode text from big endian UTF-16 encoding.

186−--

187−-- If the input contains any invalid big endian UTF-16 data, an

188−-- exception will be thrown. For more control over the handling of

189−-- invalid data, use 'decodeUtf16BEWith'.

190−decodeUtf16BE :: B.ByteString -> Text

191−decodeUtf16BE = decodeUtf16BEWith strictDecode

192−{-# INLINE decodeUtf16BE #-}

193−

194−-- | Encode text using little endian UTF-16 encoding.

195−encodeUtf16LE :: Text -> B.ByteString

196−encodeUtf16LE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf16LE) [] txt)

197−{-# INLINE encodeUtf16LE #-}

198−

199−-- | Encode text using big endian UTF-16 encoding.

200−encodeUtf16BE :: Text -> B.ByteString

201−encodeUtf16BE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf16BE) [] txt)

202−{-# INLINE encodeUtf16BE #-}

203−

204−-- | Decode text from little endian UTF-32 encoding.

205−decodeUtf32LEWith :: OnDecodeError -> B.ByteString -> Text

206−decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)

207−{-# INLINE decodeUtf32LEWith #-}

208−

209−-- | Decode text from little endian UTF-32 encoding.

210−--

211−-- If the input contains any invalid little endian UTF-32 data, an

212−-- exception will be thrown. For more control over the handling of

213−-- invalid data, use 'decodeUtf32LEWith'.

214−decodeUtf32LE :: B.ByteString -> Text

215−decodeUtf32LE = decodeUtf32LEWith strictDecode

216−{-# INLINE decodeUtf32LE #-}

217−

218−-- | Decode text from big endian UTF-32 encoding.

219−decodeUtf32BEWith :: OnDecodeError -> B.ByteString -> Text

220−decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)

221−{-# INLINE decodeUtf32BEWith #-}

222−

223−-- | Decode text from big endian UTF-32 encoding.

224−--

225−-- If the input contains any invalid big endian UTF-32 data, an

226−-- exception will be thrown. For more control over the handling of

227−-- invalid data, use 'decodeUtf32BEWith'.

228−decodeUtf32BE :: B.ByteString -> Text

229−decodeUtf32BE = decodeUtf32BEWith strictDecode

230−{-# INLINE decodeUtf32BE #-}

231−

232−-- | Encode text using little endian UTF-32 encoding.

233−encodeUtf32LE :: Text -> B.ByteString

234−encodeUtf32LE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf32LE) [] txt)

235−{-# INLINE encodeUtf32LE #-}

50+{-# INLINE decodeUtf8 #-}

23651

237−-- | Encode text using big endian UTF-32 encoding.

238−encodeUtf32BE :: Text -> B.ByteString

239−encodeUtf32BE txt = B.fromChunks (foldrChunks ((:) . TE.encodeUtf32BE) [] txt)

240−{-# INLINE encodeUtf32BE #-}

52+-- | Encode text using UTF-8 encoding.

53+encodeUtf8 :: Text -> ByteString

54+encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))

55+{-# INLINE encodeUtf8 #-}

Data/Text/Lazy/Encoding/Fusion.hsnew file+150

@@ -0,0 +1,150 @@

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

2+

3+-- |

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

5+-- Copyright : (c) Bryan O'Sullivan 2009

6+--

7+-- License : BSD-style

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

9+-- duncan@haskell.org

10+-- Stability : experimental

11+-- Portability : portable

12+--

13+-- Fusible 'Stream'-oriented functions for converting between lazy

14+-- 'Text' and several common encodings.

15+

16+module Data.Text.Lazy.Encoding.Fusion

17+ (

18+ -- * Streaming

19+ -- streamASCII

20+ streamUtf8

21+ --, streamUtf16LE

22+ --, streamUtf16BE

23+ --, streamUtf32LE

24+ --, streamUtf32BE

25+

26+ -- * Unstreaming

27+ , unstream

28+

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

30+ ) where

31+

32+import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)

33+import qualified Data.ByteString as B

34+import qualified Data.ByteString.Unsafe as B

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

36+import Data.Text.Encoding.Error

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

38+import Data.Text.Fusion.Size

39+import Data.Text.UnsafeChar (unsafeChr8)

40+import Data.Word (Word8)

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

42+import System.IO.Unsafe (unsafePerformIO)

43+import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

44+import Foreign.Storable (pokeByteOff)

45+import Data.ByteString.Internal (mallocByteString, memcpy)

46+#if defined(ASSERTS)

47+import Control.Exception (assert)

48+#endif

49+import qualified Data.ByteString.Internal as B

50+

51+data S = S0

52+ | S1 {-# UNPACK #-} !Word8

53+ | S2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

54+ | S3 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

55+ | S4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

56+

57+data T = T {-# UNPACK #-} !ByteString {-# UNPACK #-} !S {-# UNPACK #-} !Int

58+

59+-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using

60+-- UTF-8 encoding.

61+streamUtf8 :: OnDecodeError -> ByteString -> Stream Char

62+streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize

63+ where

64+ next (T bs@(Chunk ps _) S0 i)

65+ | i < len && U8.validate1 a =

66+ Yield (unsafeChr8 a) (T bs S0 (i+1))

67+ | i + 1 < len && U8.validate2 a b =

68+ Yield (U8.chr2 a b) (T bs S0 (i+2))

69+ | i + 2 < len && U8.validate3 a b c =

70+ Yield (U8.chr3 a b c) (T bs S0 (i+3))

71+ | i + 4 < len && U8.validate4 a b c d =

72+ Yield (U8.chr4 a b c d) (T bs S0 (i+4))

73+ where len = B.length ps

74+ a = B.unsafeIndex ps i

75+ b = B.unsafeIndex ps (i+1)

76+ c = B.unsafeIndex ps (i+2)

77+ d = B.unsafeIndex ps (i+3)

78+ next st@(T bs s i) =

79+ case s of

80+ S1 a | U8.validate1 a -> Yield (unsafeChr8 a) es

81+ S2 a b | U8.validate2 a b -> Yield (U8.chr2 a b) es

82+ S3 a b c | U8.validate3 a b c -> Yield (U8.chr3 a b c) es

83+ S4 a b c d | U8.validate4 a b c d -> Yield (U8.chr4 a b c d) es

84+ _ -> consume st

85+ where es = T bs S0 i

86+ consume (T bs@(Chunk ps rest) s i)

87+ | i >= B.length ps = consume (T rest s 0)

88+ | otherwise =

89+ case s of

90+ S0 -> next (T bs (S1 x) (i+1))

91+ S1 a -> next (T bs (S2 a x) (i+1))

92+ S2 a b -> next (T bs (S3 a b x) (i+1))

93+ S3 a b c -> next (T bs (S4 a b c x) (i+1))

94+ S4 a b c d -> decodeError "streamUtf8" "UTF-8" onErr (Just a)

95+ (T bs (S3 b c d) (i+1))

96+ where x = B.unsafeIndex ps i

97+ consume (T Empty S0 _) = Done

98+ consume st = decodeError "streamUtf8" "UTF-8" onErr Nothing st

99+{-# INLINE [0] streamUtf8 #-}

100+

101+-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.

102+unstreamChunks :: Int -> Stream Word8 -> ByteString

103+unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)

104+ where chunk s1 len1 = unsafePerformIO $ do

105+ let len = max 4 (min len1 chunkSize)

106+ mallocByteString len >>= loop len 0 s1

107+ where

108+ loop !n !off !s fp = case next s of

109+ Done | off == 0 -> return Empty

110+ | otherwise -> return $! Chunk (trimUp fp off) Empty

111+ Skip s' -> loop n off s' fp

112+ Yield x s'

113+ | off == chunkSize -> do

114+ let !newLen = n - off

115+ return $! Chunk (trimUp fp off) (chunk s newLen)

116+ | off == n -> realloc fp n off s' x

117+ | otherwise -> do

118+ withForeignPtr fp $ \p -> pokeByteOff p off x

119+ loop n (off+1) s' fp

120+ {-# NOINLINE realloc #-}

121+ realloc fp n off s x = do

122+ let n' = min (n+n) chunkSize

123+ fp' <- copy0 fp n n'

124+ withForeignPtr fp' $ \p -> pokeByteOff p off x

125+ loop n' (off+1) s fp'

126+ trimUp fp off = B.PS fp 0 off

127+ copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)

128+ copy0 !src !srcLen !destLen =

129+#if defined(ASSERTS)

130+ assert (srcLen <= destLen) $

131+#endif

132+ do

133+ dest <- mallocByteString destLen

134+ withForeignPtr src $ \src' ->

135+ withForeignPtr dest $ \dest' ->

136+ memcpy dest' src' (fromIntegral srcLen)

137+ return dest

138+

139+-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.

140+unstream :: Stream Word8 -> ByteString

141+unstream = unstreamChunks defaultChunkSize

142+

143+decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8

144+ -> s -> Step s Char

145+decodeError func kind onErr mb i =

146+ case onErr desc mb of

147+ Nothing -> Skip i

148+ Just c -> Yield c i

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

150+ kind ++ " stream"

Data/Text/Lazy/Fusion.hsnew file+110

@@ -0,0 +1,110 @@

1+-- |

2+-- Module : Data.Text.Lazy.Fusion

3+-- Copyright : (c) Bryan O'Sullivan 2009

4+--

5+-- License : BSD-style

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

7+-- duncan@haskell.org

8+-- Stability : experimental

9+-- Portability : GHC

10+--

11+-- Core stream fusion functionality for text.

12+

13+module Data.Text.Lazy.Fusion

14+ (

15+ stream

16+ , unstream

17+ , unstreamChunks

18+ , length

19+ , unfoldrN

20+ , index

21+ , countChar

22+ ) where

23+

24+import Prelude hiding (length)

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

26+import Data.Text.Fusion.Internal

27+import Data.Text.Fusion.Size (isEmpty)

28+import Data.Text.Lazy.Internal

29+import qualified Data.Text.Internal as I

30+import qualified Data.Text.Array as A

31+import Data.Text.UnsafeChar (unsafeWrite)

32+import Data.Text.UnsafeShift (shiftL)

33+import Data.Text.Unsafe (iter)

34+import Data.Int (Int64)

35+

36+default(Int64)

37+

38+-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.

39+stream :: Text -> Stream Char

40+stream text = Stream next (text :*: 0) 4 -- random HINT

41+ where

42+ next (Empty :*: _) = Done

43+ next (txt@(Chunk t@(I.Text _ _ len) ts) :*: i)

44+ | i >= len = next (ts :*: 0)

45+ | otherwise = Yield c (txt :*: i+d)

46+ where (c,d) = iter t i

47+{-# INLINE [0] stream #-}

48+

49+-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given

50+-- chunk size.

51+unstreamChunks :: Int -> Stream Char -> Text

52+unstreamChunks chunkSize (Stream next s0 len0)

53+ | isEmpty len0 = Empty

54+ | otherwise = outer s0

55+ where

56+ outer s = case next s of

57+ Done -> Empty

58+ Skip s' -> outer s'

59+ Yield x s' -> I.Text arr 0 len `chunk` outer s''

60+ where (arr,(s'',len)) = A.run2 fill

61+ fill = do a <- A.unsafeNew unknownLength

62+ i <- unsafeWrite a 0 x

63+ inner a unknownLength s' i

64+ unknownLength = 4

65+ inner marr len s i

66+ | i + 1 >= chunkSize = return (marr, (s,i))

67+ | i + 1 >= len = do

68+ let newLen = min (len `shiftL` 1) chunkSize

69+ marr' <- A.unsafeNew newLen

70+ A.copy marr marr'

71+ inner marr' newLen s i

72+ | otherwise =

73+ case next s of

74+ Done -> return (marr,(s,i))

75+ Skip s' -> inner marr len s' i

76+ Yield x s' -> unsafeWrite marr i x >>= inner marr len s'

77+{-# INLINE [0] unstreamChunks #-}

78+

79+-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using

80+-- 'defaultChunkSize'.

81+unstream :: Stream Char -> Text

82+unstream = unstreamChunks defaultChunkSize

83+{-# INLINE [0] unstream #-}

84+

85+-- | /O(n)/ Returns the number of characters in a text.

86+length :: Stream Char -> Int64

87+length = S.lengthI

88+{-# INLINE[0] length #-}

89+

90+{-# RULES "LAZY STREAM stream/unstream fusion" forall s.

91+ stream (unstream s) = s #-}

92+

93+-- | /O(n)/ Like 'unfoldr', 'unfoldrN64' builds a stream from a seed

94+-- value. However, the length of the result is limited by the

95+-- first argument to 'unfoldrN64'. This function is more efficient than

96+-- 'unfoldr' when the length of the result is known.

97+unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char

98+unfoldrN n = S.unfoldrNI n

99+{-# INLINE [0] unfoldrN #-}

100+

101+-- | /O(n)/ stream index (subscript) operator, starting from 0.

102+index :: Stream Char -> Int64 -> Char

103+index = S.indexI

104+{-# INLINE [0] index #-}

105+

106+-- | /O(n)/ The 'count' function returns the number of times the query

107+-- element appears in the given stream.

108+countChar :: Char -> Stream Char -> Int64

109+countChar = S.countCharI

110+{-# INLINE [0] countChar #-}

Data/Text/Lazy/IO.hs+28−49

@@ -1,26 +1,17 @@

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

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-}

4−#endif

52-- |

63-- Module : Data.Text.Lazy.IO

4+-- Copyright : (c) Bryan O'Sullivan 2009,

5+-- (c) Simon Marlow 2009

96-- License : BSD-style

107-- Maintainer : bos@serpentine.com

118-- Stability : experimental

129-- Portability : GHC

1310--

1411-- Efficient locale-sensitive support for lazy text I\/O.

15−--

16−-- Skip past the synopsis for some important notes on performance and

17−-- portability across different versions of GHC.

1812

1913module Data.Text.Lazy.IO

2014 (

21− -- * Performance

22− -- $performance

23−

2415 -- * Locale support

2516 -- $locale

2617 -- * File-at-a-time operations

@@ -41,40 +32,29 @@ module Data.Text.Lazy.IO

4132 ) where

4233

4334import Data.Text.Lazy (Text)

44−import Prelude hiding (appendFile, getContents, getLine, interact,

45− putStr, putStrLn, readFile, writeFile)

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

36+ putStrLn, readFile, writeFile)

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

4738 withFile)

4839import qualified Data.Text.IO as T

4940import qualified Data.Text.Lazy as L

50−import qualified Control.Exception as E

51−import Control.Monad (when)

41+#if __GLASGOW_HASKELL__ <= 610

42+import Data.Text.Lazy.Encoding (decodeUtf8)

43+import qualified Data.ByteString.Char8 as S8

44+import qualified Data.ByteString.Lazy.Char8 as L8

45+#else

46+import Control.Exception (throw)

5247import Data.IORef (readIORef)

53−import Data.Text.Internal.IO (hGetLineWith, readChunk)

54−import Data.Text.Internal.Lazy (chunk, empty)

48+import Data.Text.IO.Internal (hGetLineWith, readChunk)

49+import Data.Text.Lazy.Internal (chunk, empty)

5550import GHC.IO.Buffer (isEmptyBuffer)

5651import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)

5752import GHC.IO.Handle.Internals (augmentIOError, hClose_help,

5853 wantReadableHandle, withHandle)

5954import GHC.IO.Handle.Types (Handle__(..), HandleType(..))

60−import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)

6155import System.IO.Error (isEOFError)

6256import System.IO.Unsafe (unsafeInterleaveIO)

63−

64−-- $performance

65−--

66−-- The functions in this module obey the runtime system's locale,

67−-- character set encoding, and line ending conversion settings.

68−--

69−-- If you know in advance that you will be working with data that has

70−-- a specific encoding (e.g. UTF-8), and your application is highly

71−-- performance sensitive, you may find that it is faster to perform

72−-- I\/O with bytestrings and to encode and decode yourself than to use

73−-- the functions in this module.

74−--

75−-- Whether this will hold depends on the version of GHC you are using,

76−-- the platform you are working on, the data you are working with, and

77−-- the encodings you are using, so be sure to test for yourself.

57+#endif

7858

7959-- | Read a file and return its contents as a string. The file is

8060-- read lazily, as with 'getContents'.

@@ -93,19 +73,13 @@ appendFile p = withFile p AppendMode . flip hPutStr

9373-- | Lazily read the remaining contents of a 'Handle'. The 'Handle'

9474-- will be closed after the read completes, or on error.

9575hGetContents :: Handle -> IO Text

96−hGetContents h = do

97− chooseGoodBuffering h

98− wantReadableHandle "hGetContents" h $ \hh -> do

99− ts <- lazyRead h

100− return (hh{haType=SemiClosedHandle}, ts)

101−

102−-- | Use a more efficient buffer size if we're reading in

103−-- block-buffered mode with the default buffer size.

104−chooseGoodBuffering :: Handle -> IO ()

105−chooseGoodBuffering h = do

106− bufMode <- hGetBuffering h

107− when (bufMode == BlockBuffering Nothing) $

108− hSetBuffering h (BlockBuffering (Just 16384))

76+#if __GLASGOW_HASKELL__ <= 610

77+hGetContents = fmap decodeUtf8 . L8.hGetContents

78+#else

79+hGetContents h =

80+ wantReadableHandle "hGetContents" h $ \hh -> do

81+ ts <- lazyRead h

82+ return (hh{haType=SemiClosedHandle}, ts)

10983

11084lazyRead :: Handle -> IO Text

11185lazyRead h = unsafeInterleaveIO $

@@ -113,7 +87,7 @@ lazyRead h = unsafeInterleaveIO $

11387 case haType hh of

11488 ClosedHandle -> return (hh, L.empty)

11589 SemiClosedHandle -> lazyReadBuffered h hh

116− _ -> ioException

90+ _ -> ioException

11791 (IOError (Just h) IllegalOperation "hGetContents"

11892 "illegal handle type" Nothing Nothing)

11993

@@ -122,17 +96,22 @@ lazyReadBuffered h hh@Handle__{..} = do

12296 buf <- readIORef haCharBuffer

12397 (do t <- readChunk hh buf

12498 ts <- lazyRead h

125− return (hh, chunk t ts)) `E.catch` \e -> do

99+ return (hh, chunk t ts)) `catch` \e -> do

126100 (hh', _) <- hClose_help hh

127101 if isEOFError e

128102 then return $ if isEmptyBuffer buf

129103 then (hh', empty)

130104 else (hh', L.singleton '\r')

131− else E.throwIO (augmentIOError e "hGetContents" h)

105+ else throw (augmentIOError e "hGetContents" h)

106+#endif

132107

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

134109hGetLine :: Handle -> IO Text

110+#if __GLASGOW_HASKELL__ <= 610

111+hGetLine = fmap (decodeUtf8 . L8.fromChunks . (:[])) . S8.hGetLine

112+#else

135113hGetLine = hGetLineWith L.fromChunks

114+#endif

136115

137116-- | Write a string to a handle.

138117hPutStr :: Handle -> Text -> IO ()

Data/Text/Lazy/Internal.hs+92−9

@@ -1,20 +1,103 @@

11{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}

22-- |

33-- Module : Data.Text.Lazy.Internal

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

10−--

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.

13−

11+--

12+-- A module containing semi-public '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.

15+-- Regular users should not.

1416module Data.Text.Lazy.Internal

15− {-# DEPRECATED "Use Data.Text.Internal.Lazy instead" #-}

1617 (

17− module Data.Text.Internal.Lazy

18+ Text(..)

19+ , chunk

20+ , empty

21+ , foldrChunks

22+ , foldlChunks

23+ -- * Data type invariant and abstraction functions

24+ , invariant

25+ , checkInvariant

26+ , showStructure

27+ -- * Chunk allocation sizes

28+ , defaultChunkSize

29+ , smallChunkSize

30+ , chunkOverhead

1831 ) where

1932

20−import Data.Text.Internal.Lazy

33+import qualified Data.Text.Internal as T

34+import Data.Text ()

35+import Data.Text.UnsafeShift

36+import Data.Typeable (Typeable)

37+import Foreign.Storable (sizeOf)

38+

39+data Text = Empty

40+ | Chunk {-# UNPACK #-} !T.Text Text

41+ deriving (Typeable)

42+

43+-- | The data type invariant: Every 'Text' is either 'Empty' or

44+-- consists of non-null 'T.Text's. All functions must preserve this,

45+-- and the QC properties must check this.

46+invariant :: Text -> Bool

47+invariant Empty = True

48+invariant (Chunk (T.Text _ _ len) cs) = len > 0 && invariant cs

49+

50+showStructure :: Text -> String

51+showStructure Empty = "Empty"

52+showStructure (Chunk t Empty) = "Chunk " ++ show t ++ " Empty"

53+showStructure (Chunk t ts) =

54+ "Chunk " ++ show t ++ " (" ++ showStructure ts ++ ")"

55+

56+-- | In a form that checks the invariant lazily.

57+checkInvariant :: Text -> Text

58+checkInvariant Empty = Empty

59+checkInvariant (Chunk c@(T.Text _ _ len) cs)

60+ | len > 0 = Chunk c (checkInvariant cs)

61+ | otherwise = error $ "Data.Text.Lazy: invariant violation: "

62+ ++ showStructure (Chunk c cs)

63+

64+-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.

65+chunk :: T.Text -> Text -> Text

66+{-# INLINE chunk #-}

67+chunk t@(T.Text _ _ len) ts | len == 0 = ts

68+ | otherwise = Chunk t ts

69+

70+-- | Smart constructor for 'Empty'.

71+empty :: Text

72+{-# INLINE [0] empty #-}

73+empty = Empty

74+

75+-- | Consume the chunks of a lazy 'Text' with a natural right fold.

76+foldrChunks :: (T.Text -> a -> a) -> a -> Text -> a

77+foldrChunks f z = go

78+ where go Empty = z

79+ go (Chunk c cs) = f c (go cs)

80+{-# INLINE foldrChunks #-}

81+

82+-- | Consume the chunks of a lazy 'Text' with a strict, tail-recursive,

83+-- accumulating left fold.

84+foldlChunks :: (a -> T.Text -> a) -> a -> Text -> a

85+foldlChunks f z = go z

86+ where go !a Empty = a

87+ go !a (Chunk c cs) = go (f a c) cs

88+{-# INLINE foldlChunks #-}

89+

90+-- | Currently set to 32KB, less the memory management overhead.

91+defaultChunkSize :: Int

92+defaultChunkSize = 16384 - chunkOverhead

93+{-# INLINE defaultChunkSize #-}

94+

95+-- | Currently set to 256 bytes, less the memory management overhead.

96+smallChunkSize :: Int

97+smallChunkSize = 128 - chunkOverhead

98+{-# INLINE smallChunkSize #-}

99+

100+-- | The memory management overhead. Currently this is tuned for GHC only.

101+chunkOverhead :: Int

102+chunkOverhead = sizeOf (undefined :: Int) `shiftL` 1

103+{-# INLINE chunkOverhead #-}

Data/Text/Lazy/Read.hsdeleted−193

@@ -1,193 +0,0 @@

1−{-# LANGUAGE OverloadedStrings, CPP #-}

2−#if __GLASGOW_HASKELL__ >= 704

3−{-# LANGUAGE Safe #-}

4−#elif __GLASGOW_HASKELL__ >= 702

5−{-# LANGUAGE Trustworthy #-}

6−#endif

7−

8−-- |

9−-- Module : Data.Text.Lazy.Read

11−--

12−-- License : BSD-style

13−-- Maintainer : bos@serpentine.com

14−-- Stability : experimental

15−-- Portability : GHC

16−--

17−-- Functions used frequently when reading textual data.

18−module Data.Text.Lazy.Read

19− (

20− Reader

21− , decimal

22− , hexadecimal

23− , signed

24− , rational

25− , double

26− ) where

27−

28−import Control.Monad (liftM)

29−import Data.Char (isDigit, isHexDigit)

30−import Data.Int (Int8, Int16, Int32, Int64)

31−import Data.Ratio ((%))

32−import Data.Text.Internal.Read

33−import Data.Text.Lazy as T

34−import Data.Word (Word, Word8, Word16, Word32, Word64)

35−

36−-- | Read some text. If the read succeeds, return its value and the

37−-- remaining text, otherwise an error message.

38−type Reader a = IReader Text a

39−type Parser = IParser Text

40−

41−-- | Read a decimal integer. The input must begin with at least one

42−-- decimal digit, and is consumed until a non-digit or end of string

43−-- is reached.

44−--

45−-- This function does not handle leading sign characters. If you need

46−-- to handle signed input, use @'signed' 'decimal'@.

47−--

48−-- /Note/: For fixed-width integer types, this function does not

49−-- attempt to detect overflow, so a sufficiently long input may give

50−-- incorrect results. If you are worried about overflow, use

51−-- 'Integer' for your result type.

52−decimal :: Integral a => Reader a

53−{-# SPECIALIZE decimal :: Reader Int #-}

54−{-# SPECIALIZE decimal :: Reader Int8 #-}

55−{-# SPECIALIZE decimal :: Reader Int16 #-}

56−{-# SPECIALIZE decimal :: Reader Int32 #-}

57−{-# SPECIALIZE decimal :: Reader Int64 #-}

58−{-# SPECIALIZE decimal :: Reader Integer #-}

59−{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}

60−{-# SPECIALIZE decimal :: Reader Word8 #-}

61−{-# SPECIALIZE decimal :: Reader Word16 #-}

62−{-# SPECIALIZE decimal :: Reader Word32 #-}

63−{-# SPECIALIZE decimal :: Reader Word64 #-}

64−decimal txt

65− | T.null h = Left "input does not start with a digit"

66− | otherwise = Right (T.foldl' go 0 h, t)

67− where (h,t) = T.span isDigit txt

68− go n d = (n * 10 + fromIntegral (digitToInt d))

69−

70−-- | Read a hexadecimal integer, consisting of an optional leading

71−-- @\"0x\"@ followed by at least one decimal digit. Input is consumed

72−-- until a non-hex-digit or end of string is reached. This function

73−-- is case insensitive.

74−--

75−-- This function does not handle leading sign characters. If you need

76−-- to handle signed input, use @'signed' 'hexadecimal'@.

77−--

78−-- /Note/: For fixed-width integer types, this function does not

79−-- attempt to detect overflow, so a sufficiently long input may give

80−-- incorrect results. If you are worried about overflow, use

81−-- 'Integer' for your result type.

82−hexadecimal :: Integral a => Reader a

83−{-# SPECIALIZE hexadecimal :: Reader Int #-}

84−{-# SPECIALIZE hexadecimal :: Reader Integer #-}

85−hexadecimal txt

86− | h == "0x" || h == "0X" = hex t

87− | otherwise = hex txt

88− where (h,t) = T.splitAt 2 txt

89−

90−hex :: Integral a => Reader a

91−{-# SPECIALIZE hexadecimal :: Reader Int #-}

92−{-# SPECIALIZE hexadecimal :: Reader Int8 #-}

93−{-# SPECIALIZE hexadecimal :: Reader Int16 #-}

94−{-# SPECIALIZE hexadecimal :: Reader Int32 #-}

95−{-# SPECIALIZE hexadecimal :: Reader Int64 #-}

96−{-# SPECIALIZE hexadecimal :: Reader Integer #-}

97−{-# SPECIALIZE hexadecimal :: Reader Word #-}

98−{-# SPECIALIZE hexadecimal :: Reader Word8 #-}

99−{-# SPECIALIZE hexadecimal :: Reader Word16 #-}

100−{-# SPECIALIZE hexadecimal :: Reader Word32 #-}

101−{-# SPECIALIZE hexadecimal :: Reader Word64 #-}

102−hex txt

103− | T.null h = Left "input does not start with a hexadecimal digit"

104− | otherwise = Right (T.foldl' go 0 h, t)

105− where (h,t) = T.span isHexDigit txt

106− go n d = (n * 16 + fromIntegral (hexDigitToInt d))

107−

108−-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and

109−-- apply it to the result of applying the given reader.

110−signed :: Num a => Reader a -> Reader a

111−{-# INLINE signed #-}

112−signed f = runP (signa (P f))

113−

114−-- | Read a rational number.

115−--

116−-- This function accepts an optional leading sign character, followed

117−-- by at least one decimal digit. The syntax similar to that accepted

118−-- by the 'read' function, with the exception that a trailing @\'.\'@

119−-- or @\'e\'@ /not/ followed by a number is not consumed.

120−--

121−-- Examples:

122−--

123−-- >rational "3" == Right (3.0, "")

124−-- >rational "3.1" == Right (3.1, "")

125−-- >rational "3e4" == Right (30000.0, "")

126−-- >rational "3.1e4" == Right (31000.0, "")

127−-- >rational ".3" == Left "input does not start with a digit"

128−-- >rational "e3" == Left "input does not start with a digit"

129−--

130−-- Examples of differences from 'read':

131−--

132−-- >rational "3.foo" == Right (3.0, ".foo")

133−-- >rational "3e" == Right (3.0, "e")

134−rational :: Fractional a => Reader a

135−{-# SPECIALIZE rational :: Reader Double #-}

136−rational = floaty $ \real frac fracDenom -> fromRational $

137− real % 1 + frac % fracDenom

138−

139−-- | Read a rational number.

140−--

141−-- The syntax accepted by this function is the same as for 'rational'.

142−--

143−-- /Note/: This function is almost ten times faster than 'rational',

144−-- but is slightly less accurate.

145−--

146−-- The 'Double' type supports about 16 decimal places of accuracy.

147−-- For 94.2% of numbers, this function and 'rational' give identical

148−-- results, but for the remaining 5.8%, this function loses precision

149−-- around the 15th decimal place. For 0.001% of numbers, this

150−-- function will lose precision at the 13th or 14th decimal place.

151−double :: Reader Double

152−double = floaty $ \real frac fracDenom ->

153− fromIntegral real +

154− fromIntegral frac / fromIntegral fracDenom

155−

156−signa :: Num a => Parser a -> Parser a

157−{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}

158−{-# SPECIALIZE signa :: Parser Int8 -> Parser Int8 #-}

159−{-# SPECIALIZE signa :: Parser Int16 -> Parser Int16 #-}

160−{-# SPECIALIZE signa :: Parser Int32 -> Parser Int32 #-}

161−{-# SPECIALIZE signa :: Parser Int64 -> Parser Int64 #-}

162−{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}

163−signa p = do

164− sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')

165− if sign == '+' then p else negate `liftM` p

166−

167−char :: (Char -> Bool) -> Parser Char

168−char p = P $ \t -> case T.uncons t of

169− Just (c,t') | p c -> Right (c,t')

170− _ -> Left "character does not match"

171−

172−floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a

173−{-# INLINE floaty #-}

174−floaty f = runP $ do

175− sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')

176− real <- P decimal

177− T fraction fracDigits <- perhaps (T 0 0) $ do

178− _ <- char (=='.')

179− digits <- P $ \t -> Right (fromIntegral . T.length $ T.takeWhile isDigit t, t)

180− n <- P decimal

181− return $ T n digits

182− let e c = c == 'e' || c == 'E'

183− power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)

184− let n = if fracDigits == 0

185− then if power == 0

186− then fromIntegral real

187− else fromIntegral real * (10 ^^ power)

188− else if power == 0

189− then f real fraction (10 ^ fracDigits)

190− else f real fraction (10 ^ fracDigits) * (10 ^^ power)

191− return $! if sign == '+'

192− then n

193− else -n

Data/Text/Internal/Lazy/Search.hs → Data/Text/Lazy/Search.hsrenamed+15−21

@@ -2,22 +2,19 @@

22

33-- |

44-- Module : Data.Text.Lazy.Search

5+-- 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 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@.

@@ -45,17 +42,15 @@ indices :: Text -- ^ Substring to search for (@needle@)

4542indices needle@(Chunk n ns) _haystack@(Chunk k ks)

4643 | nlen <= 0 = []

4744 | nlen == 1 = indicesOne (nindex 0) 0 k ks

48− | otherwise = advance k ks 0 0

45+ | otherwise = scan 0 0 k ks

4946 where

50− advance x@(T.Text _ _ l) xs = scan

51− where

52− scan !g !i

47+ scan !g !i x@(T.Text _ _ l) xs

5348 | i >= m = case xs of

5449 Empty -> []

55− Chunk y ys -> advance y ys g (i-m)

50+ Chunk y ys -> scan g (i-m) y ys

5651 | lackingHay (i + nlen) x xs = []

57− | c == z && candidateMatch 0 = g : scan (g+nlen) (i+nlen)

58− | otherwise = scan (g+delta) (i+delta)

52+ | c == z && candidateMatch 0 = g : scan (g+nlen) (i+nlen) x xs

53+ | otherwise = scan (g+delta) (i+delta) x xs

5954 where

6055 m = fromIntegral l

6156 c = hindex (i + nlast)

@@ -80,11 +75,10 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)

8075 go !(g::Int64) !i !msk !skp

8176 | i >= xlast = case xs of

8277 Empty -> (msk .|. swizzle z) :*: skp

83− Chunk y ys -> buildTable y ys g 0 msk' skp'

84− | otherwise = go (g+1) (i+1) msk' skp'

78+ Chunk y ys -> buildTable y ys g 0 msk skp

79+ | otherwise = go (g+1) (i+1) (msk .|. swizzle c) skp'

8580 where c = A.unsafeIndex xarr (xoff+i)

86− msk' = msk .|. swizzle c

87− skp' | c == z = nlen - g - 2

81+ skp' | c == z = nlen - fromIntegral g - 2

8882 | otherwise = skp

8983 xlast = xlen - 1

9084 -- | Check whether an attempt to index into the haystack at the

Data/Text/Read.hsdeleted−201

@@ -1,201 +0,0 @@

1−{-# LANGUAGE OverloadedStrings, UnboxedTuples, CPP #-}

2−#if __GLASGOW_HASKELL__ >= 702

3−{-# LANGUAGE Trustworthy #-}

4−#endif

5−

6−-- |

7−-- Module : Data.Text.Read

9−--

10−-- License : BSD-style

11−-- Maintainer : bos@serpentine.com

12−-- Stability : experimental

13−-- Portability : GHC

14−--

15−-- Functions used frequently when reading textual data.

16−module Data.Text.Read

17− (

18− Reader

19− , decimal

20− , hexadecimal

21− , signed

22− , rational

23− , double

24− ) where

25−

26−import Control.Monad (liftM)

27−import Data.Char (isDigit, isHexDigit)

28−import Data.Int (Int8, Int16, Int32, Int64)

29−import Data.Ratio ((%))

30−import Data.Text as T

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

32−import Data.Text.Internal.Read

33−import Data.Word (Word, Word8, Word16, Word32, Word64)

34−

35−-- | Read some text. If the read succeeds, return its value and the

36−-- remaining text, otherwise an error message.

37−type Reader a = IReader Text a

38−type Parser a = IParser Text a

39−

40−-- | Read a decimal integer. The input must begin with at least one

41−-- decimal digit, and is consumed until a non-digit or end of string

42−-- is reached.

43−--

44−-- This function does not handle leading sign characters. If you need

45−-- to handle signed input, use @'signed' 'decimal'@.

46−--

47−-- /Note/: For fixed-width integer types, this function does not

48−-- attempt to detect overflow, so a sufficiently long input may give

49−-- incorrect results. If you are worried about overflow, use

50−-- 'Integer' for your result type.

51−decimal :: Integral a => Reader a

52−{-# SPECIALIZE decimal :: Reader Int #-}

53−{-# SPECIALIZE decimal :: Reader Int8 #-}

54−{-# SPECIALIZE decimal :: Reader Int16 #-}

55−{-# SPECIALIZE decimal :: Reader Int32 #-}

56−{-# SPECIALIZE decimal :: Reader Int64 #-}

57−{-# SPECIALIZE decimal :: Reader Integer #-}

58−{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}

59−{-# SPECIALIZE decimal :: Reader Word8 #-}

60−{-# SPECIALIZE decimal :: Reader Word16 #-}

61−{-# SPECIALIZE decimal :: Reader Word32 #-}

62−{-# SPECIALIZE decimal :: Reader Word64 #-}

63−decimal txt

64− | T.null h = Left "input does not start with a digit"

65− | otherwise = Right (T.foldl' go 0 h, t)

66− where (# h,t #) = span_ isDigit txt

67− go n d = (n * 10 + fromIntegral (digitToInt d))

68−

69−-- | Read a hexadecimal integer, consisting of an optional leading

70−-- @\"0x\"@ followed by at least one decimal digit. Input is consumed

71−-- until a non-hex-digit or end of string is reached. This function

72−-- is case insensitive.

73−--

74−-- This function does not handle leading sign characters. If you need

75−-- to handle signed input, use @'signed' 'hexadecimal'@.

76−--

77−-- /Note/: For fixed-width integer types, this function does not

78−-- attempt to detect overflow, so a sufficiently long input may give

79−-- incorrect results. If you are worried about overflow, use

80−-- 'Integer' for your result type.

81−hexadecimal :: Integral a => Reader a

82−{-# SPECIALIZE hexadecimal :: Reader Int #-}

83−{-# SPECIALIZE hexadecimal :: Reader Int8 #-}

84−{-# SPECIALIZE hexadecimal :: Reader Int16 #-}

85−{-# SPECIALIZE hexadecimal :: Reader Int32 #-}

86−{-# SPECIALIZE hexadecimal :: Reader Int64 #-}

87−{-# SPECIALIZE hexadecimal :: Reader Integer #-}

88−{-# SPECIALIZE hexadecimal :: Reader Word #-}

89−{-# SPECIALIZE hexadecimal :: Reader Word8 #-}

90−{-# SPECIALIZE hexadecimal :: Reader Word16 #-}

91−{-# SPECIALIZE hexadecimal :: Reader Word32 #-}

92−{-# SPECIALIZE hexadecimal :: Reader Word64 #-}

93−hexadecimal txt

94− | h == "0x" || h == "0X" = hex t

95− | otherwise = hex txt

96− where (h,t) = T.splitAt 2 txt

97−

98−hex :: Integral a => Reader a

99−{-# SPECIALIZE hex :: Reader Int #-}

100−{-# SPECIALIZE hex :: Reader Int8 #-}

101−{-# SPECIALIZE hex :: Reader Int16 #-}

102−{-# SPECIALIZE hex :: Reader Int32 #-}

103−{-# SPECIALIZE hex :: Reader Int64 #-}

104−{-# SPECIALIZE hex :: Reader Integer #-}

105−{-# SPECIALIZE hex :: Reader Word #-}

106−{-# SPECIALIZE hex :: Reader Word8 #-}

107−{-# SPECIALIZE hex :: Reader Word16 #-}

108−{-# SPECIALIZE hex :: Reader Word32 #-}

109−{-# SPECIALIZE hex :: Reader Word64 #-}

110−hex txt

111− | T.null h = Left "input does not start with a hexadecimal digit"

112− | otherwise = Right (T.foldl' go 0 h, t)

113− where (# h,t #) = span_ isHexDigit txt

114− go n d = (n * 16 + fromIntegral (hexDigitToInt d))

115−

116−-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and

117−-- apply it to the result of applying the given reader.

118−signed :: Num a => Reader a -> Reader a

119−{-# INLINE signed #-}

120−signed f = runP (signa (P f))

121−

122−-- | Read a rational number.

123−--

124−-- This function accepts an optional leading sign character, followed

125−-- by at least one decimal digit. The syntax similar to that accepted

126−-- by the 'read' function, with the exception that a trailing @\'.\'@

127−-- or @\'e\'@ /not/ followed by a number is not consumed.

128−--

129−-- Examples (with behaviour identical to 'read'):

130−--

131−-- >rational "3" == Right (3.0, "")

132−-- >rational "3.1" == Right (3.1, "")

133−-- >rational "3e4" == Right (30000.0, "")

134−-- >rational "3.1e4" == Right (31000.0, "")

135−-- >rational ".3" == Left "input does not start with a digit"

136−-- >rational "e3" == Left "input does not start with a digit"

137−--

138−-- Examples of differences from 'read':

139−--

140−-- >rational "3.foo" == Right (3.0, ".foo")

141−-- >rational "3e" == Right (3.0, "e")

142−rational :: Fractional a => Reader a

143−{-# SPECIALIZE rational :: Reader Double #-}

144−rational = floaty $ \real frac fracDenom -> fromRational $

145− real % 1 + frac % fracDenom

146−

147−-- | Read a rational number.

148−--

149−-- The syntax accepted by this function is the same as for 'rational'.

150−--

151−-- /Note/: This function is almost ten times faster than 'rational',

152−-- but is slightly less accurate.

153−--

154−-- The 'Double' type supports about 16 decimal places of accuracy.

155−-- For 94.2% of numbers, this function and 'rational' give identical

156−-- results, but for the remaining 5.8%, this function loses precision

157−-- around the 15th decimal place. For 0.001% of numbers, this

158−-- function will lose precision at the 13th or 14th decimal place.

159−double :: Reader Double

160−double = floaty $ \real frac fracDenom ->

161− fromIntegral real +

162− fromIntegral frac / fromIntegral fracDenom

163−

164−signa :: Num a => Parser a -> Parser a

165−{-# SPECIALIZE signa :: Parser Int -> Parser Int #-}

166−{-# SPECIALIZE signa :: Parser Int8 -> Parser Int8 #-}

167−{-# SPECIALIZE signa :: Parser Int16 -> Parser Int16 #-}

168−{-# SPECIALIZE signa :: Parser Int32 -> Parser Int32 #-}

169−{-# SPECIALIZE signa :: Parser Int64 -> Parser Int64 #-}

170−{-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-}

171−signa p = do

172− sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')

173− if sign == '+' then p else negate `liftM` p

174−

175−char :: (Char -> Bool) -> Parser Char

176−char p = P $ \t -> case T.uncons t of

177− Just (c,t') | p c -> Right (c,t')

178− _ -> Left "character does not match"

179−

180−floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Reader a

181−{-# INLINE floaty #-}

182−floaty f = runP $ do

183− sign <- perhaps '+' $ char (\c -> c == '-' || c == '+')

184− real <- P decimal

185− T fraction fracDigits <- perhaps (T 0 0) $ do

186− _ <- char (=='.')

187− digits <- P $ \t -> Right (T.length $ T.takeWhile isDigit t, t)

188− n <- P decimal

189− return $ T n digits

190− let e c = c == 'e' || c == 'E'

191− power <- perhaps 0 (char e >> signa (P decimal) :: Parser Int)

192− let n = if fracDigits == 0

193− then if power == 0

194− then fromIntegral real

195− else fromIntegral real * (10 ^^ power)

196− else if power == 0

197− then f real fraction (10 ^ fracDigits)

198− else f real fraction (10 ^ fracDigits) * (10 ^^ power)

199− return $! if sign == '+'

200− then n

201− else -n

Data/Text/Internal/Search.hs → Data/Text/Search.hsrenamed+11−14

@@ -1,11 +1,12 @@

11{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}

22

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)/.

@@ -59,10 +58,9 @@ indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)

5958 z = nindex nlast

6059 nindex k = A.unsafeIndex narr (noff+k)

6160 hindex k = A.unsafeIndex harr (hoff+k)

62− hindex' k | k == hlen = 0

63− | otherwise = A.unsafeIndex harr (hoff+k)

61+ (mask :: Word64) :*: skip = buildTable 0 0 (nlen-2)

6462 buildTable !i !msk !skp

65− | i >= nlast = (msk .|. swizzle z) :* skp

63+ | i >= nlast = (msk .|. swizzle z) :*: skp

6664 | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'

6765 where c = nindex i

6866 skp' | c == z = nlen - i - 2

@@ -80,8 +78,7 @@ indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)

8078 delta | nextInPattern = nlen + 1

8179 | c == z = skip + 1

8280 | otherwise = 1

83− where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0

84− !(mask :* skip) = buildTable 0 0 (nlen-2)

81+ nextInPattern = mask .&. swizzle (hindex (i+nlen)) == 0

8582 scanOne c = loop 0

8683 where loop !i | i >= hlen = []

8784 | 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+44−44

@@ -1,9 +1,10 @@

11{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}

22-- |

33-- Module : Data.Text.Unsafe

4+-- Copyright : (c) Bryan O'Sullivan 2009

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,29 @@ module Data.Text.Unsafe

1314 (

1415 inlineInterleaveST

1516 , inlinePerformIO

16− , unsafeDupablePerformIO

17− , Iter(..)

1817 , iter

1918 , iter_

2019 , reverseIter

21− , reverseIter_

2220 , unsafeHead

2321 , unsafeTail

24− , lengthWord16

25− , takeWord16

26− , dropWord16

2722 ) where

28−

23+

2924#if defined(ASSERTS)

3025import Control.Exception (assert)

3126#endif

32−import Data.Text.Internal.Encoding.Utf16 (chr2)

27+import Data.Text.Encoding.Utf16 (chr2)

3328import Data.Text.Internal (Text(..))

34−import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)

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

29+import Data.Text.UnsafeChar (unsafeChr)

30+import GHC.ST (ST(..))

3631import qualified Data.Text.Array as A

37−import GHC.IO (unsafeDupablePerformIO)

32+#if defined(__GLASGOW_HASKELL__)

33+# if __GLASGOW_HASKELL__ >= 611

34+import GHC.IO (IO(IO))

35+# else

36+import GHC.IOBase (IO(IO))

37+# endif

38+import GHC.Base (realWorld#)

39+#endif

3840

3941-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'

4042-- omits the check for the empty case, so there is an obligation on

@@ -47,7 +49,7 @@ unsafeHead (Text arr off _len)

4749 n = A.unsafeIndex arr (off+1)

4850{-# INLINE unsafeHead #-}

4951

50−-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'

52+-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeHead'

5153-- omits the check for the empty case, so there is an obligation on

5254-- the programmer to provide a proof that the 'Text' is non-empty.

5355unsafeTail :: Text -> Text

@@ -59,15 +61,13 @@ unsafeTail t@(Text arr off len) =

5961 where d = iter_ t 0

6062{-# INLINE unsafeTail #-}

6163

62−data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int

63−

6464-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16

6565-- array, returning the current character and the delta to add to give

6666-- the next offset to iterate at.

67−iter :: Text -> Int -> Iter

67+iter :: Text -> Int -> (Char,Int)

6868iter (Text arr off _len) i

69− | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1

70− | otherwise = Iter (chr2 m n) 2

69+ | m < 0xD800 || m > 0xDBFF = (unsafeChr m, 1)

70+ | otherwise = (chr2 m n, 2)

7171 where m = A.unsafeIndex arr j

7272 n = A.unsafeIndex arr k

7373 j = off + i

@@ -95,29 +95,29 @@ reverseIter (Text arr off _len) i

9595 k = j - 1

9696{-# INLINE reverseIter #-}

9797

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−

108−-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This

109−-- is useful for sizing a target array appropriately before using

110−-- 'unsafeCopyToPtr'.

111−lengthWord16 :: Text -> Int

112−lengthWord16 (Text _arr _off len) = len

113−{-# INLINE lengthWord16 #-}

114−

115−-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.

116−takeWord16 :: Int -> Text -> Text

117−takeWord16 k (Text arr off _len) = Text arr off k

118−{-# INLINE takeWord16 #-}

98+-- | Just like unsafePerformIO, but we inline it. Big performance gains as

99+-- it exposes lots of things to further inlining. /Very unsafe/. In

100+-- particular, you should do no memory allocation inside an

101+-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.

102+--

103+{-# INLINE inlinePerformIO #-}

104+inlinePerformIO :: IO a -> a

105+#if defined(__GLASGOW_HASKELL__)

106+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r

107+#else

108+inlinePerformIO = unsafePerformIO

109+#endif

119110

120−-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.

121−dropWord16 :: Int -> Text -> Text

122−dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)

123−{-# INLINE dropWord16 #-}

111+-- | Allow an 'ST' computation to be deferred lazily. When passed an

112+-- action of type 'ST' @s@ @a@, the action will only be performed when

113+-- the value of @a@ is demanded.

114+--

115+-- This function is identical to the normal unsafeInterleaveST, but is

116+-- inlined and hence faster.

117+--

118+-- /Note/: This operation is highly unsafe, as it can introduce

119+-- externally visible non-determinism into an 'ST' action.

120+inlineInterleaveST :: ST s a -> ST s a

121+inlineInterleaveST (ST m) = ST $ \ s ->

122+ let r = case m s of (# _, res #) -> res in (# s, r #)

123+{-# INLINE inlineInterleaveST #-}

Data/Text/Internal/Unsafe/Char.hs → Data/Text/UnsafeChar.hsrenamed+10−15

@@ -1,22 +1,19 @@

11{-# LANGUAGE CPP, MagicHash #-}

22

33-- |

4−-- Module : Data.Text.Internal.Unsafe.Char

4+-- Module : Data.Text.UnsafeChar

5+-- Copyright : (c) Tom Harper 2008-2009,

6+-- (c) Bryan O'Sullivan 2009,

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

@@ -52,8 +49,6 @@ unsafeChr32 :: Word32 -> Char

5249unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))

5350{-# INLINE unsafeChr32 #-}

5451

55−-- | Write a character into the array at the given offset. Returns

56−-- the number of 'Word16's written.

5752unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int

5853unsafeWrite marr i c

5954 | n < 0x10000 = do

@@ -61,14 +56,14 @@ unsafeWrite marr i c

6156 assert (i >= 0) . assert (i < A.length marr) $ return ()

6257#endif

6358 A.unsafeWrite marr i (fromIntegral n)

64− return 1

59+ return $! i+1

6560 | otherwise = do

6661#if defined(ASSERTS)

6762 assert (i >= 0) . assert (i < A.length marr - 1) $ return ()

6863#endif

6964 A.unsafeWrite marr i lo

7065 A.unsafeWrite marr (i+1) hi

71− return 2

66+ return $! i+2

7267 where n = ord c

7368 m = n - 0x10000

7469 lo = fromIntegral $ (m `shiftR` 10) + 0xD800

Data/Text/Internal/Unsafe/Shift.hs → Data/Text/UnsafeShift.hsrenamed+4−7

@@ -1,21 +1,18 @@

11{-# LANGUAGE MagicHash #-}

22

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

READMEnew file+43

@@ -0,0 +1,43 @@

1+Text: Fast, packed Unicode strings, using stream fusion

2+-------------------------------------------------------

3+

4+This package provides the Data.Text library, a library for the space-

5+and time-efficient manipulation of Unicode text in Haskell.

6+

7+

8+Normalization, conversion, and collation, oh my!

9+------------------------------------------------

10+

11+This library intentionally provides a simple API based on the Haskell

12+prelude's list manipulation functions. For more complicated

13+real-world tasks, such as Unicode normalization, conversion to and

14+from a larger variety of encodings, and collation, use the text-icu

15+package:

16+

17+ http://hackage.haskell.org/cgi-bin/hackage-scripts/package/text-icu

18+

19+That library uses the well-respected and liberally licensed ICU

20+library to provide these facilities.

21+

22+

23+Source code

24+-----------

25+

26+darcs get http://code.haskell.org/text

27+

28+

29+Reporting bugs, asking for enhancements

30+---------------------------------------

31+

32+http://trac.haskell.org/text/

33+

34+

35+Authors

36+-------

37+

38+The base code for this library was originally written by Tom Harper,

39+based on the stream fusion framework developed by Roman Leshchinskiy,

40+Duncan Coutts, and Don Stewart.

41+

42+The core library was fleshed out, debugged, and tested by Bryan

43+O'Sullivan, and he is the current maintainer.

README.markdowndeleted−42

@@ -1,42 +0,0 @@

1−# Text: Fast, packed Unicode strings, using stream fusion

2−

3−This package provides the Data.Text library, a library for the space-

4−and time-efficient manipulation of Unicode text in Haskell.

5−

6−

7−# Normalization, conversion, and collation, oh my!

8−

9−This library intentionally provides a simple API based on the

10−Haskell prelude's list manipulation functions. For more complicated

11−real-world tasks, such as Unicode normalization, conversion to and

12−from a larger variety of encodings, and collation, use the [text-icu

13−package](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/text-icu).

14−

15−That library uses the well-respected and liberally licensed ICU

16−library to provide these facilities.

17−

18−

19−# Get involved!

20−

21−Please report bugs via the

22−[github issue tracker](https://github.com/bos/text/issues).

23−

24−Master [git repository](https://github.com/bos/text):

25−

26−* `git clone git://github.com/bos/text.git`

27−

28−There's also a [Mercurial mirror](https://bitbucket.org/bos/text):

29−

30−* `hg clone https://bitbucket.org/bos/text`

31−

32−(You can create and contribute changes using either Mercurial or git.)

33−

34−

35−# Authors

36−

37−The base code for this library was originally written by Tom Harper,

38−based on the stream fusion framework developed by Roman Leshchinskiy,

39−Duncan Coutts, and Don Stewart.

40−

41−The core library was fleshed out, debugged, and tested by Bryan

42−O'Sullivan <bos@serpentine.com>, and he is the current maintainer.

TODOnew file+6

@@ -0,0 +1,6 @@

1+Normalization.

2+

3+Collation.

4+

5+Case conversion lacks locale sensitivity, so cannot handle a few

6+Turkic and Azeri code points completely correctly.

benchmarks/.gitignoredeleted−1

@@ -1 +0,0 @@

1−dist

benchmarks/Setup.hsdeleted−2

@@ -1,2 +0,0 @@

1−import Distribution.Simple

2−main = defaultMain

benchmarks/cbits/time_iconv.cdeleted−35

@@ -1,35 +0,0 @@

1−#include <iconv.h>

2−#include <stdlib.h>

3−#include <stdio.h>

4−#include <stdint.h>

5−

6−int time_iconv(char *srcbuf, size_t srcbufsize)

7−{

8− uint16_t *destbuf = NULL;

9− size_t destbufsize;

10− static uint16_t *origdestbuf;

11− static size_t origdestbufsize;

12− iconv_t ic = (iconv_t) -1;

13− int ret = 0;

14−

15− if (ic == (iconv_t) -1) {

16− ic = iconv_open("UTF-16LE", "UTF-8");

17− if (ic == (iconv_t) -1) {

18− ret = -1;

19− goto done;

20− }

21− }

22−

23− destbufsize = srcbufsize * sizeof(uint16_t);

24− if (destbufsize > origdestbufsize) {

25− free(origdestbuf);

26− origdestbuf = destbuf = malloc(origdestbufsize = destbufsize);

27− } else {

28− destbuf = origdestbuf;

29− }

30−

31− iconv(ic, &srcbuf, &srcbufsize, (char**) &destbuf, &destbufsize);

32−

33− done:

34− return ret;

35−}

benchmarks/haskell/Benchmarks.hsdeleted−79

@@ -1,79 +0,0 @@

1−-- | Main module to run the micro benchmarks

2−--

3−{-# LANGUAGE OverloadedStrings #-}

4−module Main

5− ( main

6− ) where

7−

8−import Criterion.Main (Benchmark, defaultMain, bgroup)

9−import System.FilePath ((</>))

10−import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)

11−

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

25−

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

32−

33−main :: IO ()

34−main = benchmarks >>= defaultMain

35−

36−benchmarks :: IO [Benchmark]

37−benchmarks = do

38− sink <- openFile "/dev/null" WriteMode

39− hSetEncoding sink utf8

40−

41− -- Traditional benchmarks

42− bs <- sequence

43− [ Builder.benchmark

44− , DecodeUtf8.benchmark "html" (tf "libya-chinese.html")

45− , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml")

46− , DecodeUtf8.benchmark "ascii" (tf "ascii.txt")

47− , DecodeUtf8.benchmark "russian" (tf "russian.txt")

48− , DecodeUtf8.benchmark "japanese" (tf "japanese.txt")

49− , EncodeUtf8.benchmark "επανάληψη 竺法蘭共譯"

50− , Equality.benchmark (tf "japanese.txt")

51− , FileRead.benchmark (tf "russian.txt")

52− , 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")

59− , ReadNumbers.benchmark (tf "numbers.txt")

60− , Replace.benchmark (tf "russian.txt") "принимая" "своем"

61− , Search.benchmark (tf "russian.txt") "принимая"

62− , Stream.benchmark (tf "russian.txt")

63− , WordFrequencies.benchmark (tf "russian.txt")

64− ]

65−

66− -- Program-like benchmarks

67− ps <- bgroup "Programs" `fmap` sequence

68− [ Programs.BigTable.benchmark sink

69− , Programs.Cut.benchmark (tf "russian.txt") sink 20 40

70− , Programs.Fold.benchmark (tf "russian.txt") sink

71− , Programs.Sort.benchmark (tf "russian.txt") sink

72− , Programs.StripTags.benchmark (tf "yiwiki.xml") sink

73− , Programs.Throughput.benchmark (tf "russian.txt") sink

74− ]

75−

76− return $ bs ++ [ps]

77− where

78− -- Location of a test file

79− tf = ("../tests/text-test-data" </>)

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/DecodeUtf8.hsdeleted−67

@@ -1,67 +0,0 @@

1−{-# LANGUAGE ForeignFunctionInterface #-}

2−

3−-- | Test decoding of UTF-8

4−--

5−-- Tested in this benchmark:

6−--

7−-- * Decoding bytes using UTF-8

8−--

9−-- In some tests:

10−--

11−-- * Taking the length of the result

12−--

13−-- * Taking the init of the result

14−--

15−-- The latter are used for testing stream fusion.

16−--

17−module Benchmarks.DecodeUtf8

18− ( benchmark

19− ) where

20−

21−import Foreign.C.Types

22−import Data.ByteString.Internal (ByteString(..))

23−import Data.ByteString.Lazy.Internal (ByteString(..))

24−import Foreign.Ptr (Ptr, plusPtr)

25−import Foreign.ForeignPtr (withForeignPtr)

26−import Data.Word (Word8)

27−import qualified Criterion as C

28−import Criterion (Benchmark, bgroup, nf, whnfIO)

29−import qualified Codec.Binary.UTF8.Generic as U8

30−import qualified Data.ByteString as B

31−import qualified Data.ByteString.Lazy as BL

32−import qualified Data.Text as T

33−import qualified Data.Text.Encoding as T

34−import qualified Data.Text.Lazy as TL

35−import qualified Data.Text.Lazy.Encoding as TL

36−

37−benchmark :: String -> FilePath -> IO Benchmark

38−benchmark kind fp = do

39− bs <- B.readFile fp

40− lbs <- BL.readFile fp

41− 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 _ = []

48− return $ bgroup "DecodeUtf8"

49− [ bench "Strict" $ nf T.decodeUtf8 bs

50− , bench "Stream" $ nf decodeStream lbs

51− , bench "IConv" $ whnfIO $ iconv bs

52− , bench "StrictLength" $ nf (T.length . T.decodeUtf8) bs

53− , bench "StrictInitLength" $ nf (T.length . T.init . T.decodeUtf8) bs

54− , bench "Lazy" $ nf TL.decodeUtf8 lbs

55− , bench "LazyLength" $ nf (TL.length . TL.decodeUtf8) lbs

56− , bench "LazyInitLength" $ nf (TL.length . TL.init . TL.decodeUtf8) lbs

57− , bench "StrictStringUtf8" $ nf U8.toString bs

58− , bench "StrictStringUtf8Length" $ nf (length . U8.toString) bs

59− , bench "LazyStringUtf8" $ nf U8.toString lbs

60− , bench "LazyStringUtf8Length" $ nf (length . U8.toString) lbs

61− ]

62−

63−iconv :: B.ByteString -> IO CInt

64−iconv (PS fp off len) = withForeignPtr fp $ \ptr ->

65− time_iconv (ptr `plusPtr` off) (fromIntegral len)

66−

67−foreign import ccall unsafe time_iconv :: Ptr Word8 -> CSize -> IO CInt

benchmarks/haskell/Benchmarks/EncodeUtf8.hsdeleted−33

@@ -1,33 +0,0 @@

1−-- | UTF-8 encode a text

2−--

3−-- Tested in this benchmark:

4−--

5−-- * Replicating a string a number of times

6−--

7−-- * UTF-8 encoding it

8−--

9−module Benchmarks.EncodeUtf8

10− ( benchmark

11− ) where

12−

13−import Criterion (Benchmark, bgroup, bench, whnf)

14−import qualified Data.ByteString as B

15−import qualified Data.ByteString.Lazy as BL

16−import qualified Data.Text as T

17−import qualified Data.Text.Encoding as T

18−import qualified Data.Text.Lazy as TL

19−import qualified Data.Text.Lazy.Encoding as TL

20−

21−benchmark :: String -> IO Benchmark

22−benchmark string = do

23− return $ bgroup "EncodeUtf8"

24− [ bench "Text" $ whnf (B.length . T.encodeUtf8) text

25− , bench "LazyText" $ whnf (BL.length . TL.encodeUtf8) lazyText

26− ]

27− where

28− -- The string in different formats

29− text = T.replicate k $ T.pack string

30− lazyText = TL.replicate (fromIntegral k) $ TL.pack string

31−

32− -- Amount

33− k = 100000

benchmarks/haskell/Benchmarks/Equality.hsdeleted−38

@@ -1,38 +0,0 @@

1−-- | Compare a string with a copy of itself that is identical except

2−-- for the last character.

3−--

4−-- Tested in this benchmark:

5−--

6−-- * Comparison of strings (Eq instance)

7−--

8−module Benchmarks.Equality

9− ( benchmark

10− ) where

11−

12−import Criterion (Benchmark, bgroup, bench, whnf)

13−import qualified Data.ByteString.Char8 as B

14−import qualified Data.ByteString.Lazy.Char8 as BL

15−import qualified Data.Text as T

16−import qualified Data.Text.Encoding as T

17−import qualified Data.Text.Lazy as TL

18−import qualified Data.Text.Lazy.Encoding as TL

19−

20−benchmark :: FilePath -> IO Benchmark

21−benchmark fp = do

22− b <- B.readFile fp

23− bl1 <- BL.readFile fp

24− -- A lazy bytestring is a list of chunks. When we do not explicitly create two

25− -- different lazy bytestrings at a different address, the bytestring library

26− -- will compare the chunk addresses instead of the chunk contents. This is why

27− -- we read the lazy bytestring twice here.

28− bl2 <- BL.readFile fp

29− l <- readFile fp

30− let t = T.decodeUtf8 b

31− tl = TL.decodeUtf8 bl1

32− return $ bgroup "Equality"

33− [ bench "Text" $ whnf (== T.init t `T.snoc` '\xfffd') t

34− , bench "LazyText" $ whnf (== TL.init tl `TL.snoc` '\xfffd') tl

35− , bench "ByteString" $ whnf (== B.init b `B.snoc` '\xfffd') b

36− , bench "LazyByteString" $ whnf (== BL.init bl2 `BL.snoc` '\xfffd') bl1

37− , bench "String" $ whnf (== init l ++ "\xfffd") l

38− ]

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/FoldLines.hsdeleted−58

@@ -1,58 +0,0 @@

1−-- | Read a file line-by-line using handles, and perform a fold over the lines.

2−-- The fold is used here to calculate the number of lines in the file.

3−--

4−-- Tested in this benchmark:

5−--

6−-- * Buffered, line-based IO

7−--

8−{-# LANGUAGE BangPatterns #-}

9−module Benchmarks.FoldLines

10− ( benchmark

11− ) where

12−

13−import Criterion (Benchmark, bgroup, bench, whnfIO)

14−import System.IO

15−import qualified Data.ByteString as B

16−import qualified Data.Text as T

17−import qualified Data.Text.IO as T

18−

19−benchmark :: FilePath -> IO Benchmark

20−benchmark fp = return $ bgroup "ReadLines"

21− [ bench "Text" $ withHandle $ foldLinesT (\n _ -> n + 1) (0 :: Int)

22− , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)

23− ]

24− where

25− withHandle f = whnfIO $ do

26− h <- openFile fp ReadMode

27− hSetBuffering h (BlockBuffering (Just 16384))

28− x <- f h

29− hClose h

30− return x

31−

32−-- | Text line fold

33−--

34−foldLinesT :: (a -> T.Text -> a) -> a -> Handle -> IO a

35−foldLinesT f z0 h = go z0

36− where

37− go !z = do

38− eof <- hIsEOF h

39− if eof

40− then return z

41− else do

42− l <- T.hGetLine h

43− let z' = f z l in go z'

44−{-# INLINE foldLinesT #-}

45−

46−-- | ByteString line fold

47−--

48−foldLinesB :: (a -> B.ByteString -> a) -> a -> Handle -> IO a

49−foldLinesB f z0 h = go z0

50− where

51− go !z = do

52− eof <- hIsEOF h

53− if eof

54− then return z

55− else do

56− l <- B.hGetLine h

57− let z' = f z l in go z'

58−{-# INLINE foldLinesB #-}

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/Programs/BigTable.hsdeleted−42

@@ -1,42 +0,0 @@

1−-- | Create a large HTML table and dump it to a handle

2−--

3−-- Tested in this benchmark:

4−--

5−-- * Creating a large HTML document using a builder

6−--

7−-- * Writing to a handle

8−--

9−{-# LANGUAGE OverloadedStrings #-}

10−module Benchmarks.Programs.BigTable

11− ( benchmark

12− ) where

13−

14−import Criterion (Benchmark, bench, whnfIO)

15−import Data.Monoid (mappend, mconcat)

16−import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)

17−import Data.Text.Lazy.IO (hPutStr)

18−import System.IO (Handle)

19−import qualified Data.Text as T

20−

21−benchmark :: Handle -> IO Benchmark

22−benchmark sink = return $ bench "BigTable" $ whnfIO $ do

23− hPutStr sink "Content-Type: text/html\n\n<table>"

24− hPutStr sink . toLazyText . makeTable =<< rows

25− hPutStr sink "</table>"

26− where

27− -- We provide the number of rows in IO so the builder value isn't shared

28− -- between the benchmark samples.

29− rows :: IO Int

30− rows = return 20000

31− {-# NOINLINE rows #-}

32−

33−makeTable :: Int -> Builder

34−makeTable n = mconcat $ replicate n $ mconcat $ map makeCol [1 .. 50]

35−

36−makeCol :: Int -> Builder

37−makeCol 1 = fromText "<tr><td>1</td>"

38−makeCol 50 = fromText "<td>50</td></tr>"

39−makeCol i = fromText "<td>" `mappend` (fromInt i `mappend` fromText "</td>")

40−

41−fromInt :: Int -> Builder

42−fromInt = fromText . T.pack . show

benchmarks/haskell/Benchmarks/Programs/Cut.hsdeleted−98

@@ -1,98 +0,0 @@

1−-- | Cut into a file, selecting certain columns (e.g. columns 10 to 40)

2−--

3−-- Tested in this benchmark:

4−--

5−-- * Reading the file

6−--

7−-- * Splitting into lines

8−--

9−-- * Taking a number of characters from the lines

10−--

11−-- * Joining the lines

12−--

13−-- * Writing back to a handle

14−--

15−module Benchmarks.Programs.Cut

16− ( benchmark

17− ) where

18−

19−import Criterion (Benchmark, bgroup, bench, whnfIO)

20−import System.IO (Handle, hPutStr)

21−import qualified Data.ByteString as B

22−import qualified Data.ByteString.Char8 as BC

23−import qualified Data.ByteString.Lazy as BL

24−import qualified Data.ByteString.Lazy.Char8 as BLC

25−import qualified Data.Text as T

26−import qualified Data.Text.Encoding as T

27−import qualified Data.Text.IO as T

28−import qualified Data.Text.Lazy as TL

29−import qualified Data.Text.Lazy.Encoding as TL

30−import qualified Data.Text.Lazy.IO as TL

31−

32−benchmark :: FilePath -> Handle -> Int -> Int -> IO Benchmark

33−benchmark p sink from to = return $ bgroup "Cut"

34− [ bench' "String" string

35− , bench' "ByteString" byteString

36− , bench' "LazyByteString" lazyByteString

37− , bench' "Text" text

38− , bench' "LazyText" lazyText

39− , bench' "TextByteString" textByteString

40− , bench' "LazyTextByteString" lazyTextByteString

41− ]

42− where

43− bench' n s = bench n $ whnfIO (s p sink from to)

44−

45−string :: FilePath -> Handle -> Int -> Int -> IO ()

46−string fp sink from to = do

47− s <- readFile fp

48− hPutStr sink $ cut s

49− where

50− cut = unlines . map (take (to - from) . drop from) . lines

51−

52−byteString :: FilePath -> Handle -> Int -> Int -> IO ()

53−byteString fp sink from to = do

54− bs <- B.readFile fp

55− B.hPutStr sink $ cut bs

56− where

57− cut = BC.unlines . map (B.take (to - from) . B.drop from) . BC.lines

58−

59−lazyByteString :: FilePath -> Handle -> Int -> Int -> IO ()

60−lazyByteString fp sink from to = do

61− bs <- BL.readFile fp

62− BL.hPutStr sink $ cut bs

63− where

64− cut = BLC.unlines . map (BL.take (to' - from') . BL.drop from') . BLC.lines

65− from' = fromIntegral from

66− to' = fromIntegral to

67−

68−text :: FilePath -> Handle -> Int -> Int -> IO ()

69−text fp sink from to = do

70− t <- T.readFile fp

71− T.hPutStr sink $ cut t

72− where

73− cut = T.unlines . map (T.take (to - from) . T.drop from) . T.lines

74−

75−lazyText :: FilePath -> Handle -> Int -> Int -> IO ()

76−lazyText fp sink from to = do

77− t <- TL.readFile fp

78− TL.hPutStr sink $ cut t

79− where

80− cut = TL.unlines . map (TL.take (to' - from') . TL.drop from') . TL.lines

81− from' = fromIntegral from

82− to' = fromIntegral to

83−

84−textByteString :: FilePath -> Handle -> Int -> Int -> IO ()

85−textByteString fp sink from to = do

86− t <- T.decodeUtf8 `fmap` B.readFile fp

87− B.hPutStr sink $ T.encodeUtf8 $ cut t

88− where

89− cut = T.unlines . map (T.take (to - from) . T.drop from) . T.lines

90−

91−lazyTextByteString :: FilePath -> Handle -> Int -> Int -> IO ()

92−lazyTextByteString fp sink from to = do

93− t <- TL.decodeUtf8 `fmap` BL.readFile fp

94− BL.hPutStr sink $ TL.encodeUtf8 $ cut t

95− where

96− cut = TL.unlines . map (TL.take (to' - from') . TL.drop from') . TL.lines

97− from' = fromIntegral from

98− to' = fromIntegral to

benchmarks/haskell/Benchmarks/Programs/Fold.hsdeleted−68

@@ -1,68 +0,0 @@

1−-- | Benchmark which formats paragraph, like the @sort@ unix utility.

2−--

3−-- Tested in this benchmark:

4−--

5−-- * Reading the file

6−--

7−-- * Splitting into paragraphs

8−--

9−-- * Reformatting the paragraphs to a certain line width

10−--

11−-- * Concatenating the results using the text builder

12−--

13−-- * Writing back to a handle

14−--

15−{-# LANGUAGE OverloadedStrings #-}

16−module Benchmarks.Programs.Fold

17− ( benchmark

18− ) where

19−

20−import Data.List (foldl')

21−import Data.List (intersperse)

22−import Data.Monoid (mempty, mappend, mconcat)

23−import System.IO (Handle)

24−import Criterion (Benchmark, bench, whnfIO)

25−import qualified Data.Text as T

26−import qualified Data.Text.IO as T

27−import qualified Data.Text.Lazy.Builder as TLB

28−import qualified Data.Text.Lazy as TL

29−import qualified Data.Text.Lazy.IO as TL

30−

31−benchmark :: FilePath -> Handle -> IO Benchmark

32−benchmark i o = return $

33− bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80

34−

35−-- | We represent a paragraph by a word list

36−--

37−type Paragraph = [T.Text]

38−

39−-- | Fold a text

40−--

41−fold :: Int -> T.Text -> TL.Text

42−fold maxWidth = TLB.toLazyText . mconcat .

43− intersperse "\n\n" . map (foldParagraph maxWidth) . paragraphs

44−

45−-- | Fold a paragraph

46−--

47−foldParagraph :: Int -> Paragraph -> TLB.Builder

48−foldParagraph _ [] = mempty

49−foldParagraph max' (w : ws) = fst $ foldl' go (TLB.fromText w, T.length w) ws

50− where

51− go (builder, width) word

52− | width + len + 1 <= max' =

53− (builder `mappend` " " `mappend` word', width + len + 1)

54− | otherwise =

55− (builder `mappend` "\n" `mappend` word', len)

56− where

57− word' = TLB.fromText word

58− len = T.length word

59−

60−-- | Divide a text into paragraphs

61−--

62−paragraphs :: T.Text -> [Paragraph]

63−paragraphs = splitParagraphs . map T.words . T.lines

64− where

65− splitParagraphs ls = case break null ls of

66− ([], []) -> []

67− (p, []) -> [concat p]

68− (p, lr) -> concat p : splitParagraphs (dropWhile null lr)

benchmarks/haskell/Benchmarks/Programs/Sort.hsdeleted−71

@@ -1,71 +0,0 @@

1−-- | This benchmark sorts the lines of a file, like the @sort@ unix utility.

2−--

3−-- Tested in this benchmark:

4−--

5−-- * Reading the file

6−--

7−-- * Splitting into lines

8−--

9−-- * Sorting the lines

10−--

11−-- * Joining the lines

12−--

13−-- * Writing back to a handle

14−--

15−{-# LANGUAGE OverloadedStrings #-}

16−module Benchmarks.Programs.Sort

17− ( benchmark

18− ) where

19−

20−import Criterion (Benchmark, bgroup, bench, whnfIO)

21−import Data.Monoid (mconcat)

22−import System.IO (Handle, hPutStr)

23−import qualified Data.ByteString as B

24−import qualified Data.ByteString.Char8 as BC

25−import qualified Data.ByteString.Lazy as BL

26−import qualified Data.ByteString.Lazy.Char8 as BLC

27−import qualified Data.List as L

28−import qualified Data.Text as T

29−import qualified Data.Text.Encoding as T

30−import qualified Data.Text.IO as T

31−import qualified Data.Text.Lazy as TL

32−import qualified Data.Text.Lazy.Builder as TLB

33−import qualified Data.Text.Lazy.Encoding as TL

34−import qualified Data.Text.Lazy.IO as TL

35−

36−benchmark :: FilePath -> Handle -> IO Benchmark

37−benchmark 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 >>=

45− B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

46− , bench "LazyTextByteString" $ whnfIO $ BL.readFile i >>=

47− BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8

48− , bench "TextBuilder" $ whnfIO $ B.readFile i >>=

49− BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8

50− ]

51−

52−string :: String -> String

53−string = unlines . L.sort . lines

54−

55−byteString :: B.ByteString -> B.ByteString

56−byteString = BC.unlines . L.sort . BC.lines

57−

58−lazyByteString :: BL.ByteString -> BL.ByteString

59−lazyByteString = BLC.unlines . L.sort . BLC.lines

60−

61−text :: T.Text -> T.Text

62−text = T.unlines . L.sort . T.lines

63−

64−lazyText :: TL.Text -> TL.Text

65−lazyText = TL.unlines . L.sort . TL.lines

66−

67−-- | Text variant using a builder monoid for the final concatenation

68−--

69−textBuilder :: T.Text -> TL.Text

70−textBuilder = TLB.toLazyText . mconcat . L.intersperse (TLB.singleton '\n') .

71− map TLB.fromText . L.sort . T.lines

benchmarks/haskell/Benchmarks/Programs/StripTags.hsdeleted−53

@@ -1,53 +0,0 @@

1−-- | Program to replace HTML tags by whitespace

2−--

3−-- This program was originally contributed by Petr Prokhorenkov.

4−--

5−-- Tested in this benchmark:

6−--

7−-- * Reading the file

8−--

9−-- * Replacing text between HTML tags (<>) with whitespace

10−--

11−-- * Writing back to a handle

12−--

13−{-# OPTIONS_GHC -fspec-constr-count=5 #-}

14−module Benchmarks.Programs.StripTags

15− ( benchmark

16− ) where

17−

18−import Criterion (Benchmark, bgroup, bench, whnfIO)

19−import Data.List (mapAccumL)

20−import System.IO (Handle, hPutStr)

21−import qualified Data.ByteString as B

22−import qualified Data.ByteString.Char8 as BC

23−import qualified Data.Text as T

24−import qualified Data.Text.Encoding as T

25−import qualified Data.Text.IO as T

26−

27−benchmark :: FilePath -> Handle -> IO Benchmark

28−benchmark 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 $

33− B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

34− ]

35−

36−string :: String -> String

37−string = snd . mapAccumL step 0

38−

39−text :: T.Text -> T.Text

40−text = snd . T.mapAccumL step 0

41−

42−byteString :: B.ByteString -> B.ByteString

43−byteString = snd . BC.mapAccumL step 0

44−

45−step :: Int -> Char -> (Int, Char)

46−step d c

47− | d > 0 || d' > 0 = (d', ' ')

48− | otherwise = (d', c)

49− where

50− d' = d + depth c

51− depth '>' = 1

52− depth '<' = -1

53− depth _ = 0

benchmarks/haskell/Benchmarks/Programs/Throughput.hsdeleted−41

@@ -1,41 +0,0 @@

1−-- | This benchmark simply reads and writes a file using the various string

2−-- libraries. The point of it is that we can make better estimations on how

3−-- much time the other benchmarks spend doing IO.

4−--

5−-- Note that we expect ByteStrings to be a whole lot faster, since they do not

6−-- do any actual encoding/decoding here, while String and Text do have UTF-8

7−-- encoding/decoding.

8−--

9−-- Tested in this benchmark:

10−--

11−-- * Reading the file

12−--

13−-- * Replacing text between HTML tags (<>) with whitespace

14−--

15−-- * Writing back to a handle

16−--

17−module Benchmarks.Programs.Throughput

18− ( benchmark

19− ) where

20−

21−import Criterion (Benchmark, bgroup, bench, whnfIO)

22−import System.IO (Handle, hPutStr)

23−import qualified Data.ByteString as B

24−import qualified Data.ByteString.Lazy as BL

25−import qualified Data.Text.Encoding as T

26−import qualified Data.Text.IO as T

27−import qualified Data.Text.Lazy.Encoding as TL

28−import qualified Data.Text.Lazy.IO as TL

29−

30−benchmark :: FilePath -> Handle -> IO Benchmark

31−benchmark 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 $

38− B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8

39− , bench "LazyTextByteString" $ whnfIO $

40− BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8

41− ]

benchmarks/haskell/Benchmarks/Pure.hsdeleted−486

@@ -1,486 +0,0 @@

1−-- | Benchmarks various pure functions from the Text library

2−--

3−-- Tested in this benchmark:

4−--

5−-- * Most pure functions defined the string types

6−--

7−{-# LANGUAGE BangPatterns, CPP, GADTs, MagicHash #-}

8−{-# OPTIONS_GHC -fno-warn-orphans #-}

9−module Benchmarks.Pure

10− ( benchmark

11− ) where

12−

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

14−import Control.Exception (evaluate)

15−import Criterion (Benchmark, bgroup, bench, nf)

16−import Data.Char (toLower, toUpper)

17−import Data.Monoid (mappend, mempty)

18−import GHC.Base (Char (..), Int (..), chr#, ord#, (+#))

19−import qualified Data.ByteString.Char8 as BS

20−import qualified Data.ByteString.Lazy.Char8 as BL

21−import qualified Data.ByteString.UTF8 as UTF8

22−import qualified Data.List as L

23−import qualified Data.Text as T

24−import qualified Data.Text.Encoding as T

25−import qualified Data.Text.Lazy as TL

26−import qualified Data.Text.Lazy.Builder as TB

27−import qualified Data.Text.Lazy.Encoding as TL

28−

29−benchmark :: String -> FilePath -> IO Benchmark

30−benchmark kind fp = do

31− -- Evaluate stuff before actually running the benchmark, we don't want to

32− -- count it here.

33−

34− -- ByteString A

35− bsa <- BS.readFile fp

36−

37− -- Text A/B, LazyText A/B

38− ta <- evaluate $ T.decodeUtf8 bsa

39− tb <- evaluate $ T.toUpper ta

40− tla <- evaluate $ TL.fromChunks (T.chunksOf 16376 ta)

41− tlb <- evaluate $ TL.fromChunks (T.chunksOf 16376 tb)

42−

43− -- ByteString B, LazyByteString A/B

44− bsb <- evaluate $ T.encodeUtf8 tb

45− bla <- evaluate $ BL.fromChunks (chunksOf 16376 bsa)

46− blb <- evaluate $ BL.fromChunks (chunksOf 16376 bsb)

47−

48− -- String A/B

49− sa <- evaluate $ UTF8.toString bsa

50− sb <- evaluate $ T.unpack tb

51−

52− -- Lengths

53− bsa_len <- evaluate $ BS.length bsa

54− ta_len <- evaluate $ T.length ta

55− bla_len <- evaluate $ BL.length bla

56− tla_len <- evaluate $ TL.length tla

57− sa_len <- evaluate $ L.length sa

58−

59− -- Lines

60− bsl <- evaluate $ BS.lines bsa

61− bll <- evaluate $ BL.lines bla

62− tl <- evaluate $ T.lines ta

63− tll <- evaluate $ TL.lines tla

64− sl <- evaluate $ L.lines sa

65−

66− return $ bgroup "Pure"

67− [ bgroup "append"

68− [ benchT $ nf (T.append tb) ta

69− , benchTL $ nf (TL.append tlb) tla

70− , benchBS $ nf (BS.append bsb) bsa

71− , benchBSL $ nf (BL.append blb) bla

72− , benchS $ nf ((++) sb) sa

73− ]

74− , bgroup "concat"

75− [ benchT $ nf T.concat tl

76− , benchTL $ nf TL.concat tll

77− , benchBS $ nf BS.concat bsl

78− , benchBSL $ nf BL.concat bll

79− , benchS $ nf L.concat sl

80− ]

81− , bgroup "cons"

82− [ benchT $ nf (T.cons c) ta

83− , benchTL $ nf (TL.cons c) tla

84− , benchBS $ nf (BS.cons c) bsa

85− , benchBSL $ nf (BL.cons c) bla

86− , benchS $ nf (c:) sa

87− ]

88− , bgroup "concatMap"

89− [ benchT $ nf (T.concatMap (T.replicate 3 . T.singleton)) ta

90− , benchTL $ nf (TL.concatMap (TL.replicate 3 . TL.singleton)) tla

91− , benchBS $ nf (BS.concatMap (BS.replicate 3)) bsa

92− , benchBSL $ nf (BL.concatMap (BL.replicate 3)) bla

93− , benchS $ nf (L.concatMap (L.replicate 3 . (:[]))) sa

94− ]

95− , bgroup "decode"

96− [ benchT $ nf T.decodeUtf8 bsa

97− , benchTL $ nf TL.decodeUtf8 bla

98− , benchBS $ nf BS.unpack bsa

99− , benchBSL $ nf BL.unpack bla

100− , benchS $ nf UTF8.toString bsa

101− ]

102− , bgroup "decode'"

103− [ benchT $ nf T.decodeUtf8' bsa

104− , benchTL $ nf TL.decodeUtf8' bla

105− ]

106− , bgroup "drop"

107− [ benchT $ nf (T.drop (ta_len `div` 3)) ta

108− , benchTL $ nf (TL.drop (tla_len `div` 3)) tla

109− , benchBS $ nf (BS.drop (bsa_len `div` 3)) bsa

110− , benchBSL $ nf (BL.drop (bla_len `div` 3)) bla

111− , benchS $ nf (L.drop (sa_len `div` 3)) sa

112− ]

113− , bgroup "encode"

114− [ benchT $ nf T.encodeUtf8 ta

115− , benchTL $ nf TL.encodeUtf8 tla

116− , benchBS $ nf BS.pack sa

117− , benchBSL $ nf BL.pack sa

118− , benchS $ nf UTF8.fromString sa

119− ]

120− , bgroup "filter"

121− [ benchT $ nf (T.filter p0) ta

122− , benchTL $ nf (TL.filter p0) tla

123− , benchBS $ nf (BS.filter p0) bsa

124− , benchBSL $ nf (BL.filter p0) bla

125− , benchS $ nf (L.filter p0) sa

126− ]

127− , bgroup "filter.filter"

128− [ benchT $ nf (T.filter p1 . T.filter p0) ta

129− , benchTL $ nf (TL.filter p1 . TL.filter p0) tla

130− , benchBS $ nf (BS.filter p1 . BS.filter p0) bsa

131− , benchBSL $ nf (BL.filter p1 . BL.filter p0) bla

132− , benchS $ nf (L.filter p1 . L.filter p0) sa

133− ]

134− , bgroup "foldl'"

135− [ benchT $ nf (T.foldl' len 0) ta

136− , benchTL $ nf (TL.foldl' len 0) tla

137− , benchBS $ nf (BS.foldl' len 0) bsa

138− , benchBSL $ nf (BL.foldl' len 0) bla

139− , benchS $ nf (L.foldl' len 0) sa

140− ]

141− , bgroup "foldr"

142− [ benchT $ nf (L.length . T.foldr (:) []) ta

143− , benchTL $ nf (L.length . TL.foldr (:) []) tla

144− , benchBS $ nf (L.length . BS.foldr (:) []) bsa

145− , benchBSL $ nf (L.length . BL.foldr (:) []) bla

146− , benchS $ nf (L.length . L.foldr (:) []) sa

147− ]

148− , bgroup "head"

149− [ benchT $ nf T.head ta

150− , benchTL $ nf TL.head tla

151− , benchBS $ nf BS.head bsa

152− , benchBSL $ nf BL.head bla

153− , benchS $ nf L.head sa

154− ]

155− , bgroup "init"

156− [ benchT $ nf T.init ta

157− , benchTL $ nf TL.init tla

158− , benchBS $ nf BS.init bsa

159− , benchBSL $ nf BL.init bla

160− , benchS $ nf L.init sa

161− ]

162− , bgroup "intercalate"

163− [ benchT $ nf (T.intercalate tsw) tl

164− , benchTL $ nf (TL.intercalate tlw) tll

165− , benchBS $ nf (BS.intercalate bsw) bsl

166− , benchBSL $ nf (BL.intercalate blw) bll

167− , benchS $ nf (L.intercalate lw) sl

168− ]

169− , bgroup "intersperse"

170− [ benchT $ nf (T.intersperse c) ta

171− , benchTL $ nf (TL.intersperse c) tla

172− , benchBS $ nf (BS.intersperse c) bsa

173− , benchBSL $ nf (BL.intersperse c) bla

174− , benchS $ nf (L.intersperse c) sa

175− ]

176− , bgroup "isInfixOf"

177− [ benchT $ nf (T.isInfixOf tsw) ta

178− , benchTL $ nf (TL.isInfixOf tlw) tla

179− , benchBS $ nf (BS.isInfixOf bsw) bsa

180− -- no isInfixOf for lazy bytestrings

181− , benchS $ nf (L.isInfixOf lw) sa

182− ]

183− , bgroup "last"

184− [ benchT $ nf T.last ta

185− , benchTL $ nf TL.last tla

186− , benchBS $ nf BS.last bsa

187− , benchBSL $ nf BL.last bla

188− , benchS $ nf L.last sa

189− ]

190− , bgroup "map"

191− [ benchT $ nf (T.map f) ta

192− , benchTL $ nf (TL.map f) tla

193− , benchBS $ nf (BS.map f) bsa

194− , benchBSL $ nf (BL.map f) bla

195− , benchS $ nf (L.map f) sa

196− ]

197− , bgroup "mapAccumL"

198− [ benchT $ nf (T.mapAccumL g 0) ta

199− , benchTL $ nf (TL.mapAccumL g 0) tla

200− , benchBS $ nf (BS.mapAccumL g 0) bsa

201− , benchBSL $ nf (BL.mapAccumL g 0) bla

202− , benchS $ nf (L.mapAccumL g 0) sa

203− ]

204− , bgroup "mapAccumR"

205− [ benchT $ nf (T.mapAccumR g 0) ta

206− , benchTL $ nf (TL.mapAccumR g 0) tla

207− , benchBS $ nf (BS.mapAccumR g 0) bsa

208− , benchBSL $ nf (BL.mapAccumR g 0) bla

209− , benchS $ nf (L.mapAccumR g 0) sa

210− ]

211− , bgroup "map.map"

212− [ benchT $ nf (T.map f . T.map f) ta

213− , benchTL $ nf (TL.map f . TL.map f) tla

214− , benchBS $ nf (BS.map f . BS.map f) bsa

215− , benchBSL $ nf (BL.map f . BL.map f) bla

216− , benchS $ nf (L.map f . L.map f) sa

217− ]

218− , bgroup "replicate char"

219− [ benchT $ nf (T.replicate bsa_len) (T.singleton c)

220− , benchTL $ nf (TL.replicate (fromIntegral bsa_len)) (TL.singleton c)

221− , benchBS $ nf (BS.replicate bsa_len) c

222− , benchBSL $ nf (BL.replicate (fromIntegral bsa_len)) c

223− , benchS $ nf (L.replicate bsa_len) c

224− ]

225− , bgroup "replicate string"

226− [ benchT $ nf (T.replicate (bsa_len `div` T.length tsw)) tsw

227− , benchTL $ nf (TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw

228− , benchS $ nf (replicat (bsa_len `div` T.length tsw)) lw

229− ]

230− , bgroup "reverse"

231− [ benchT $ nf T.reverse ta

232− , benchTL $ nf TL.reverse tla

233− , benchBS $ nf BS.reverse bsa

234− , benchBSL $ nf BL.reverse bla

235− , benchS $ nf L.reverse sa

236− ]

237− , bgroup "take"

238− [ benchT $ nf (T.take (ta_len `div` 3)) ta

239− , benchTL $ nf (TL.take (tla_len `div` 3)) tla

240− , benchBS $ nf (BS.take (bsa_len `div` 3)) bsa

241− , benchBSL $ nf (BL.take (bla_len `div` 3)) bla

242− , benchS $ nf (L.take (sa_len `div` 3)) sa

243− ]

244− , bgroup "tail"

245− [ benchT $ nf T.tail ta

246− , benchTL $ nf TL.tail tla

247− , benchBS $ nf BS.tail bsa

248− , benchBSL $ nf BL.tail bla

249− , benchS $ nf L.tail sa

250− ]

251− , bgroup "toLower"

252− [ benchT $ nf T.toLower ta

253− , benchTL $ nf TL.toLower tla

254− , benchBS $ nf (BS.map toLower) bsa

255− , benchBSL $ nf (BL.map toLower) bla

256− , benchS $ nf (L.map toLower) sa

257− ]

258− , bgroup "toUpper"

259− [ benchT $ nf T.toUpper ta

260− , benchTL $ nf TL.toUpper tla

261− , benchBS $ nf (BS.map toUpper) bsa

262− , benchBSL $ nf (BL.map toUpper) bla

263− , benchS $ nf (L.map toUpper) sa

264− ]

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− ]

272− , bgroup "words"

273− [ benchT $ nf T.words ta

274− , benchTL $ nf TL.words tla

275− , benchBS $ nf BS.words bsa

276− , benchBSL $ nf BL.words bla

277− , benchS $ nf L.words sa

278− ]

279− , bgroup "zipWith"

280− [ benchT $ nf (T.zipWith min tb) ta

281− , benchTL $ nf (TL.zipWith min tlb) tla

282− , benchBS $ nf (BS.zipWith min bsb) bsa

283− , benchBSL $ nf (BL.zipWith min blb) bla

284− , benchS $ nf (L.zipWith min sb) sa

285− ]

286− , bgroup "length"

287− [ bgroup "cons"

288− [ benchT $ nf (T.length . T.cons c) ta

289− , benchTL $ nf (TL.length . TL.cons c) tla

290− , benchBS $ nf (BS.length . BS.cons c) bsa

291− , benchBSL $ nf (BL.length . BL.cons c) bla

292− , benchS $ nf (L.length . (:) c) sa

293− ]

294− , bgroup "decode"

295− [ benchT $ nf (T.length . T.decodeUtf8) bsa

296− , benchTL $ nf (TL.length . TL.decodeUtf8) bla

297− , benchBS $ nf (L.length . BS.unpack) bsa

298− , benchBSL $ nf (L.length . BL.unpack) bla

299− , bench "StringUTF8" $ nf (L.length . UTF8.toString) bsa

300− ]

301− , bgroup "drop"

302− [ benchT $ nf (T.length . T.drop (ta_len `div` 3)) ta

303− , benchTL $ nf (TL.length . TL.drop (tla_len `div` 3)) tla

304− , benchBS $ nf (BS.length . BS.drop (bsa_len `div` 3)) bsa

305− , benchBSL $ nf (BL.length . BL.drop (bla_len `div` 3)) bla

306− , benchS $ nf (L.length . L.drop (sa_len `div` 3)) sa

307− ]

308− , bgroup "filter"

309− [ benchT $ nf (T.length . T.filter p0) ta

310− , benchTL $ nf (TL.length . TL.filter p0) tla

311− , benchBS $ nf (BS.length . BS.filter p0) bsa

312− , benchBSL $ nf (BL.length . BL.filter p0) bla

313− , benchS $ nf (L.length . L.filter p0) sa

314− ]

315− , bgroup "filter.filter"

316− [ benchT $ nf (T.length . T.filter p1 . T.filter p0) ta

317− , benchTL $ nf (TL.length . TL.filter p1 . TL.filter p0) tla

318− , benchBS $ nf (BS.length . BS.filter p1 . BS.filter p0) bsa

319− , benchBSL $ nf (BL.length . BL.filter p1 . BL.filter p0) bla

320− , benchS $ nf (L.length . L.filter p1 . L.filter p0) sa

321− ]

322− , bgroup "init"

323− [ benchT $ nf (T.length . T.init) ta

324− , benchTL $ nf (TL.length . TL.init) tla

325− , benchBS $ nf (BS.length . BS.init) bsa

326− , benchBSL $ nf (BL.length . BL.init) bla

327− , benchS $ nf (L.length . L.init) sa

328− ]

329− , bgroup "intercalate"

330− [ benchT $ nf (T.length . T.intercalate tsw) tl

331− , benchTL $ nf (TL.length . TL.intercalate tlw) tll

332− , benchBS $ nf (BS.length . BS.intercalate bsw) bsl

333− , benchBSL $ nf (BL.length . BL.intercalate blw) bll

334− , benchS $ nf (L.length . L.intercalate lw) sl

335− ]

336− , bgroup "intersperse"

337− [ benchT $ nf (T.length . T.intersperse c) ta

338− , benchTL $ nf (TL.length . TL.intersperse c) tla

339− , benchBS $ nf (BS.length . BS.intersperse c) bsa

340− , benchBSL $ nf (BL.length . BL.intersperse c) bla

341− , benchS $ nf (L.length . L.intersperse c) sa

342− ]

343− , bgroup "map"

344− [ benchT $ nf (T.length . T.map f) ta

345− , benchTL $ nf (TL.length . TL.map f) tla

346− , benchBS $ nf (BS.length . BS.map f) bsa

347− , benchBSL $ nf (BL.length . BL.map f) bla

348− , benchS $ nf (L.length . L.map f) sa

349− ]

350− , bgroup "map.map"

351− [ benchT $ nf (T.length . T.map f . T.map f) ta

352− , benchTL $ nf (TL.length . TL.map f . TL.map f) tla

353− , benchBS $ nf (BS.length . BS.map f . BS.map f) bsa

354− , benchS $ nf (L.length . L.map f . L.map f) sa

355− ]

356− , bgroup "replicate char"

357− [ benchT $ nf (T.length . T.replicate bsa_len) (T.singleton c)

358− , benchTL $ nf (TL.length . TL.replicate (fromIntegral bsa_len)) (TL.singleton c)

359− , benchBS $ nf (BS.length . BS.replicate bsa_len) c

360− , benchBSL $ nf (BL.length . BL.replicate (fromIntegral bsa_len)) c

361− , benchS $ nf (L.length . L.replicate bsa_len) c

362− ]

363− , bgroup "replicate string"

364− [ benchT $ nf (T.length . T.replicate (bsa_len `div` T.length tsw)) tsw

365− , benchTL $ nf (TL.length . TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw

366− , benchS $ nf (L.length . replicat (bsa_len `div` T.length tsw)) lw

367− ]

368− , bgroup "take"

369− [ benchT $ nf (T.length . T.take (ta_len `div` 3)) ta

370− , benchTL $ nf (TL.length . TL.take (tla_len `div` 3)) tla

371− , benchBS $ nf (BS.length . BS.take (bsa_len `div` 3)) bsa

372− , benchBSL $ nf (BL.length . BL.take (bla_len `div` 3)) bla

373− , benchS $ nf (L.length . L.take (sa_len `div` 3)) sa

374− ]

375− , bgroup "tail"

376− [ benchT $ nf (T.length . T.tail) ta

377− , benchTL $ nf (TL.length . TL.tail) tla

378− , benchBS $ nf (BS.length . BS.tail) bsa

379− , benchBSL $ nf (BL.length . BL.tail) bla

380− , benchS $ nf (L.length . L.tail) sa

381− ]

382− , bgroup "toLower"

383− [ benchT $ nf (T.length . T.toLower) ta

384− , benchTL $ nf (TL.length . TL.toLower) tla

385− , benchBS $ nf (BS.length . BS.map toLower) bsa

386− , benchBSL $ nf (BL.length . BL.map toLower) bla

387− , benchS $ nf (L.length . L.map toLower) sa

388− ]

389− , bgroup "toUpper"

390− [ benchT $ nf (T.length . T.toUpper) ta

391− , benchTL $ nf (TL.length . TL.toUpper) tla

392− , benchBS $ nf (BS.length . BS.map toUpper) bsa

393− , benchBSL $ nf (BL.length . BL.map toUpper) bla

394− , benchS $ nf (L.length . L.map toUpper) sa

395− ]

396− , bgroup "words"

397− [ benchT $ nf (L.length . T.words) ta

398− , benchTL $ nf (L.length . TL.words) tla

399− , benchBS $ nf (L.length . BS.words) bsa

400− , benchBSL $ nf (L.length . BL.words) bla

401− , benchS $ nf (L.length . L.words) sa

402− ]

403− , bgroup "zipWith"

404− [ benchT $ nf (T.length . T.zipWith min tb) ta

405− , benchTL $ nf (TL.length . TL.zipWith min tlb) tla

406− , benchBS $ nf (L.length . BS.zipWith min bsb) bsa

407− , benchBSL $ nf (L.length . BL.zipWith min blb) bla

408− , benchS $ nf (L.length . L.zipWith min sb) sa

409− ]

410− ]

411− , bgroup "Builder"

412− [ bench "mappend char" $ nf (TL.length . TB.toLazyText . mappendNChar 'a') 10000

413− , bench "mappend 8 char" $ nf (TL.length . TB.toLazyText . mappend8Char) 'a'

414− , bench "mappend text" $ nf (TL.length . TB.toLazyText . mappendNText short) 10000

415− ]

416− ]

417− 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)

423−

424− c = 'й'

425− p0 = (== c)

426− p1 = (/= 'д')

427− lw = "право"

428− bsw = UTF8.fromString lw

429− blw = BL.fromChunks [bsw]

430− tsw = T.pack lw

431− tlw = TL.fromChunks [tsw]

432− f (C# c#) = C# (chr# (ord# c# +# 1#))

433− g (I# i#) (C# c#) = (I# (i# +# 1#), C# (chr# (ord# c# +# i#)))

434− len l _ = l + (1::Int)

435− replicat n = concat . L.replicate n

436− short = T.pack "short"

437−

438−#if !MIN_VERSION_bytestring(0,10,0)

439−instance NFData BS.ByteString

440−

441−instance NFData BL.ByteString where

442− rnf BL.Empty = ()

443− rnf (BL.Chunk _ ts) = rnf ts

444−#endif

445−

446−data B where

447− B :: NFData a => a -> B

448−

449−instance NFData B where

450− rnf (B b) = rnf b

451−

452−-- | Split a bytestring in chunks

453−--

454−chunksOf :: Int -> BS.ByteString -> [BS.ByteString]

455−chunksOf k = go

456− where

457− go t = case BS.splitAt k t of

458− (a,b) | BS.null a -> []

459− | otherwise -> a : go b

460−

461−-- | Append a character n times

462−--

463−mappendNChar :: Char -> Int -> TB.Builder

464−mappendNChar c n = go 0

465− where

466− go i

467− | i < n = TB.singleton c `mappend` go (i+1)

468− | otherwise = mempty

469−

470−-- | Gives more opportunity for inlining and elimination of unnecesary

471−-- bounds checks.

472−--

473−mappend8Char :: Char -> TB.Builder

474−mappend8Char c = TB.singleton c `mappend` TB.singleton c `mappend`

475− TB.singleton c `mappend` TB.singleton c `mappend`

476− TB.singleton c `mappend` TB.singleton c `mappend`

477− TB.singleton c `mappend` TB.singleton c

478−

479−-- | Append a text N times

480−--

481−mappendNText :: T.Text -> Int -> TB.Builder

482−mappendNText t n = go 0

483− where

484− go i

485− | i < n = TB.fromText t `mappend` go (i+1)

486− | otherwise = mempty

benchmarks/haskell/Benchmarks/ReadNumbers.hsdeleted−93

@@ -1,93 +0,0 @@

1−-- | Read numbers from a file with a just a number on each line, find the

2−-- minimum of those numbers. The file contains different kinds of numbers:

3−--

4−-- * Decimals

5−--

6−-- * Hexadecimals

7−--

8−-- * Floating point numbers

9−--

10−-- * Floating point numbers in scientific notation

11−--

12−-- The different benchmarks will only take into account the values they can

13−-- parse.

14−--

15−-- Tested in this benchmark:

16−--

17−-- * Lexing/parsing of different numerical types

18−--

19−module Benchmarks.ReadNumbers

20− ( benchmark

21− ) where

22−

23−import Criterion (Benchmark, bgroup, bench, whnf)

24−import Data.List (foldl')

25−import Numeric (readDec, readFloat, readHex)

26−import qualified Data.ByteString.Char8 as B

27−import qualified Data.ByteString.Lazy.Char8 as BL

28−import qualified Data.ByteString.Lex.Fractional as B

29−import qualified Data.Text as T

30−import qualified Data.Text.IO as T

31−import qualified Data.Text.Lazy as TL

32−import qualified Data.Text.Lazy.IO as TL

33−import qualified Data.Text.Lazy.Read as TL

34−import qualified Data.Text.Read as T

35−

36−benchmark :: FilePath -> IO Benchmark

37−benchmark fp = do

38− -- Read all files into lines: string, text, lazy text, bytestring, lazy

39− -- bytestring

40− s <- lines `fmap` readFile fp

41− t <- T.lines `fmap` T.readFile fp

42− tl <- TL.lines `fmap` TL.readFile fp

43− b <- B.lines `fmap` B.readFile fp

44− bl <- BL.lines `fmap` BL.readFile fp

45− return $ bgroup "ReadNumbers"

46− [ bench "DecimalString" $ whnf (int . string readDec) s

47− , bench "HexadecimalString" $ whnf (int . string readHex) s

48− , bench "DoubleString" $ whnf (double . string readFloat) s

49−

50− , bench "DecimalText" $ whnf (int . text (T.signed T.decimal)) t

51− , bench "HexadecimalText" $ whnf (int . text (T.signed T.hexadecimal)) t

52− , bench "DoubleText" $ whnf (double . text T.double) t

53− , bench "RationalText" $ whnf (double . text T.rational) t

54−

55− , bench "DecimalLazyText" $

56− whnf (int . text (TL.signed TL.decimal)) tl

57− , bench "HexadecimalLazyText" $

58− whnf (int . text (TL.signed TL.hexadecimal)) tl

59− , bench "DoubleLazyText" $

60− whnf (double . text TL.double) tl

61− , bench "RationalLazyText" $

62− whnf (double . text TL.rational) tl

63−

64− , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b

65− , bench "DoubleByteString" $ whnf (double . byteString B.readDecimal) b

66−

67− , bench "DecimalLazyByteString" $

68− whnf (int . byteString BL.readInt) bl

69− ]

70− where

71− -- Used for fixing types

72− int :: Int -> Int

73− int = id

74− double :: Double -> Double

75− double = id

76−

77−string :: (Ord a, Num a) => (t -> [(a, t)]) -> [t] -> a

78−string reader = foldl' go 1000000

79− where

80− go z t = case reader t of [(n, _)] -> min n z

81− _ -> z

82−

83−text :: (Ord a, Num a) => (t -> Either String (a,t)) -> [t] -> a

84−text reader = foldl' go 1000000

85− where

86− go z t = case reader t of Left _ -> z

87− Right (n, _) -> min n z

88−

89−byteString :: (Ord a, Num a) => (t -> Maybe (a,t)) -> [t] -> a

90−byteString reader = foldl' go 1000000

91− where

92− go z t = case reader t of Nothing -> z

93− Just (n, _) -> min n z

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/Benchmarks/Search.hsdeleted−48

@@ -1,48 +0,0 @@

1−-- | Search for a pattern in a file, find the number of occurences

2−--

3−-- Tested in this benchmark:

4−--

5−-- * Searching all occurences of a pattern using library routines

6−--

7−module Benchmarks.Search

8− ( benchmark

9− ) where

10−

11−import Criterion (Benchmark, bench, bgroup, whnf)

12−import qualified Data.ByteString as B

13−import qualified Data.ByteString.Lazy as BL

14−import qualified Data.ByteString.Lazy.Search as BL

15−import qualified Data.ByteString.Search as B

16−import qualified Data.Text as T

17−import qualified Data.Text.Encoding as T

18−import qualified Data.Text.IO as T

19−import qualified Data.Text.Lazy as TL

20−import qualified Data.Text.Lazy.IO as TL

21−

22−benchmark :: FilePath -> T.Text -> IO Benchmark

23−benchmark fp needleT = do

24− b <- B.readFile fp

25− bl <- BL.readFile fp

26− t <- T.readFile fp

27− tl <- TL.readFile fp

28− return $ bgroup "FileIndices"

29− [ bench "ByteString" $ whnf (byteString needleB) b

30− , bench "LazyByteString" $ whnf (lazyByteString needleB) bl

31− , bench "Text" $ whnf (text needleT) t

32− , bench "LazyText" $ whnf (lazyText needleTL) tl

33− ]

34− where

35− needleB = T.encodeUtf8 needleT

36− needleTL = TL.fromChunks [needleT]

37−

38−byteString :: B.ByteString -> B.ByteString -> Int

39−byteString needle = length . B.indices needle

40−

41−lazyByteString :: B.ByteString -> BL.ByteString -> Int

42−lazyByteString needle = length . BL.indices needle

43−

44−text :: T.Text -> T.Text -> Int

45−text = T.count

46−

47−lazyText :: TL.Text -> TL.Text -> Int

48−lazyText needle = fromIntegral . TL.count needle

benchmarks/haskell/Benchmarks/Stream.hsdeleted−104

@@ -1,104 +0,0 @@

1−-- | This module contains a number of benchmarks for the different streaming

2−-- functions

3−--

4−-- Tested in this benchmark:

5−--

6−-- * Most streaming functions

7−--

8−{-# LANGUAGE BangPatterns #-}

9−{-# OPTIONS_GHC -fno-warn-orphans #-}

10−module Benchmarks.Stream

11− ( benchmark

12− ) where

13−

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

15−import Criterion (Benchmark, bgroup, bench, nf)

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

17−import qualified Data.Text.Encoding as T

18−import 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

22−import qualified Data.Text.IO as T

23−import 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

26−import qualified Data.Text.Lazy.IO as TL

27−

28−instance NFData a => NFData (Stream a) where

29− -- Currently, this implementation does not force evaluation of the size hint

30− rnf (Stream next s0 _) = go s0

31− where

32− go !s = case next s of

33− Done -> ()

34− Skip s' -> go s'

35− Yield x s' -> rnf x `seq` go s'

36−

37−benchmark :: FilePath -> IO Benchmark

38−benchmark fp = do

39− -- Different formats

40− t <- T.readFile fp

41− let !utf8 = T.encodeUtf8 t

42− !utf16le = T.encodeUtf16LE t

43− !utf16be = T.encodeUtf16BE t

44− !utf32le = T.encodeUtf32LE t

45− !utf32be = T.encodeUtf32BE t

46−

47− -- Once again for the lazy variants

48− tl <- TL.readFile fp

49− let !utf8L = TL.encodeUtf8 tl

50− !utf16leL = TL.encodeUtf16LE tl

51− !utf16beL = TL.encodeUtf16BE tl

52− !utf32leL = TL.encodeUtf32LE tl

53− !utf32beL = TL.encodeUtf32BE tl

54−

55− -- For the functions which operate on streams

56− let !s = F.stream t

57−

58− return $ bgroup "Stream"

59−

60− -- Fusion

61− [ 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

75− ]

76−

77− -- Encoding.Fusion

78− , bgroup "streamUtf8"

79− [ bench "Text" $ nf (T.streamUtf8 E.lenientDecode) utf8

80− , bench "LazyText" $ nf (TL.streamUtf8 E.lenientDecode) utf8L

81− ]

82− , bgroup "streamUtf16LE"

83− [ bench "Text" $ nf (T.streamUtf16LE E.lenientDecode) utf16le

84− , bench "LazyText" $ nf (TL.streamUtf16LE E.lenientDecode) utf16leL

85− ]

86− , bgroup "streamUtf16BE"

87− [ bench "Text" $ nf (T.streamUtf16BE E.lenientDecode) utf16be

88− , bench "LazyText" $ nf (TL.streamUtf16BE E.lenientDecode) utf16beL

89− ]

90− , bgroup "streamUtf32LE"

91− [ bench "Text" $ nf (T.streamUtf32LE E.lenientDecode) utf32le

92− , bench "LazyText" $ nf (TL.streamUtf32LE E.lenientDecode) utf32leL

93− ]

94− , bgroup "streamUtf32BE"

95− [ bench "Text" $ nf (T.streamUtf32BE E.lenientDecode) utf32be

96− , bench "LazyText" $ nf (TL.streamUtf32BE E.lenientDecode) utf32beL

97− ]

98−

99− -- Encoding.Fusion.Common

100− , bench "restreamUtf16LE" $ nf F.restreamUtf16LE s

101− , bench "restreamUtf16BE" $ nf F.restreamUtf16BE s

102− , bench "restreamUtf32LE" $ nf F.restreamUtf32LE s

103− , bench "restreamUtf32BE" $ nf F.restreamUtf32BE s

104− ]

benchmarks/haskell/Benchmarks/WordFrequencies.hsdeleted−36

@@ -1,36 +0,0 @@

1−-- | A word frequency count using the different string types

2−--

3−-- Tested in this benchmark:

4−--

5−-- * Splitting into words

6−--

7−-- * Converting to lowercase

8−--

9−-- * Comparing: Eq/Ord instances

10−--

11−module Benchmarks.WordFrequencies

12− ( benchmark

13− ) where

14−

15−import Criterion (Benchmark, bench, bgroup, whnf)

16−import Data.Char (toLower)

17−import Data.List (foldl')

18−import Data.Map (Map)

19−import qualified Data.ByteString.Char8 as B

20−import qualified Data.Map as M

21−import qualified Data.Text as T

22−import qualified Data.Text.IO as T

23−

24−benchmark :: FilePath -> IO Benchmark

25−benchmark fp = do

26− s <- readFile fp

27− b <- B.readFile fp

28− t <- T.readFile fp

29− return $ bgroup "WordFrequencies"

30− [ bench "String" $ whnf (frequencies . words . map toLower) s

31− , bench "ByteString" $ whnf (frequencies . B.words . B.map toLower) b

32− , bench "Text" $ whnf (frequencies . T.words . T.toLower) t

33− ]

34−

35−frequencies :: Ord a => [a] -> Map a Int

36−frequencies = foldl' (\m k -> M.insertWith (+) k 1 m) M.empty

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/.gitignoredeleted−2

@@ -1,2 +0,0 @@

1−__pycache__

2−*.pyc

benchmarks/python/cut.pydeleted−12

@@ -1,12 +0,0 @@

1−#!/usr/bin/env python

2−

3−import utils, sys, codecs

4−

5−def cut(filename, l, r):

6− content = open(filename, encoding='utf-8')

7− for line in content:

8− print(line[l:r])

9−

10−for f in sys.argv[1:]:

11− t = utils.benchmark(lambda: cut(f, 20, 40))

12− sys.stderr.write('{0}: {1}\n'.format(f, t))

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/python/sort.pydeleted−13

@@ -1,13 +0,0 @@

1−#!/usr/bin/env python

2−

3−import utils, sys, codecs

4−

5−def sort(filename):

6− content = open(filename, encoding='utf-8').read()

7− lines = content.splitlines()

8− lines.sort()

9− print('\n'.join(lines))

10−

11−for f in sys.argv[1:]:

12− t = utils.benchmark(lambda: sort(f))

13− sys.stderr.write('{0}: {1}\n'.format(f, t))

benchmarks/python/strip_tags.pydeleted−25

@@ -1,25 +0,0 @@

1−#!/usr/bin/env python

2−

3−import utils, sys

4−

5−def strip_tags(filename):

6− string = open(filename, encoding='utf-8').read()

7−

8− d = 0

9− out = []

10−

11− for c in string:

12− if c == '<': d += 1

13−

14− if d > 0:

15− out += ' '

16− else:

17− out += c

18−

19− if c == '>': d -= 1

20−

21− print(''.join(out))

22−

23−for f in sys.argv[1:]:

24− t = utils.benchmark(lambda: strip_tags(f))

25− sys.stderr.write('{0}: {1}\n'.format(f, t))

benchmarks/python/utils.pydeleted−18

@@ -1,18 +0,0 @@

1−#!/usr/bin/env python

2−

3−import sys, time

4−

5−def benchmark_once(f):

6− start = time.time()

7− f()

8− end = time.time()

9− return end - start

10−

11−def benchmark(f):

12− runs = 100

13− total = 0.0

14− for i in range(runs):

15− result = benchmark_once(f)

16− sys.stderr.write('Run {0}: {1}\n'.format(i, result))

17− total += result

18− return total / runs

benchmarks/ruby/cut.rbdeleted−16

@@ -1,16 +0,0 @@

1−#!/usr/bin/env ruby

2−

3−require './utils.rb'

4−

5−def cut(filename, l, r)

6− File.open(filename, 'r:utf-8') do |file|

7− file.each_line do |line|

8− puts line[l, r - l]

9− end

10− end

11−end

12−

13−ARGV.each do |f|

14− t = benchmark { cut(f, 20, 40) }

15− STDERR.puts "#{f}: #{t}"

16−end

benchmarks/ruby/fold.rbdeleted−50

@@ -1,50 +0,0 @@

1−#!/usr/bin/env ruby

2−

3−require './utils.rb'

4−

5−def fold(filename, max_width)

6− File.open(filename, 'r:utf-8') do |file|

7− # Words in this paragraph

8− paragraph = []

9−

10− file.each_line do |line|

11− # If we encounter an empty line, we reformat and dump the current

12− # paragraph

13− if line.strip.empty?

14− puts fold_paragraph(paragraph, max_width)

15− puts

16− paragraph = []

17− # Otherwise, we append the words found in the line to the paragraph

18− else

19− paragraph.concat line.split

20− end

21− end

22−

23− # Last paragraph

24− puts fold_paragraph(paragraph, max_width) unless paragraph.empty?

25− end

26−end

27−

28−# Fold a single paragraph to the desired width

29−def fold_paragraph(paragraph, max_width)

30− # Gradually build our output

31− str, *rest = paragraph

32− width = str.length

33−

34− rest.each do |word|

35− if width + word.length + 1 <= max_width

36− str << ' ' << word

37− width += word.length + 1

38− else

39− str << "\n" << word

40− width = word.length

41− end

42− end

43−

44− str

45−end

46−

47−ARGV.each do |f|

48− t = benchmark { fold(f, 80) }

49− STDERR.puts "#{f}: #{t}"

50−end

benchmarks/ruby/sort.rbdeleted−15

@@ -1,15 +0,0 @@

1−#!/usr/bin/env ruby

2−

3−require './utils.rb'

4−

5−def sort(filename)

6− File.open(filename, 'r:utf-8') do |file|

7− content = file.read

8− puts content.lines.sort.join

9− end

10−end

11−

12−ARGV.each do |f|

13− t = benchmark { sort(f) }

14− STDERR.puts "#{f}: #{t}"

15−end

benchmarks/ruby/strip_tags.rbdeleted−22

@@ -1,22 +0,0 @@

1−#!/usr/bin/env ruby

2−

3−require './utils.rb'

4−

5−def strip_tags(filename)

6− File.open(filename, 'r:utf-8') do |file|

7− str = file.read

8−

9− d = 0

10−

11− str.each_char do |c|

12− d += 1 if c == '<'

13− putc(if d > 0 then ' ' else c end)

14− d -= 1 if c == '>'

15− end

16− end

17−end

18−

19−ARGV.each do |f|

20− t = benchmark { strip_tags(f) }

21− STDERR.puts "#{f}: #{t}"

22−end

benchmarks/ruby/utils.rbdeleted−14

@@ -1,14 +0,0 @@

1−require 'benchmark'

2−

3−def benchmark(&block)

4− runs = 100

5− total = 0

6−

7− runs.times do |i|

8− result = Benchmark.measure(&block).total

9− $stderr.puts "Run #{i}: #{result}"

10− total += result

11− end

12−

13− total / runs

14−end

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.cdeleted−311

@@ -1,311 +0,0 @@

1−/*

3− *

5− *

6− * See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.

7− */

8−

9−#include <string.h>

10−#include <stdint.h>

11−#include <stdio.h>

12−#include "text_cbits.h"

13−

14−void _hs_text_memcpy(void *dest, size_t doff, const void *src, size_t soff,

15− size_t n)

16−{

17− memcpy(dest + (doff<<1), src + (soff<<1), n<<1);

18−}

19−

20−int _hs_text_memcmp(const void *a, size_t aoff, const void *b, size_t boff,

21− size_t n)

22−{

23− return memcmp(a + (aoff<<1), b + (boff<<1), n<<1);

24−}

25−

26−#define UTF8_ACCEPT 0

27−#define UTF8_REJECT 12

28−

29−static const uint8_t utf8d[] = {

30− /*

31− * The first part of the table maps bytes to character classes that

32− * to reduce the size of the transition table and create bitmasks.

33− */

34− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

35− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

36− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

37− 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,

38− 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1, 9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,

39− 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7, 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,

40− 8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2, 2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,

41− 10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8,

42−

43− /*

44− * The second part is a transition table that maps a combination of

45− * a state of the automaton and a character class to a state.

46− */

47− 0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,

48− 12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,

49− 12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,

50− 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,

52−};

53−

54−static inline uint32_t

55−decode(uint32_t *state, uint32_t* codep, uint32_t byte) {

56− uint32_t type = utf8d[byte];

57−

58− *codep = (*state != UTF8_ACCEPT) ?

59− (byte & 0x3fu) | (*codep << 6) :

60− (0xff >> type) & (byte);

61−

62− return *state = utf8d[256 + *state + type];

63−}

64−

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−

103−/*

104− * A best-effort decoder. Runs until it hits either end of input or

105− * the start of an invalid byte sequence.

106− *

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− *

129− */

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)

142−{

143− uint16_t *d = dest + *destoff;

144− const uint8_t *s = *src, *last = *src;

145− uint32_t state = *state0;

146− uint32_t codepoint = *codepoint0;

147−

148− while (s < srcend) {

149−#if defined(__i386__) || defined(__x86_64__)

150− /*

151− * This code will only work on a little-endian system that

152− * supports unaligned loads.

153− *

154− * It gives a substantial speed win on data that is purely or

155− * partly ASCII (e.g. HTML), at only a slight cost on purely

156− * non-ASCII text.

157− */

158−

159− if (state == UTF8_ACCEPT) {

160− while (s < srcend - 4) {

161− codepoint = *((uint32_t *) s);

162− if ((codepoint & 0x80808080) != 0)

163− break;

164− s += 4;

165−

166− /*

167− * Tried 32-bit stores here, but the extra bit-twiddling

168− * slowed the code down.

169− */

170−

171− *d++ = (uint16_t) (codepoint & 0xff);

172− *d++ = (uint16_t) ((codepoint >> 8) & 0xff);

173− *d++ = (uint16_t) ((codepoint >> 16) & 0xff);

174− *d++ = (uint16_t) ((codepoint >> 24) & 0xff);

175− }

176− last = s;

177− }

178−#endif

179−

180− if (decode(&state, &codepoint, *s++) != UTF8_ACCEPT) {

181− if (state != UTF8_REJECT)

182− continue;

183− break;

184− }

185−

186− if (codepoint <= 0xffff)

187− *d++ = (uint16_t) codepoint;

188− else {

189− *d++ = (uint16_t) (0xD7C0 + (codepoint >> 10));

190− *d++ = (uint16_t) (0xDC00 + (codepoint & 0x3FF));

191− }

192− last = s;

193− }

194−

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 */

228− 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;

242−

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− }

309−

310− *destp = dest;

311−}

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/ApiCompare.hs+2−6

@@ -17,12 +17,8 @@ main = do

1717 S.difference a b

1818 text <- tidy "Data.Text"

1919 lazy <- tidy "Data.Text.Lazy"

20− list <- tidy "Data.List"

21− putStrLn "Text \\ List:"

22− diff text list

23− putStrLn ""

24− putStrLn "Text \\ Lazy:"

20+ putStrLn "In Data.Text:"

2521 diff text lazy

2622 putStrLn ""

27− putStrLn "Lazy \\ Text:"

23+ putStrLn "In Data.Text.Lazy:"

2824 diff lazy text

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

44

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

44

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/.ghcideleted−1

@@ -1 +0,0 @@

1−:set -DHAVE_DEEPSEQ -isrc -i../..

tests/Benchmarks.hsnew file+441

@@ -0,0 +1,441 @@

1+{-# LANGUAGE BangPatterns, GADTs, MagicHash #-}

2+

3+import qualified Data.ByteString.Char8 as BS

4+import qualified Data.ByteString.Lazy.Char8 as BL

5+import qualified Data.ByteString.Lazy.Internal as BL

6+import Control.Monad.Trans (liftIO)

7+import Control.Exception (evaluate)

8+import Criterion.Main

9+import Data.Char

10+import Data.Monoid (mappend, mempty)

11+import qualified Codec.Binary.UTF8.Generic as UTF8

12+import qualified Data.Text as TS

13+import qualified Data.Text.IO as TS

14+import qualified Data.Text.Lazy as TL

15+import qualified Data.Text.Lazy.Builder as TB

16+import qualified Data.Text.Lazy.IO as TL

17+import qualified Data.List as L

18+import qualified Data.Text.Encoding as TS

19+import qualified Data.Text.Lazy.Encoding as TL

20+import qualified Criterion.MultiMap as M

21+import Control.DeepSeq

22+import Criterion.Config

23+import GHC.Base

24+

25+

26+myConfig

27+ | False = defaultConfig {

28+ -- Always display an 800x600 window.

29+ cfgPlot = M.singleton KernelDensity (Window 800 600)

30+ }

31+ | otherwise = defaultConfig

32+

33+instance NFData BS.ByteString

34+

35+instance NFData BL.ByteString where

36+ rnf BL.Empty = ()

37+ rnf (BL.Chunk _ ts) = rnf ts

38+

39+data B where

40+ B :: NFData a => a -> B

41+

42+instance NFData B where

43+ rnf (B b) = rnf b

44+

45+main = do

46+ let dataFile = "text/test/russian.txt"

47+ bsa <- BS.readFile dataFile

48+ let tsa = TS.decodeUtf8 bsa

49+ tsb = TS.toUpper tsa

50+ tla = TL.fromChunks (TS.chunksOf 16376 tsa)

51+ tlb = TL.fromChunks (TS.chunksOf 16376 tsb)

52+ bsb = TS.encodeUtf8 tsb

53+ bla = BL.fromChunks (chunksOf 16376 bsa)

54+ blb = BL.fromChunks (chunksOf 16376 bsb)

55+ bsa_len = BS.length bsa

56+ tsa_len = TS.length tsa

57+ bla_len = BL.length bla

58+ tla_len = TL.length tla

59+ la = UTF8.toString bsa

60+ la_len = L.length la

61+ tsb_len = TS.length tsb

62+ lb = TS.unpack tsb

63+ bsl = BS.lines bsa

64+ bll = BL.lines bla

65+ tsl = TS.lines tsa

66+ tll = TL.lines tla

67+ ll = L.lines la

68+ defaultMainWith

69+ myConfig

70+ (liftIO . evaluate $

71+ rnf [B tsa, B tsb, B tla, B tlb, B bsa, B bsb, B bla, B blb,

72+ B bsa_len, B tsa_len, B bla_len, B tla_len, B la, B la_len,

73+ B tsb_len, B lb, B bsl, B bll, B tsl, B tll, B ll])

74+ [

75+ bgroup "append" [

76+ bench "ts" $ nf (TS.append tsb) tsa

77+ , bench "tl" $ nf (TL.append tlb) tla

78+ , bench "bs" $ nf (BS.append bsb) bsa

79+ , bench "bl" $ nf (BL.append blb) bla

80+ , bench "l" $ nf ((++) lb) la

81+ ],

82+ bgroup "concat" [

83+ bench "ts" $ nf TS.concat tsl

84+ , bench "tl" $ nf TL.concat tll

85+ , bench "bs" $ nf BS.concat bsl

86+ , bench "bl" $ nf BL.concat bll

87+ , bench "l" $ nf L.concat ll

88+ ],

89+ bgroup "cons" [

90+ bench "ts" $ nf (TS.cons c) tsa

91+ , bench "tl" $ nf (TL.cons c) tla

92+ , bench "bs" $ nf (BS.cons c) bsa

93+ , bench "bl" $ nf (BL.cons c) bla

94+ , bench "l" $ nf (c:) la

95+ ],

96+ bgroup "concatMap" [

97+ bench "ts" $ nf (TS.concatMap (TS.replicate 3 . TS.singleton)) tsa

98+ , bench "tl" $ nf (TL.concatMap (TL.replicate 3 . TL.singleton)) tla

99+ , bench "bs" $ nf (BS.concatMap (BS.replicate 3)) bsa

100+ , bench "bl" $ nf (BL.concatMap (BL.replicate 3)) bla

101+ , bench "l" $ nf (L.concatMap (L.replicate 3 . (:[]))) la

102+ ],

103+ bgroup "decode" [

104+ bench "ts" $ nf TS.decodeUtf8 bsa

105+ , bench "tl" $ nf TL.decodeUtf8 bla

106+ , bench "bs" $ nf BS.unpack bsa

107+ , bench "bl" $ nf BL.unpack bla

108+ , bench "l" $ nf UTF8.toString bsa

109+ ],

110+ bgroup "drop" [

111+ bench "ts" $ nf (TS.drop (tsa_len `div` 3)) tsa

112+ , bench "tl" $ nf (TL.drop (tla_len `div` 3)) tla

113+ , bench "bs" $ nf (BS.drop (bsa_len `div` 3)) bsa

114+ , bench "bl" $ nf (BL.drop (bla_len `div` 3)) bla

115+ , bench "l" $ nf (L.drop (la_len `div` 3)) la

116+ ],

117+ bgroup "filter" [

118+ bench "ts" $ nf (TS.filter p0) tsa

119+ , bench "tl" $ nf (TL.filter p0) tla

120+ , bench "bs" $ nf (BS.filter p0) bsa

121+ , bench "bl" $ nf (BL.filter p0) bla

122+ , bench "l" $ nf (L.filter p0) la

123+ ],

124+ bgroup "filter.filter" [

125+ bench "ts" $ nf (TS.filter p1 . TS.filter p0) tsa

126+ , bench "tl" $ nf (TL.filter p1 . TL.filter p0) tla

127+ , bench "bs" $ nf (BS.filter p1 . BS.filter p0) bsa

128+ , bench "bl" $ nf (BL.filter p1 . BL.filter p0) bla

129+ , bench "l" $ nf (L.filter p1 . L.filter p0) la

130+ ],

131+ bgroup "foldl'" [

132+ bench "ts" $ nf (TS.foldl' len 0) tsa

133+ , bench "tl" $ nf (TL.foldl' len 0) tla

134+ , bench "bs" $ nf (BS.foldl' len 0) bsa

135+ , bench "bl" $ nf (BL.foldl' len 0) bla

136+ , bench "l" $ nf (L.foldl' len 0) la

137+ ],

138+ bgroup "foldr" [

139+ bench "ts" $ nf (L.length . TS.foldr (:) []) tsa

140+ , bench "tl" $ nf (L.length . TL.foldr (:) []) tla

141+ , bench "bs" $ nf (L.length . BS.foldr (:) []) bsa

142+ , bench "bl" $ nf (L.length . BL.foldr (:) []) bla

143+ , bench "l" $ nf (L.length . L.foldr (:) []) la

144+ ],

145+ bgroup "head" [

146+ bench "ts" $ nf TS.head tsa

147+ , bench "tl" $ nf TL.head tla

148+ , bench "bs" $ nf BS.head bsa

149+ , bench "bl" $ nf BL.head bla

150+ , bench "l" $ nf L.head la

151+ ],

152+ bgroup "init" [

153+ bench "ts" $ nf TS.init tsa

154+ , bench "tl" $ nf TL.init tla

155+ , bench "bs" $ nf BS.init bsa

156+ , bench "bl" $ nf BL.init bla

157+ , bench "l" $ nf L.init la

158+ ],

159+ bgroup "intercalate" [

160+ bench "ts" $ nf (TS.intercalate tsw) tsl

161+ , bench "tl" $ nf (TL.intercalate tlw) tll

162+ , bench "bs" $ nf (BS.intercalate bsw) bsl

163+ , bench "bl" $ nf (BL.intercalate blw) bll

164+ , bench "l" $ nf (L.intercalate lw) ll

165+ ],

166+ bgroup "intersperse" [

167+ bench "ts" $ nf (TS.intersperse c) tsa

168+ , bench "tl" $ nf (TL.intersperse c) tla

169+ , bench "bs" $ nf (BS.intersperse c) bsa

170+ , bench "bl" $ nf (BL.intersperse c) bla

171+ , bench "l" $ nf (L.intersperse c) la

172+ ],

173+ bgroup "isInfixOf" [

174+ bench "ts" $ nf (TS.isInfixOf tsw) tsa

175+ , bench "tl" $ nf (TL.isInfixOf tlw) tla

176+ , bench "bs" $ nf (BS.isInfixOf bsw) bsa

177+ -- no isInfixOf for lazy bytestrings

178+ , bench "l" $ nf (L.isInfixOf lw) la

179+ ],

180+ bgroup "last" [

181+ bench "ts" $ nf TS.last tsa

182+ , bench "tl" $ nf TL.last tla

183+ , bench "bs" $ nf BS.last bsa

184+ , bench "bl" $ nf BL.last bla

185+ , bench "l" $ nf L.last la

186+ ],

187+ bgroup "map" [

188+ bench "ts" $ nf (TS.map f) tsa

189+ , bench "tl" $ nf (TL.map f) tla

190+ , bench "bs" $ nf (BS.map f) bsa

191+ , bench "bl" $ nf (BL.map f) bla

192+ , bench "l" $ nf (L.map f) la

193+ ],

194+ bgroup "map.map" [

195+ bench "ts" $ nf (TS.map f . TS.map f) tsa

196+ , bench "tl" $ nf (TL.map f . TL.map f) tla

197+ , bench "bs" $ nf (BS.map f . BS.map f) bsa

198+ , bench "bl" $ nf (BL.map f . BL.map f) bla

199+ , bench "l" $ nf (L.map f . L.map f) la

200+ ],

201+ bgroup "readFile" [

202+ bench "ts" $ TS.readFile dataFile

203+ , bench "tl" $ nfIO (TL.readFile dataFile)

204+ , bench "bs" $ BS.readFile dataFile

205+ , bench "bl" $ nfIO (BL.length `fmap` BL.readFile dataFile)

206+ , bench "l" $ nfIO (length `fmap` readFile dataFile)

207+ ],

208+ bgroup "replicate char" [

209+ bench "ts" $ nf (TS.replicate bsa_len) (TS.singleton c)

210+ , bench "tl" $ nf (TL.replicate (fromIntegral bsa_len)) (TL.singleton c)

211+ , bench "bs" $ nf (BS.replicate bsa_len) c

212+ , bench "bl" $ nf (BL.replicate (fromIntegral bsa_len)) c

213+ , bench "l" $ nf (L.replicate bsa_len) c

214+ ],

215+ bgroup "replicate string" [

216+ bench "ts" $ nf (TS.replicate (bsa_len `div` TS.length tsw)) tsw

217+ , bench "tl" $ nf (TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw

218+ , bench "l" $ nf (replicat (bsa_len `div` TS.length tsw)) lw

219+ ],

220+ bgroup "reverse" [

221+ bench "ts" $ nf TS.reverse tsa

222+ , bench "tl" $ nf TL.reverse tla

223+ , bench "bs" $ nf BS.reverse bsa

224+ , bench "bl" $ nf BL.reverse bla

225+ , bench "l" $ nf L.reverse la

226+ ],

227+ bgroup "take" [

228+ bench "ts" $ nf (TS.take (tsa_len `div` 3)) tsa

229+ , bench "tl" $ nf (TL.take (tla_len `div` 3)) tla

230+ , bench "bs" $ nf (BS.take (bsa_len `div` 3)) bsa

231+ , bench "bl" $ nf (BL.take (bla_len `div` 3)) bla

232+ , bench "l" $ nf (L.take (la_len `div` 3)) la

233+ ],

234+ bgroup "tail" [

235+ bench "ts" $ nf TS.tail tsa

236+ , bench "tl" $ nf TL.tail tla

237+ , bench "bs" $ nf BS.tail bsa

238+ , bench "bl" $ nf BL.tail bla

239+ , bench "l" $ nf L.tail la

240+ ],

241+ bgroup "toLower" [

242+ bench "ts" $ nf TS.toLower tsa

243+ , bench "tl" $ nf TL.toLower tla

244+ , bench "bs" $ nf (BS.map toLower) bsa

245+ , bench "bl" $ nf (BL.map toLower) bla

246+ , bench "l" $ nf (L.map toLower) la

247+ ],

248+ bgroup "toUpper" [

249+ bench "ts" $ nf TS.toUpper tsa

250+ , bench "tl" $ nf TL.toUpper tla

251+ , bench "bs" $ nf (BS.map toUpper) bsa

252+ , bench "bl" $ nf (BL.map toUpper) bla

253+ , bench "l" $ nf (L.map toUpper) la

254+ ],

255+ bgroup "words" [

256+ bench "ts" $ nf TS.words tsa

257+ , bench "tl" $ nf TL.words tla

258+ , bench "bs" $ nf BS.words bsa

259+ , bench "bl" $ nf BL.words bla

260+ , bench "l" $ nf L.words la

261+ ],

262+ bgroup "zipWith" [

263+ bench "ts" $ nf (TS.zipWith min tsb) tsa

264+ , bench "tl" $ nf (TL.zipWith min tlb) tla

265+ , bench "bs" $ nf (BS.zipWith min bsb) bsa

266+ , bench "bl" $ nf (BL.zipWith min blb) bla

267+ , bench "l" $ nf (L.zipWith min lb) la

268+ ],

269+ bgroup "length" [

270+ bgroup "cons" [

271+ bench "ts" $ nf (TS.length . TS.cons c) tsa

272+ , bench "tl" $ nf (TL.length . TL.cons c) tla

273+ , bench "bs" $ nf (BS.length . BS.cons c) bsa

274+ , bench "bl" $ nf (BL.length . BL.cons c) bla

275+ , bench "l" $ nf (L.length . (:) c) la

276+ ],

277+ bgroup "decode" [

278+ bench "ts" $ nf (TS.length . TS.decodeUtf8) bsa

279+ , bench "tl" $ nf (TL.length . TL.decodeUtf8) bla

280+ , bench "bs" $ nf (L.length . BS.unpack) bsa

281+ , bench "bl" $ nf (L.length . BL.unpack) bla

282+ , bench "utf8-string" $ nf (L.length . UTF8.toString) bsa

283+ ],

284+ bgroup "drop" [

285+ bench "ts" $ nf (TS.length . TS.drop (tsa_len `div` 3)) tsa

286+ , bench "tl" $ nf (TL.length . TL.drop (tla_len `div` 3)) tla

287+ , bench "bs" $ nf (BS.length . BS.drop (bsa_len `div` 3)) bsa

288+ , bench "bl" $ nf (BL.length . BL.drop (bla_len `div` 3)) bla

289+ , bench "l" $ nf (L.length . L.drop (la_len `div` 3)) la

290+ ],

291+ bgroup "filter" [

292+ bench "ts" $ nf (TS.length . TS.filter p0) tsa

293+ , bench "tl" $ nf (TL.length . TL.filter p0) tla

294+ , bench "bs" $ nf (BS.length . BS.filter p0) bsa

295+ , bench "bl" $ nf (BL.length . BL.filter p0) bla

296+ , bench "l" $ nf (L.length . L.filter p0) la

297+ ],

298+ bgroup "filter.filter" [

299+ bench "ts" $ nf (TS.length . TS.filter p1 . TS.filter p0) tsa

300+ , bench "tl" $ nf (TL.length . TL.filter p1 . TL.filter p0) tla

301+ , bench "bs" $ nf (BS.length . BS.filter p1 . BS.filter p0) bsa

302+ , bench "bl" $ nf (BL.length . BL.filter p1 . BL.filter p0) bla

303+ , bench "l" $ nf (L.length . L.filter p1 . L.filter p0) la

304+ ],

305+ bgroup "init" [

306+ bench "ts" $ nf (TS.length . TS.init) tsa

307+ , bench "tl" $ nf (TL.length . TL.init) tla

308+ , bench "bs" $ nf (BS.length . BS.init) bsa

309+ , bench "bl" $ nf (BL.length . BL.init) bla

310+ , bench "l" $ nf (L.length . L.init) la

311+ ],

312+ bgroup "intercalate" [

313+ bench "ts" $ nf (TS.length . TS.intercalate tsw) tsl

314+ , bench "tl" $ nf (TL.length . TL.intercalate tlw) tll

315+ , bench "bs" $ nf (BS.length . BS.intercalate bsw) bsl

316+ , bench "bl" $ nf (BL.length . BL.intercalate blw) bll

317+ , bench "l" $ nf (L.length . L.intercalate lw) ll

318+ ],

319+ bgroup "intersperse" [

320+ bench "ts" $ nf (TS.length . TS.intersperse c) tsa

321+ , bench "tl" $ nf (TL.length . TL.intersperse c) tla

322+ , bench "bs" $ nf (BS.length . BS.intersperse c) bsa

323+ , bench "bl" $ nf (BL.length . BL.intersperse c) bla

324+ , bench "l" $ nf (L.length . L.intersperse c) la

325+ ],

326+ bgroup "map" [

327+ bench "ts" $ nf (TS.length . TS.map f) tsa

328+ , bench "tl" $ nf (TL.length . TL.map f) tla

329+ , bench "bs" $ nf (BS.length . BS.map f) bsa

330+ , bench "bl" $ nf (BL.length . BL.map f) bla

331+ , bench "l" $ nf (L.length . L.map f) la

332+ ],

333+ bgroup "map.map" [

334+ bench "ts" $ nf (TS.length . TS.map f . TS.map f) tsa

335+ , bench "tl" $ nf (TL.length . TL.map f . TL.map f) tla

336+ , bench "bs" $ nf (BS.length . BS.map f . BS.map f) bsa

337+ , bench "l" $ nf (L.length . L.map f . L.map f) la

338+ ],

339+ bgroup "replicate char" [

340+ bench "ts" $ nf (TS.length . TS.replicate bsa_len) (TS.singleton c)

341+ , bench "tl" $ nf (TL.length . TL.replicate (fromIntegral bsa_len)) (TL.singleton c)

342+ , bench "bs" $ nf (BS.length . BS.replicate bsa_len) c

343+ , bench "bl" $ nf (BL.length . BL.replicate (fromIntegral bsa_len)) c

344+ , bench "l" $ nf (L.length . L.replicate bsa_len) c

345+ ],

346+ bgroup "replicate string" [

347+ bench "ts" $ nf (TS.length . TS.replicate (bsa_len `div` TS.length tsw)) tsw

348+ , bench "tl" $ nf (TL.length . TL.replicate (fromIntegral bsa_len `div` TL.length tlw)) tlw

349+ , bench "l" $ nf (L.length . replicat (bsa_len `div` TS.length tsw)) lw

350+ ],

351+ bgroup "take" [

352+ bench "ts" $ nf (TS.length . TS.take (tsa_len `div` 3)) tsa

353+ , bench "tl" $ nf (TL.length . TL.take (tla_len `div` 3)) tla

354+ , bench "bs" $ nf (BS.length . BS.take (bsa_len `div` 3)) bsa

355+ , bench "bl" $ nf (BL.length . BL.take (bla_len `div` 3)) bla

356+ , bench "l" $ nf (L.length . L.take (la_len `div` 3)) la

357+ ],

358+ bgroup "tail" [

359+ bench "ts" $ nf (TS.length . TS.tail) tsa

360+ , bench "tl" $ nf (TL.length . TL.tail) tla

361+ , bench "bs" $ nf (BS.length . BS.tail) bsa

362+ , bench "bl" $ nf (BL.length . BL.tail) bla

363+ , bench "l" $ nf (L.length . L.tail) la

364+ ],

365+ bgroup "toLower" [

366+ bench "ts" $ nf (TS.length . TS.toLower) tsa

367+ , bench "tl" $ nf (TL.length . TL.toLower) tla

368+ , bench "bs" $ nf (BS.length . BS.map toLower) bsa

369+ , bench "bl" $ nf (BL.length . BL.map toLower) bla

370+ , bench "l" $ nf (L.length . L.map toLower) la

371+ ],

372+ bgroup "toUpper" [

373+ bench "ts" $ nf (TS.length . TS.toUpper) tsa

374+ , bench "tl" $ nf (TL.length . TL.toUpper) tla

375+ , bench "bs" $ nf (BS.length . BS.map toUpper) bsa

376+ , bench "bl" $ nf (BL.length . BL.map toUpper) bla

377+ , bench "l" $ nf (L.length . L.map toUpper) la

378+ ],

379+ bgroup "words" [

380+ bench "ts" $ nf (L.length . TS.words) tsa

381+ , bench "tl" $ nf (L.length . TL.words) tla

382+ , bench "bs" $ nf (L.length . BS.words) bsa

383+ , bench "bl" $ nf (L.length . BL.words) bla

384+ , bench "l" $ nf (L.length . L.words) la

385+ ],

386+ bgroup "zipWith" [

387+ bench "ts" $ nf (TS.length . TS.zipWith min tsb) tsa

388+ , bench "tl" $ nf (TL.length . TL.zipWith min tlb) tla

389+ , bench "bs" $ nf (L.length . BS.zipWith min bsb) bsa

390+ , bench "bl" $ nf (L.length . BL.zipWith min blb) bla

391+ , bench "l" $ nf (L.length . L.zipWith min lb) la

392+ ]

393+ ],

394+ bgroup "builder" [

395+ bench "mappend char" $ nf (TL.length . TB.toLazyText . mappendNChar 'a') 10000,

396+ bench "mappend 8 char" $ nf (TL.length . TB.toLazyText . mappend8Char) 'a',

397+ bench "mappend text" $ nf (TL.length . TB.toLazyText . mappendNText short) 10000

398+ ]

399+ ]

400+ where

401+ c = 'й'

402+ p0 = (== c)

403+ p1 = (/= 'д')

404+ lw = "право"

405+ bsw = UTF8.fromString lw

406+ blw = BL.fromChunks [bsw]

407+ tsw = TS.pack lw

408+ tlw = TL.fromChunks [tsw]

409+ f (C# c#) = C# (chr# (ord# c# +# 1#))

410+ len l _ = l + (1::Int)

411+ replicat n = concat . L.replicate n

412+ short = TS.pack "short"

413+

414+chunksOf :: Int -> BS.ByteString -> [BS.ByteString]

415+chunksOf k = go

416+ where

417+ go t = case BS.splitAt k t of

418+ (a,b) | BS.null a -> []

419+ | otherwise -> a : go b

420+

421+mappendNChar :: Char -> Int -> TB.Builder

422+mappendNChar c n = go 0

423+ where

424+ go i

425+ | i < n = TB.singleton c `mappend` go (i+1)

426+ | otherwise = mempty

427+

428+-- Gives more opportunity for inlining and elimination of unnecesary

429+-- bounds checks.

430+mappend8Char :: Char -> TB.Builder

431+mappend8Char c = TB.singleton c `mappend` TB.singleton c `mappend`

432+ TB.singleton c `mappend` TB.singleton c `mappend`

433+ TB.singleton c `mappend` TB.singleton c `mappend`

434+ TB.singleton c `mappend` TB.singleton c

435+

436+mappendNText :: TS.Text -> Int -> TB.Builder

437+mappendNText t n = go 0

438+ where

439+ go i

440+ | i < n = TB.fromText t `mappend` go (i+1)

441+ | otherwise = mempty

tests/Chartem.hsnew file+153

@@ -0,0 +1,153 @@

1+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

2+

3+import Data.Char

4+import Control.Monad (forM_)

5+import Data.Accessor ((^=))

6+import Data.Function

7+import Data.Maybe

8+import Data.List

9+import Debug.Trace

10+import Data.Text (Text)

11+import Data.Text.Encoding (decodeUtf8)

12+import Graphics.Rendering.Chart

13+import Graphics.Rendering.Chart.Gtk (renderableToWindow)

14+import System.Environment (getArgs)

15+import Text.Printf

16+import qualified Data.ByteString as B

17+import qualified Data.Map as M

18+import qualified Data.Text as T

19+

20+data Row = Row {

21+ rowName :: !Text

22+ , rowMean :: !Double

23+ , rowMeanLB :: !Double

24+ , rowMeanUB :: !Double

25+ , rowStdDev :: !Double

26+ , rowStdDevLB :: !Double

27+ , rowStdDevUB :: !Double

28+ } deriving (Show)

29+

30+parseRow :: Text -> Row

31+parseRow = f . T.split ","

32+ where f [n,m,ml,mu,s,sl,su] = Row {

33+ rowName = n

34+ , rowMean = r m

35+ , rowMeanLB = r ml

36+ , rowMeanUB = r mu

37+ , rowStdDev = r s

38+ , rowStdDevLB = r sl

39+ , rowStdDevUB = r su

40+ }

41+ r = read . T.unpack

42+

43+readCSV :: FilePath -> IO [Row]

44+readCSV = fmap (map parseRow . tail . T.lines . decodeUtf8) . B.readFile

45+

46+groupRows :: [Row] -> M.Map Text [Row]

47+groupRows = M.map (sortBy (compare `on` rowName)) . foldr f M.empty

48+ where f r m = let (p,s) = T.breakEnd "/" (rowName r)

49+ in M.insertWith' (++) (T.init . T.tail $ p)

50+ [r { rowName = T.init s}] m

51+

52+main = do

53+ args <- getArgs

54+ groups <- mapM (fmap groupRows . readCSV) args

55+ let dd = M.unionsWith (++) . map (M.map (:[])) $ groups

56+ forM_ (M.toList dd) $ \(tdesc,rows) -> do

57+ let desc = T.unpack tdesc

58+ if False

59+ then renderableToWindow (renderMark desc rows) 400 160

60+ else renderableToPNGFile (renderMark desc rows) 400 160

61+ (printf "time-%s.png" (map clean desc))

62+ where clean '/' = '-'

63+ clean c | isSpace c = '-'

64+ | otherwise = c

65+

66+instance BarsPlotValue LogValue where

67+ barsReference = LogValue 1e-300

68+ barsAdd (LogValue a) (LogValue b) = LogValue (a * b)

69+

70+renderMark :: String -> [[Row]] -> Renderable ()

71+renderMark desc rows

72+ | useLog = toRenderable linLayout

73+ | otherwise = toRenderable logLayout

74+ where

75+ useLog = minimum (map minimum values) >= maximum (map maximum values) / 25

76+ values = transpose . map (map rowMean) $ rows

77+ keys = map git (head rows)

78+ where git r = let n = T.unpack . rowName $ r

79+ in maybe n id . flip lookup mappings $ n

80+ mappings = [("bl", "lazy BS"), ("bs", "strict BS"), ("l", "list"),

81+ ("tl", "lazy T"), ("ts", "strict T")]

82+

83+ linLayout = layout1_title ^= "Timings for \"" ++ desc ++ "\""

84+ $ layout1_plots ^= [ Left (plotBars linBars) ]

85+ $ layout1_left_axis ^= linLeftAxis

86+ $ layout1_bottom_axis ^= bottomAxis

87+ $ defaultLayout1 :: Layout1 Double Double

88+

89+ logLayout = layout1_title ^= "Timings for \"" ++ desc ++

90+ "\" (log scale)"

91+ $ layout1_plots ^= [ Left (plotBars logBars) ]

92+ $ layout1_left_axis ^= logLeftAxis

93+ $ layout1_bottom_axis ^= bottomAxis

94+ $ defaultLayout1 :: Layout1 Double LogValue

95+

96+ logLeftAxis = laxis_generate ^= autoScaledLogAxis logSecAxis

97+ $ laxis_reverse ^= False

98+ $ defaultLayoutAxis

99+

100+ linLeftAxis = laxis_generate ^= autoScaledAxis linSecAxis

101+ $ defaultLayoutAxis

102+

103+ bottomAxis = laxis_generate ^= autoScaledAxis typeAxis

104+ $ defaultLayoutAxis

105+

106+ linBars = plot_bars_values ^= (zip [0.5,1.5..] values)

107+ $ defaultPlotBars

108+

109+ logBars = plot_bars_values ^= (zip [0.5,1.5..] . map (map LogValue) $ values)

110+ $ defaultPlotBars

111+

112+ typeAxis = la_labelf ^= (ix keys . floor)

113+ $ la_nLabels ^= length keys

114+ $ defaultLinearAxis

115+

116+ ix (x:xs) n | n <= 0 = x

117+ | otherwise = ix xs (n-1)

118+ ix [] _ = ""

119+

120+ linSecAxis = la_labelf ^= secs

121+ $ defaultLinearAxis

122+

123+ logSecAxis = loga_labelf ^= (secs . fromLV)

124+ $ defaultLogAxis

125+

126+ fromLV (LogValue v) = v

127+

128+-- | Try to render meaningful time-axis labels.

129+--

130+-- /FIXME/: Trouble is, we need to know the range of times for this to

131+-- work properly, so that we don't accidentally display consecutive

132+-- values that appear identical (e.g. \"43 ms, 43 ms\").

133+secs :: Double -> String

134+secs k

135+ | k < 0 = '-' : secs (-k)

136+ | k >= 1e9 = (k/1e9) `with` "Gs"

137+ | k >= 1e6 = (k/1e6) `with` "Ms"

138+ | k >= 1e4 = (k/1e3) `with` "Ks"

139+ | k >= 1 = k `with` "s"

140+ | k >= 1e-3 = (k*1e3) `with` "ms"

141+ | k >= 1e-6 = (k*1e6) `with` "µs"

142+ | k >= 1e-9 = (k*1e9) `with` "ns"

143+ | k >= 1e-12 = (k*1e12) `with` "ps"

144+ | otherwise = printf "%g s" k

145+ where with (t :: Double) (u :: String)

146+ | t >= 1e9 = printf "%.4g %s" t u

147+ | t >= 1e6 = printf "%.0f %s" t u

148+ | t >= 1e5 = printf "%.0f %s" t u

149+ | t >= 1e4 = printf "%.0f %s" t u

150+ | t >= 1e3 = printf "%.0f %s" t u

151+ | t >= 1e2 = printf "%.0f %s" t u

152+ | t >= 1e1 = printf "%.0f %s" t u

153+ | otherwise = printf "%.0f %s" t u

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/Makefile+70−29

@@ -1,40 +1,81 @@

1−count = 1000

1+version := $(shell awk '/^version:/{print $$2}' ../text.cabal)

2+ghc := ghc

3+ghc-opt-flags = -O0

4+ghc-base-flags := -funbox-strict-fields -package criterion -package deepseq \

5+ -package bytestring -ignore-package text \

6+ -fno-ignore-asserts

7+ghc-test-flags := -package QuickCheck -package test-framework -package deepseq \

8+ -package test-framework-quickcheck2 -package test-framework-hunit \

9+ -package HUnit

10+ghc-base-flags += -Wall -fno-warn-orphans -fno-warn-missing-signatures

11+ghc-flags := $(ghc-base-flags) -i../dist/build -package-name text-$(version)

12+ghc-hpc-flags := $(ghc-base-flags) -fhpc -fno-ignore-asserts -odir hpcdir \

13+ -hidir hpcdir -i..

14+lib := ../dist/build/libHStext-$(version).a

15+lib-srcs := $(shell grep '^ *Data' ../text.cabal | \

16+ sed -e 's,\.,/,g' -e 's,$$,.hs,')

217

3−all: coverage literal-rule-test

18+cabal := $(shell which cabal 2>/dev/null)

419

5−literal-rule-test:

6− ./literal-rule-test.sh

20+all: bm qc coverage regressions

721

8−coverage: build coverage/hpc_index.html

22+lib: $(lib)

923

10−build: text-test-data

11− cabal configure -fhpc

12− cabal build

24+$(lib): $(lib-srcs:%=../%)

25+ifeq ($(cabal),)

26+ cd .. && runghc Setup configure --user --prefix=$(HOME)

27+ cd .. && runghc Setup build

28+else

29+ cd .. && cabal configure

30+ cd .. && cabal build

31+endif

1332

14−text-test-data:

15− hg clone https://bitbucket.org/bos/text-test-data

16− $(MAKE) -C text-test-data

33+Properties.o qc qc-hpc: ghc-flags += $(ghc-test-flags)

34+Properties.o: QuickCheckUtils.o SlowFunctions.o

1735

18−coverage/text-tests.tix:

19− -mkdir -p coverage

20− ./dist/build/text-tests/text-tests -a $(count)

21− mv text-tests.tix $@

36+QuickCheckUtils.o: $(lib)

2237

23−coverage/text-tests-stdio.tix:

24− -mkdir -p coverage

25− ./scripts/cover-stdio.sh ./dist/build/text-tests-stdio/text-tests-stdio

26− mv text-tests-stdio.tix $@

38+qc: Properties.o QuickCheckUtils.o SlowFunctions.o

39+ $(ghc) $(ghc-flags) -threaded -o $@ $^ $(lib)

2740

28−coverage/coverage.tix: coverage/text-tests.tix coverage/text-tests-stdio.tix

29− hpc combine --output=$@ \

30− --exclude=Main \

31− coverage/text-tests.tix \

32− coverage/text-tests-stdio.tix

41+sb: SearchBench.o SlowFunctions.o

42+ $(ghc) $(ghc-flags) -threaded -o $@ $^ $(lib)

3343

34−coverage/hpc_index.html: coverage/coverage.tix

35− hpc markup --destdir=coverage coverage/coverage.tix

44+qc-hpc: Properties.hs QuickCheckUtils.hs $(lib-srcs:%=../%)

45+ -mkdir -p hpcdir

46+ @rm -f $@.tix

47+ $(ghc) $(ghc-hpc-flags) $(ghc-opt-flags) -ihpcdir \

48+ --make -threaded -o $@ $<

3649

37−clean:

38− rm -rf dist coverage .hpc

50+regressions: Regressions.o

51+ $(ghc) $(ghc-test-flags) -o $@ $^ $(lib)

52+

53+coverage: qc-hpc-html/hpc_index.html

54+

55+qc-hpc-html/hpc_index.html: qc-hpc

56+ ./qc-hpc -a 100 +RTS -N2

57+ hpc markup qc-hpc --exclude=Main --exclude=Properties \

58+ --exclude=Data.Text.Fusion.CaseMapping \

59+ --exclude=QuickCheckUtils --srcdir=.. --srcdir=. --destdir=$(dir $@)

60+

61+Benchmarks.o: ghc-opt-flags = -O

62+bm Benchmarks.o: ghc-flags += -hide-package transformers -package utf8-string

63+bm: Benchmarks.o

64+ $(ghc) $(ghc-flags) -o $@ $^ $(lib)

65+

66+SlowFunctions.o: ghc-opt-flags = -O2

67+SearchBench.o: ghc-opt-flags = -O

68+%.o: %.hs

69+ $(ghc) $(ghc-flags) $(ghc-opt-flags) -c -o $@ $<

3970

40−.PHONY: build coverage all literal-rule-test

71+hpcdir/%.o: %.hs

72+ $(ghc) $(ghc-hpc-flags) $(ghc-opt-flags) --make -c -o $@ $<

73+

74+.PHONY: testdata

75+testdata: text-testdata.tar.bz2

76+

77+text-testdata.tar.bz2:

78+ curl -O http://projects.haskell.org/text/text-testdata.tar.bz2

79+

80+clean:

81+ -rm -rf *.o *.hi *.tix bm qc qc-hpc hpcdir .hpc qc-hpc-html

tests/Properties.hsnew file+947

@@ -0,0 +1,947 @@

1+{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,

2+ ScopedTypeVariables, TypeSynonymInstances #-}

3+{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}

4+

5+import Test.QuickCheck

6+import Text.Show.Functions ()

7+

8+import qualified Data.Bits as Bits (shiftL, shiftR)

9+import Data.Char (chr, isLower, isSpace, isUpper, ord)

10+import Data.Monoid (Monoid(..))

11+import Data.String (fromString)

12+import Debug.Trace (trace)

13+import Control.Arrow ((***), second)

14+import Data.Word (Word8, Word16, Word32)

15+import qualified Data.Text as T

16+import qualified Data.Text.Lazy as TL

17+import qualified Data.Text.Lazy.Builder as TB

18+import qualified Data.Text.Encoding as E

19+import Control.Exception (SomeException, evaluate, try)

20+import qualified Data.Text.Fusion as S

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

22+import Data.Text.Fusion.Size

23+import qualified Data.Text.Lazy.Encoding as EL

24+import qualified Data.Text.Lazy.Fusion as SL

25+import qualified Data.Text.UnsafeShift as U

26+import qualified Data.List as L

27+import Prelude hiding (replicate)

28+import System.IO.Unsafe (unsafePerformIO)

29+import Test.Framework (defaultMain, testGroup)

30+import Test.Framework.Providers.QuickCheck2 (testProperty)

31+import Data.Text.Search (indices)

32+import qualified Data.Text.Lazy.Search as S (indices)

33+import qualified SlowFunctions as Slow

34+

35+import QuickCheckUtils (NotEmpty(..), small)

36+

37+-- Ensure that two potentially bottom values (in the sense of crashing

38+-- for some inputs, not looping infinitely) either both crash, or both

39+-- give comparable results for some input.

40+(=^=) :: (Eq a, Show a) => a -> a -> Bool

41+{-# NOINLINE (=^=) #-}

42+i =^= j = unsafePerformIO $ do

43+ x <- try (evaluate i)

44+ y <- try (evaluate j)

45+ case (x,y) of

46+ (Left (_ :: SomeException), Left (_ :: SomeException))

47+ -> return True

48+ (Right a, Right b) -> return (a == b)

49+ e -> trace ("*** Divergence: " ++ show e) return False

50+infix 4 =^=

51+

52+t_pack_unpack = (T.unpack . T.pack) `eq` id

53+tl_pack_unpack = (TL.unpack . TL.pack) `eq` id

54+t_stream_unstream = (S.unstream . S.stream) `eq` id

55+tl_stream_unstream = (SL.unstream . SL.stream) `eq` id

56+t_reverse_stream t = (S.reverse . S.reverseStream) t == t

57+t_singleton c = [c] == (T.unpack . T.singleton) c

58+tl_singleton c = [c] == (TL.unpack . TL.singleton) c

59+tl_unstreamChunks x = f 11 x == f 1000 x

60+ where f n = SL.unstreamChunks n . S.streamList

61+tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id

62+

63+t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a

64+ where a = T.map (\c -> chr (ord c `mod` 128)) t

65+t_utf8 = (E.decodeUtf8 . E.encodeUtf8) `eq` id

66+tl_utf8 = (EL.decodeUtf8 . EL.encodeUtf8) `eq` id

67+t_utf16LE = (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id

68+t_utf16BE = (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id

69+t_utf32LE = (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id

70+t_utf32BE = (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id

71+

72+class Stringy s where

73+ packS :: String -> s

74+ unpackS :: s -> String

75+ splitAtS :: Int -> s -> (s,s)

76+ packSChunkSize :: Int -> String -> s

77+ packSChunkSize _ = packS

78+

79+instance Stringy String where

80+ packS = id

81+ unpackS = id

82+ splitAtS = splitAt

83+

84+instance Stringy (S.Stream Char) where

85+ packS = S.streamList

86+ unpackS = S.unstreamList

87+ splitAtS n s = (S.take n s, S.drop n s)

88+

89+instance Stringy T.Text where

90+ packS = T.pack

91+ unpackS = T.unpack

92+ splitAtS = T.splitAt

93+

94+instance Stringy TL.Text where

95+ packSChunkSize k = SL.unstreamChunks k . S.streamList

96+ packS = TL.pack

97+ unpackS = TL.unpack

98+ splitAtS = TL.splitAt . fromIntegral

99+

100+-- Do two functions give the same answer?

101+eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool

102+eq a b s = a s =^= b s

103+

104+-- What about with the RHS packed?

105+eqP :: (Eq a, Show a, Stringy s) =>

106+ (String -> a) -> (s -> a) -> String -> Word8 -> Bool

107+eqP f g s w = eql "orig" (f s) (g t) &&

108+ eql "mini" (f s) (g mini) &&

109+ eql "head" (f sa) (g ta) &&

110+ eql "tail" (f sb) (g tb)

111+ where t = packS s

112+ mini = packSChunkSize 10 s

113+ (sa,sb) = splitAt m s

114+ (ta,tb) = splitAtS m t

115+ l = length s

116+ m | l == 0 = n

117+ | otherwise = n `mod` l

118+ n = fromIntegral w

119+ eql d a b | a =^= b = True

120+ | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False

121+

122+-- For tests that have O(n^2) running times or input sizes, resize

123+-- their inputs to the square root of the originals.

124+unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property

125+unsquare = forAll . sized $ \n -> resize (smallish n) arbitrary

126+ where smallish = round . (sqrt :: Double -> Double) . fromIntegral

127+

128+s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)

129+ where _types = s :: String

130+sf_Eq p s =

131+ ((L.filter p s==) . L.filter p) `eq`

132+ (((S.filter p $ S.streamList s)==) . S.filter p . S.streamList)

133+t_Eq s = (s==) `eq` ((T.pack s==) . T.pack)

134+tl_Eq s = (s==) `eq` ((TL.pack s==) . TL.pack)

135+s_Ord s = (compare s) `eq` (compare (S.streamList s) . S.streamList)

136+ where _types = s :: String

137+sf_Ord p s =

138+ ((compare $ L.filter p s) . L.filter p) `eq`

139+ (compare (S.filter p $ S.streamList s) . S.filter p . S.streamList)

140+t_Ord s = (compare s) `eq` (compare (T.pack s) . T.pack)

141+tl_Ord s = (compare s) `eq` (compare (TL.pack s) . TL.pack)

142+t_Read = id `eq` (T.unpack . read . show)

143+tl_Read = id `eq` (TL.unpack . read . show)

144+t_Show = show `eq` (show . T.pack)

145+tl_Show = show `eq` (show . TL.pack)

146+t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))

147+tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))

148+t_mconcat = unsquare (mconcat `eq` (unpackS . mconcat . L.map T.pack))

149+tl_mconcat = unsquare (mconcat `eq` (unpackS . mconcat . L.map TL.pack))

150+t_IsString = fromString `eqP` (T.unpack . fromString)

151+tl_IsString = fromString `eqP` (TL.unpack . fromString)

152+

153+s_cons x = (x:) `eqP` (unpackS . S.cons x)

154+s_cons_s x = (x:) `eqP` (unpackS . S.unstream . S.cons x)

155+sf_cons p x = ((x:) . L.filter p) `eqP` (unpackS . S.cons x . S.filter p)

156+t_cons x = (x:) `eqP` (unpackS . T.cons x)

157+tl_cons x = (x:) `eqP` (unpackS . TL.cons x)

158+s_snoc x = (++ [x]) `eqP` (unpackS . (flip S.snoc) x)

159+t_snoc x = (++ [x]) `eqP` (unpackS . (flip T.snoc) x)

160+tl_snoc x = (++ [x]) `eqP` (unpackS . (flip TL.snoc) x)

161+s_append s = (s++) `eqP` (unpackS . S.append (S.streamList s))

162+s_append_s s = (s++) `eqP` (unpackS . S.unstream . S.append (S.streamList s))

163+sf_append p s = (L.filter p s++) `eqP` (unpackS . S.append (S.filter p $ S.streamList s))

164+t_append s = (s++) `eqP` (unpackS . T.append (packS s))

165+

166+uncons (x:xs) = Just (x,xs)

167+uncons _ = Nothing

168+

169+s_uncons = uncons `eqP` (fmap (second unpackS) . S.uncons)

170+sf_uncons p = (uncons . L.filter p) `eqP` (fmap (second unpackS) . S.uncons . S.filter p)

171+t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)

172+tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)

173+s_head = head `eqP` S.head

174+sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)

175+t_head = head `eqP` T.head

176+tl_head = head `eqP` TL.head

177+s_last = last `eqP` S.last

178+sf_last p = (last . L.filter p) `eqP` (S.last . S.filter p)

179+t_last = last `eqP` T.last

180+tl_last = last `eqP` TL.last

181+s_tail = tail `eqP` (unpackS . S.tail)

182+s_tail_s = tail `eqP` (unpackS . S.unstream . S.tail)

183+sf_tail p = (tail . L.filter p) `eqP` (unpackS . S.tail . S.filter p)

184+t_tail = tail `eqP` (unpackS . T.tail)

185+tl_tail = tail `eqP` (unpackS . TL.tail)

186+s_init = init `eqP` (unpackS . S.init)

187+s_init_s = init `eqP` (unpackS . S.unstream . S.init)

188+sf_init p = (init . L.filter p) `eqP` (unpackS . S.init . S.filter p)

189+t_init = init `eqP` (unpackS . T.init)

190+tl_init = init `eqP` (unpackS . TL.init)

191+s_null = null `eqP` S.null

192+sf_null p = (null . L.filter p) `eqP` (S.null . S.filter p)

193+t_null = null `eqP` T.null

194+tl_null = null `eqP` TL.null

195+s_length = length `eqP` S.length

196+sf_length p = (length . L.filter p) `eqP` (S.length . S.filter p)

197+t_length = length `eqP` T.length

198+tl_length = L.genericLength `eqP` TL.length

199+

200+s_map f = map f `eqP` (unpackS . S.map f)

201+s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)

202+sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)

203+t_map f = map f `eqP` (unpackS . T.map f)

204+tl_map f = map f `eqP` (unpackS . TL.map f)

205+t_intercalate c = unsquare (L.intercalate c `eq` (unpackS . T.intercalate (packS c) . map packS))

206+tl_intercalate c = unsquare (L.intercalate c `eq` (unpackS . TL.intercalate (TL.pack c) . map TL.pack))

207+s_intersperse c = L.intersperse c `eqP` (unpackS . S.intersperse c)

208+s_intersperse_s c = L.intersperse c `eqP` (unpackS . S.unstream . S.intersperse c)

209+sf_intersperse p c= (L.intersperse c . L.filter p) `eqP` (unpackS . S.intersperse c . S.filter p)

210+t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)

211+tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)

212+t_transpose = unsquare (L.transpose `eq` (map unpackS . T.transpose . map packS))

213+tl_transpose = unsquare (L.transpose `eq` (map unpackS . TL.transpose . map TL.pack))

214+t_reverse = L.reverse `eqP` (unpackS . T.reverse)

215+tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)

216+t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)

217+

218+t_replace s d = (L.intercalate d . split s) `eqP` (unpackS . T.replace (T.pack s) (T.pack d))

219+tl_replace s d = (L.intercalate d . split s) `eqP` (unpackS . TL.replace (TL.pack s) (TL.pack d))

220+

221+split :: (Eq a) => [a] -> [a] -> [[a]]

222+split pat src0

223+ | l == 0 = error "empty"

224+ | otherwise = go src0

225+ where

226+ l = length pat

227+ go src = search 0 src

228+ where

229+ search _ [] = [src]

230+ search !n s@(_:s')

231+ | pat `L.isPrefixOf` s = take n src : go (drop l s)

232+ | otherwise = search (n+1) s'

233+

234+s_toCaseFold_length xs = S.length (S.toCaseFold s) >= length xs

235+ where s = S.streamList xs

236+sf_toCaseFold_length p xs =

237+ (S.length . S.toCaseFold . S.filter p $ s) >= (length . L.filter p $ xs)

238+ where s = S.streamList xs

239+t_toCaseFold_length t = T.length (T.toCaseFold t) >= T.length t

240+tl_toCaseFold_length t = TL.length (TL.toCaseFold t) >= TL.length t

241+t_toLower_length t = T.length (T.toLower t) >= T.length t

242+t_toLower_lower t = p (T.toLower t) >= p t

243+ where p = T.length . T.filter isLower

244+tl_toLower_lower t = p (TL.toLower t) >= p t

245+ where p = TL.length . TL.filter isLower

246+t_toUpper_length t = T.length (T.toUpper t) >= T.length t

247+t_toUpper_upper t = p (T.toUpper t) >= p t

248+ where p = T.length . T.filter isUpper

249+tl_toUpper_upper t = p (TL.toUpper t) >= p t

250+ where p = TL.length . TL.filter isUpper

251+

252+justifyLeft k c s = s ++ L.replicate (k - length s) c

253+justifyRight m n s = L.replicate (m - length s) n ++ s

254+

255+s_justifyLeft k c = justifyLeft j c `eqP` (unpackS . S.justifyLeftI j c)

256+ where j = fromIntegral (k :: Word8)

257+s_justifyLeft_s k c = justifyLeft j c `eqP` (unpackS . S.unstream . S.justifyLeftI j c)

258+ where j = fromIntegral (k :: Word8)

259+sf_justifyLeft p k c = (justifyLeft j c . L.filter p) `eqP`

260+ (unpackS . S.justifyLeftI j c . S.filter p)

261+ where j = fromIntegral (k :: Word8)

262+t_justifyLeft k c = justifyLeft j c `eqP` (unpackS . T.justifyLeft j c)

263+ where j = fromIntegral (k :: Word8)

264+tl_justifyLeft k c = justifyLeft j c `eqP` (unpackS . TL.justifyLeft (fromIntegral j) c)

265+ where j = fromIntegral (k :: Word8)

266+t_justifyRight k c = justifyRight j c `eqP` (unpackS . T.justifyRight j c)

267+ where j = fromIntegral (k :: Word8)

268+tl_justifyRight k c = justifyRight j c `eqP` (unpackS . TL.justifyRight (fromIntegral j) c)

269+ where j = fromIntegral (k :: Word8)

270+

271+sf_foldl p f z = (L.foldl f z . L.filter p) `eqP` (S.foldl f z . S.filter p)

272+ where _types = f :: Char -> Char -> Char

273+t_foldl f z = L.foldl f z `eqP` (T.foldl f z)

274+ where _types = f :: Char -> Char -> Char

275+tl_foldl f z = L.foldl f z `eqP` (TL.foldl f z)

276+ where _types = f :: Char -> Char -> Char

277+sf_foldl' p f z = (L.foldl' f z . L.filter p) `eqP` (S.foldl' f z . S.filter p)

278+ where _types = f :: Char -> Char -> Char

279+t_foldl' f z = L.foldl' f z `eqP` T.foldl' f z

280+ where _types = f :: Char -> Char -> Char

281+tl_foldl' f z = L.foldl' f z `eqP` TL.foldl' f z

282+ where _types = f :: Char -> Char -> Char

283+sf_foldl1 p f = (L.foldl1 f . L.filter p) `eqP` (S.foldl1 f . S.filter p)

284+t_foldl1 f = L.foldl1 f `eqP` T.foldl1 f

285+tl_foldl1 f = L.foldl1 f `eqP` TL.foldl1 f

286+sf_foldl1' p f = (L.foldl1' f . L.filter p) `eqP` (S.foldl1' f . S.filter p)

287+t_foldl1' f = L.foldl1' f `eqP` T.foldl1' f

288+tl_foldl1' f = L.foldl1' f `eqP` TL.foldl1' f

289+sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)

290+ where _types = f :: Char -> Char -> Char

291+t_foldr f z = L.foldr f z `eqP` T.foldr f z

292+ where _types = f :: Char -> Char -> Char

293+tl_foldr f z = L.foldr f z `eqP` TL.foldr f z

294+ where _types = f :: Char -> Char -> Char

295+sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)

296+t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f

297+tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f

298+

299+s_concat_s = unsquare (L.concat `eq` (unpackS . S.unstream . S.concat . map packS))

300+sf_concat p = unsquare ((L.concat . map (L.filter p)) `eq` (unpackS . S.concat . map (S.filter p . packS)))

301+t_concat = unsquare (L.concat `eq` (unpackS . T.concat . map packS))

302+tl_concat = unsquare (L.concat `eq` (unpackS . TL.concat . map TL.pack))

303+sf_concatMap p f = unsquare ((L.concatMap f . L.filter p) `eqP` (unpackS . S.concatMap (packS . f) . S.filter p))

304+t_concatMap f = unsquare (L.concatMap f `eqP` (unpackS . T.concatMap (packS . f)))

305+tl_concatMap f = unsquare (L.concatMap f `eqP` (unpackS . TL.concatMap (TL.pack . f)))

306+sf_any q p = (L.any p . L.filter q) `eqP` (S.any p . S.filter q)

307+t_any p = L.any p `eqP` T.any p

308+tl_any p = L.any p `eqP` TL.any p

309+sf_all q p = (L.all p . L.filter q) `eqP` (S.all p . S.filter q)

310+t_all p = L.all p `eqP` T.all p

311+tl_all p = L.all p `eqP` TL.all p

312+sf_maximum p = (L.maximum . L.filter p) `eqP` (S.maximum . S.filter p)

313+t_maximum = L.maximum `eqP` T.maximum

314+tl_maximum = L.maximum `eqP` TL.maximum

315+sf_minimum p = (L.minimum . L.filter p) `eqP` (S.minimum . S.filter p)

316+t_minimum = L.minimum `eqP` T.minimum

317+tl_minimum = L.minimum `eqP` TL.minimum

318+

319+sf_scanl p f z = (L.scanl f z . L.filter p) `eqP` (unpackS . S.scanl f z . S.filter p)

320+t_scanl f z = L.scanl f z `eqP` (unpackS . T.scanl f z)

321+tl_scanl f z = L.scanl f z `eqP` (unpackS . TL.scanl f z)

322+t_scanl1 f = L.scanl1 f `eqP` (unpackS . T.scanl1 f)

323+tl_scanl1 f = L.scanl1 f `eqP` (unpackS . TL.scanl1 f)

324+t_scanr f z = L.scanr f z `eqP` (unpackS . T.scanr f z)

325+tl_scanr f z = L.scanr f z `eqP` (unpackS . TL.scanr f z)

326+t_scanr1 f = L.scanr1 f `eqP` (unpackS . T.scanr1 f)

327+tl_scanr1 f = L.scanr1 f `eqP` (unpackS . TL.scanr1 f)

328+

329+t_mapAccumL f z = unsquare (L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z))

330+ where _types = f :: Int -> Char -> (Int,Char)

331+tl_mapAccumL f z = unsquare (L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z))

332+ where _types = f :: Int -> Char -> (Int,Char)

333+t_mapAccumR f z = unsquare (L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z))

334+ where _types = f :: Int -> Char -> (Int,Char)

335+tl_mapAccumR f z = unsquare (L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z))

336+ where _types = f :: Int -> Char -> (Int,Char)

337+

338+replicate n l = concat (L.replicate n l)

339+

340+t_replicate n = replicate m `eq` (unpackS . T.replicate m . packS)

341+ where m = fromIntegral (n :: Word8)

342+tl_replicate n = replicate m `eq` (unpackS . TL.replicate (fromIntegral m) . packS)

343+ where m = fromIntegral (n :: Word8)

344+

345+unf :: Int -> Char -> Maybe (Char, Char)

346+unf n c | fromEnum c * 100 > n = Nothing

347+ | otherwise = Just (c, succ c)

348+

349+t_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . T.unfoldr (unf m))

350+ where m = fromIntegral (n :: Word16)

351+tl_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . TL.unfoldr (unf m))

352+ where m = fromIntegral (n :: Word16)

353+t_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`

354+ (unpackS . T.unfoldrN i (unf j))

355+ where i = fromIntegral (n :: Word16)

356+ j = fromIntegral (m :: Word16)

357+tl_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`

358+ (unpackS . TL.unfoldrN (fromIntegral i) (unf j))

359+ where i = fromIntegral (n :: Word16)

360+ j = fromIntegral (m :: Word16)

361+

362+unpack2 :: (Stringy s) => (s,s) -> (String,String)

363+unpack2 = unpackS *** unpackS

364+

365+s_take n = L.take n `eqP` (unpackS . S.take n)

366+s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)

367+ where n = small m

368+sf_take p n = (L.take n . L.filter p) `eqP` (unpackS . S.take n . S.filter p)

369+t_take n = L.take n `eqP` (unpackS . T.take n)

370+tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))

371+s_drop n = L.drop n `eqP` (unpackS . S.drop n)

372+s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)

373+ where n = small m

374+sf_drop p n = (L.drop n . L.filter p) `eqP` (unpackS . S.drop n . S.filter p)

375+t_drop n = L.drop n `eqP` (unpackS . T.drop n)

376+tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))

377+s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)

378+ where n = small m

379+s_take_drop_s m = (L.take n . L.drop n) `eqP` (unpackS . S.unstream . S.take n . S.drop n)

380+ where n = small m

381+s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)

382+s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)

383+sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP` (unpackS . S.takeWhile p . S.filter q)

384+t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)

385+tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)

386+s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

387+s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)

388+sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP` (unpackS . S.dropWhile p . S.filter q)

389+t_dropWhile p = L.dropWhile p `eqP` (unpackS . T.dropWhile p)

390+tl_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

391+t_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . T.dropWhileEnd p)

392+tl_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . TL.dropWhileEnd p)

393+t_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . T.dropAround p)

394+tl_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . TL.dropAround p)

395+t_stripStart = T.dropWhile isSpace `eq` T.stripStart

396+tl_stripStart = TL.dropWhile isSpace `eq` TL.stripStart

397+t_stripEnd = T.dropWhileEnd isSpace `eq` T.stripEnd

398+tl_stripEnd = TL.dropWhileEnd isSpace `eq` TL.stripEnd

399+t_strip = T.dropAround isSpace `eq` T.strip

400+tl_strip = TL.dropAround isSpace `eq` TL.strip

401+t_splitAt n = L.splitAt n `eqP` (unpack2 . T.splitAt n)

402+tl_splitAt n = L.splitAt n `eqP` (unpack2 . TL.splitAt (fromIntegral n))

403+t_spanBy p = L.span p `eqP` (unpack2 . T.spanBy p)

404+tl_spanBy p = L.span p `eqP` (unpack2 . TL.spanBy p)

405+

406+t_break_id s = squid `eq` (uncurry T.append . T.break s)

407+ where squid t | T.null s = error "empty"

408+ | otherwise = t

409+tl_break_id s = squid `eq` (uncurry TL.append . TL.break s)

410+ where squid t | TL.null s = error "empty"

411+ | otherwise = t

412+t_break_start (NotEmpty s) t = let (_,m) = T.break s t

413+ in T.null m || s `T.isPrefixOf` m

414+tl_break_start (NotEmpty s) t = let (_,m) = TL.break s t

415+ in TL.null m || s `TL.isPrefixOf` m

416+t_breakBy p = L.break p `eqP` (unpack2 . T.breakBy p)

417+tl_breakBy p = L.break p `eqP` (unpack2 . TL.breakBy p)

418+t_group = L.group `eqP` (map unpackS . T.group)

419+tl_group = L.group `eqP` (map unpackS . TL.group)

420+t_groupBy p = L.groupBy p `eqP` (map unpackS . T.groupBy p)

421+tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)

422+t_inits = L.inits `eqP` (map unpackS . T.inits)

423+tl_inits = L.inits `eqP` (map unpackS . TL.inits)

424+t_tails = L.tails `eqP` (map unpackS . T.tails)

425+tl_tails = L.tails `eqP` (map unpackS . TL.tails)

426+t_findAppendId (NotEmpty s) = unsquare $ \ts ->

427+ let t = T.intercalate s ts

428+ in all (==t) $ map (uncurry T.append) (T.find s t)

429+tl_findAppendId (NotEmpty s) = unsquare $ \ts ->

430+ let t = TL.intercalate s ts

431+ in all (==t) $ map (uncurry TL.append) (TL.find s t)

432+t_findContains (NotEmpty s) = unsquare (all (T.isPrefixOf s . snd) . T.find s .

433+ T.intercalate s)

434+tl_findContains (NotEmpty s) = unsquare (all (TL.isPrefixOf s . snd) .

435+ TL.find s . TL.intercalate s)

436+t_findCount s = (L.length . T.find s) `eq` T.count s

437+tl_findCount s = (L.genericLength . TL.find s) `eq` TL.count s

438+

439+t_split_split s = unsquare ((T.split s `eq` Slow.split s) .

440+ T.intercalate s)

441+tl_split_split s = unsquare (((TL.split (chunkify s) . chunkify) `eq`

442+ (map chunkify . T.split s)) .

443+ T.intercalate s)

444+t_split_i (NotEmpty t) = id `eq` (T.intercalate t . T.split t)

445+tl_split_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.split t)

446+

447+t_splitBy p = splitBy p `eqP` (map unpackS . T.splitBy p)

448+t_splitBy_count c = (L.length . T.splitBy (==c)) `eq` ((1+) . T.count (T.singleton c))

449+t_splitBy_split c = T.splitBy (==c) `eq` T.split (T.singleton c)

450+tl_splitBy p = splitBy p `eqP` (map unpackS . TL.splitBy p)

451+

452+splitBy :: (a -> Bool) -> [a] -> [[a]]

453+splitBy _ [] = [[]]

454+splitBy p xs = loop xs

455+ where loop s | null s' = [l]

456+ | otherwise = l : loop (tail s')

457+ where (l, s') = break p s

458+

459+t_chunksOf_same_lengths k = all ((==k) . T.length) . ini . T.chunksOf k

460+ where ini [] = []

461+ ini xs = init xs

462+

463+t_chunksOf_length k t = len == T.length t || (k <= 0 && len == 0)

464+ where len = L.sum . L.map T.length $ T.chunksOf k t

465+

466+chunkify = TL.fromChunks . (:[])

467+

468+tl_chunksOf k = T.chunksOf k `eq` (map (T.concat . TL.toChunks) . TL.chunksOf (fromIntegral k) . chunkify)

469+

470+t_lines = L.lines `eqP` (map unpackS . T.lines)

471+tl_lines = L.lines `eqP` (map unpackS . TL.lines)

472+{-

473+t_lines' = lines' `eqP` (map unpackS . T.lines')

474+ where lines' "" = []

475+ lines' s = let (l, s') = break eol s

476+ in l : case s' of

477+ [] -> []

478+ ('\r':'\n':s'') -> lines' s''

479+ (_:s'') -> lines' s''

480+ eol c = c == '\r' || c == '\n'

481+-}

482+t_words = L.words `eqP` (map unpackS . T.words)

483+

484+tl_words = L.words `eqP` (map unpackS . TL.words)

485+t_unlines = unsquare (L.unlines `eq` (unpackS . T.unlines . map packS))

486+tl_unlines = unsquare (L.unlines `eq` (unpackS . TL.unlines . map packS))

487+t_unwords = unsquare (L.unwords `eq` (unpackS . T.unwords . map packS))

488+tl_unwords = unsquare (L.unwords `eq` (unpackS . TL.unwords . map packS))

489+

490+s_isPrefixOf s = L.isPrefixOf s `eqP` (S.isPrefixOf (S.stream $ packS s) . S.stream)

491+sf_isPrefixOf p s = (L.isPrefixOf s . L.filter p) `eqP` (S.isPrefixOf (S.stream $ packS s) . S.filter p . S.stream)

492+t_isPrefixOf s = L.isPrefixOf s`eqP` T.isPrefixOf (packS s)

493+tl_isPrefixOf s = L.isPrefixOf s`eqP` TL.isPrefixOf (packS s)

494+t_isSuffixOf s = L.isSuffixOf s`eqP` T.isSuffixOf (packS s)

495+tl_isSuffixOf s = L.isSuffixOf s`eqP` TL.isSuffixOf (packS s)

496+t_isInfixOf s = L.isInfixOf s `eqP` T.isInfixOf (packS s)

497+tl_isInfixOf s = L.isInfixOf s `eqP` TL.isInfixOf (packS s)

498+

499+prefixed (p:ps) (t:ts)

500+ | p == t = prefixed ps ts

501+prefixed [] ts = Just ts

502+prefixed _ _ = Nothing

503+

504+t_prefixed s = (fmap packS . prefixed s) `eqP` T.prefixed (packS s)

505+tl_prefixed s = (fmap packS . prefixed s) `eqP` TL.prefixed (packS s)

506+

507+suffixed p t = reverse `fmap` prefixed (reverse p) (reverse t)

508+

509+t_suffixed s = (fmap packS . suffixed s) `eqP` T.suffixed (packS s)

510+tl_suffixed s = (fmap packS . suffixed s) `eqP` TL.suffixed (packS s)

511+

512+sf_elem p c = (L.elem c . L.filter p) `eqP` (S.elem c . S.filter p)

513+sf_filter q p = (L.filter p . L.filter q) `eqP` (unpackS . S.filter p . S.filter q)

514+t_filter p = L.filter p `eqP` (unpackS . T.filter p)

515+tl_filter p = L.filter p `eqP` (unpackS . TL.filter p)

516+sf_findBy q p = (L.find p . L.filter q) `eqP` (S.findBy p . S.filter q)

517+t_findBy p = L.find p `eqP` T.findBy p

518+tl_findBy p = L.find p `eqP` TL.findBy p

519+t_partition p = L.partition p `eqP` (unpack2 . T.partitionBy p)

520+tl_partition p = L.partition p `eqP` (unpack2 . TL.partitionBy p)

521+

522+sf_index p s = forAll (choose (-l,l*2)) ((L.filter p s L.!!) `eq` S.index (S.filter p $ packS s))

523+ where l = L.length s

524+t_index s = forAll (choose (-l,l*2)) ((s L.!!) `eq` T.index (packS s))

525+ where l = L.length s

526+

527+tl_index s = forAll (choose (-l,l*2)) ((s L.!!) `eq` (TL.index (packS s) . fromIntegral))

528+ where l = L.length s

529+

530+t_findIndex p = L.findIndex p `eqP` T.findIndex p

531+t_count t = (subtract 1 . L.length . T.split t) `eq` T.count t

532+tl_count t = (subtract 1 . L.genericLength . TL.split t) `eq` TL.count t

533+t_zip s = L.zip s `eqP` T.zip (packS s)

534+tl_zip s = L.zip s `eqP` TL.zip (packS s)

535+sf_zipWith p c s = (L.zipWith c (L.filter p s) . L.filter p) `eqP` (unpackS . S.zipWith c (S.filter p $ packS s) . S.filter p)

536+t_zipWith c s = L.zipWith c s `eqP` (unpackS . T.zipWith c (packS s))

537+tl_zipWith c s = L.zipWith c s `eqP` (unpackS . TL.zipWith c (packS s))

538+

539+t_indices = unsquare (\s -> Slow.indices s `eq` indices s)

540+tl_indices = unsquare (\s -> lazyIndices s `eq` S.indices s)

541+ where lazyIndices s t = map fromIntegral $ Slow.indices (conc s) (conc t)

542+ conc = T.concat . TL.toChunks

543+t_indices_occurs t = unsquare (\ts -> let s = T.intercalate t ts

544+ in Slow.indices t s == indices t s)

545+

546+-- Bit shifts.

547+shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k

548+ where width = round (log (fromIntegral m) / log 2 :: Double)

549+ (m,_) = (maxBound, m == w)

550+shiftR w = forAll (choose (0,width-1)) $ \k -> Bits.shiftR w k == U.shiftR w k

551+ where width = round (log (fromIntegral m) / log 2 :: Double)

552+ (m,_) = (maxBound, m == w)

553+

554+shiftL_Int = shiftL :: Int -> Property

555+shiftL_Word16 = shiftL :: Word16 -> Property

556+shiftL_Word32 = shiftL :: Word32 -> Property

557+shiftR_Int = shiftR :: Int -> Property

558+shiftR_Word16 = shiftR :: Word16 -> Property

559+shiftR_Word32 = shiftR :: Word32 -> Property

560+

561+-- Builder

562+t_builderSingleton = id `eqP` (unpackS . TB.toLazyText . mconcat . map TB.singleton)

563+t_builderFromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat . map (TB.fromText . packS))

564+t_builderAssociative s1 s2 s3 = TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==

565+ TB.toLazyText ((b1 `mappend` b2) `mappend` b3)

566+ where b1 = TB.fromText (packS s1)

567+ b2 = TB.fromText (packS s2)

568+ b3 = TB.fromText (packS s3)

569+

570+-- Regression tests.

571+s_filter_eq s = S.filter p t == S.streamList (filter p s)

572+ where p = (/= S.last t)

573+ t = S.streamList s

574+

575+-- Make a stream appear shorter than it really is, to ensure that

576+-- functions that consume inaccurately sized streams behave

577+-- themselves.

578+shorten :: Int -> S.Stream a -> S.Stream a

579+shorten n t@(S.Stream arr off len)

580+ | n > 0 = S.Stream arr off (smaller (exactSize n) len)

581+ | otherwise = t

582+

583+main = defaultMain tests

584+

585+tests = [

586+ testGroup "creation/elimination" [

587+ testProperty "t_pack_unpack" t_pack_unpack,

588+ testProperty "tl_pack_unpack" tl_pack_unpack,

589+ testProperty "t_stream_unstream" t_stream_unstream,

590+ testProperty "tl_stream_unstream" tl_stream_unstream,

591+ testProperty "t_reverse_stream" t_reverse_stream,

592+ testProperty "t_singleton" t_singleton,

593+ testProperty "tl_singleton" tl_singleton,

594+ testProperty "tl_unstreamChunks" tl_unstreamChunks,

595+ testProperty "tl_chunk_unchunk" tl_chunk_unchunk

596+ ],

597+

598+ testGroup "transcoding" [

599+ testProperty "t_ascii" t_ascii,

600+ testProperty "t_utf8" t_utf8,

601+ testProperty "tl_utf8" tl_utf8,

602+ testProperty "t_utf16LE" t_utf16LE,

603+ testProperty "t_utf16BE" t_utf16BE,

604+ testProperty "t_utf32LE" t_utf32LE,

605+ testProperty "t_utf32BE" t_utf32BE

606+ ],

607+

608+ testGroup "instances" [

609+ testProperty "s_Eq" s_Eq,

610+ testProperty "sf_Eq" sf_Eq,

611+ testProperty "t_Eq" t_Eq,

612+ testProperty "tl_Eq" tl_Eq,

613+ testProperty "s_Ord" s_Ord,

614+ testProperty "sf_Ord" sf_Ord,

615+ testProperty "t_Ord" t_Ord,

616+ testProperty "tl_Ord" tl_Ord,

617+ testProperty "t_Read" t_Read,

618+ testProperty "tl_Read" tl_Read,

619+ testProperty "t_Show" t_Show,

620+ testProperty "tl_Show" tl_Show,

621+ testProperty "t_mappend" t_mappend,

622+ testProperty "tl_mappend" tl_mappend,

623+ testProperty "t_mconcat" t_mconcat,

624+ testProperty "tl_mconcat" tl_mconcat,

625+ testProperty "t_IsString" t_IsString,

626+ testProperty "tl_IsString" tl_IsString

627+ ],

628+

629+ testGroup "basics" [

630+ testProperty "s_cons" s_cons,

631+ testProperty "s_cons_s" s_cons_s,

632+ testProperty "sf_cons" sf_cons,

633+ testProperty "t_cons" t_cons,

634+ testProperty "tl_cons" tl_cons,

635+ testProperty "s_snoc" s_snoc,

636+ testProperty "t_snoc" t_snoc,

637+ testProperty "tl_snoc" tl_snoc,

638+ testProperty "s_append" s_append,

639+ testProperty "s_append_s" s_append_s,

640+ testProperty "sf_append" sf_append,

641+ testProperty "t_append" t_append,

642+ testProperty "s_uncons" s_uncons,

643+ testProperty "sf_uncons" sf_uncons,

644+ testProperty "t_uncons" t_uncons,

645+ testProperty "tl_uncons" tl_uncons,

646+ testProperty "s_head" s_head,

647+ testProperty "sf_head" sf_head,

648+ testProperty "t_head" t_head,

649+ testProperty "tl_head" tl_head,

650+ testProperty "s_last" s_last,

651+ testProperty "sf_last" sf_last,

652+ testProperty "t_last" t_last,

653+ testProperty "tl_last" tl_last,

654+ testProperty "s_tail" s_tail,

655+ testProperty "s_tail_s" s_tail_s,

656+ testProperty "sf_tail" sf_tail,

657+ testProperty "t_tail" t_tail,

658+ testProperty "tl_tail" tl_tail,

659+ testProperty "s_init" s_init,

660+ testProperty "s_init_s" s_init_s,

661+ testProperty "sf_init" sf_init,

662+ testProperty "t_init" t_init,

663+ testProperty "tl_init" tl_init,

664+ testProperty "s_null" s_null,

665+ testProperty "sf_null" sf_null,

666+ testProperty "t_null" t_null,

667+ testProperty "tl_null" tl_null,

668+ testProperty "s_length" s_length,

669+ testProperty "sf_length" sf_length,

670+ testProperty "t_length" t_length,

671+ testProperty "tl_length" tl_length

672+ ],

673+

674+ testGroup "transformations" [

675+ testProperty "s_map" s_map,

676+ testProperty "s_map_s" s_map_s,

677+ testProperty "sf_map" sf_map,

678+ testProperty "t_map" t_map,

679+ testProperty "tl_map" tl_map,

680+ testProperty "t_intercalate" t_intercalate,

681+ testProperty "tl_intercalate" tl_intercalate,

682+ testProperty "s_intersperse" s_intersperse,

683+ testProperty "s_intersperse_s" s_intersperse_s,

684+ testProperty "sf_intersperse" sf_intersperse,

685+ testProperty "t_intersperse" t_intersperse,

686+ testProperty "tl_intersperse" tl_intersperse,

687+ testProperty "t_transpose" t_transpose,

688+ testProperty "tl_transpose" tl_transpose,

689+ testProperty "t_reverse" t_reverse,

690+ testProperty "tl_reverse" tl_reverse,

691+ testProperty "t_reverse_short" t_reverse_short,

692+ testProperty "t_replace" t_replace,

693+ testProperty "tl_replace" tl_replace,

694+

695+ testGroup "case conversion" [

696+ testProperty "s_toCaseFold_length" s_toCaseFold_length,

697+ testProperty "sf_toCaseFold_length" sf_toCaseFold_length,

698+ testProperty "t_toCaseFold_length" t_toCaseFold_length,

699+ testProperty "tl_toCaseFold_length" tl_toCaseFold_length,

700+ testProperty "t_toLower_length" t_toLower_length,

701+ testProperty "t_toLower_lower" t_toLower_lower,

702+ testProperty "tl_toLower_lower" tl_toLower_lower,

703+ testProperty "t_toUpper_length" t_toUpper_length,

704+ testProperty "t_toUpper_upper" t_toUpper_upper,

705+ testProperty "tl_toUpper_upper" tl_toUpper_upper

706+ ],

707+

708+ testGroup "justification" [

709+ testProperty "s_justifyLeft" s_justifyLeft,

710+ testProperty "s_justifyLeft_s" s_justifyLeft_s,

711+ testProperty "sf_justifyLeft" sf_justifyLeft,

712+ testProperty "t_justifyLeft" t_justifyLeft,

713+ testProperty "tl_justifyLeft" tl_justifyLeft,

714+ testProperty "t_justifyRight" t_justifyRight,

715+ testProperty "tl_justifyRight" tl_justifyRight

716+ ]

717+ ],

718+

719+ testGroup "folds" [

720+ testProperty "sf_foldl" sf_foldl,

721+ testProperty "t_foldl" t_foldl,

722+ testProperty "tl_foldl" tl_foldl,

723+ testProperty "sf_foldl'" sf_foldl',

724+ testProperty "t_foldl'" t_foldl',

725+ testProperty "tl_foldl'" tl_foldl',

726+ testProperty "sf_foldl1" sf_foldl1,

727+ testProperty "t_foldl1" t_foldl1,

728+ testProperty "tl_foldl1" tl_foldl1,

729+ testProperty "t_foldl1'" t_foldl1',

730+ testProperty "sf_foldl1'" sf_foldl1',

731+ testProperty "tl_foldl1'" tl_foldl1',

732+ testProperty "sf_foldr" sf_foldr,

733+ testProperty "t_foldr" t_foldr,

734+ testProperty "tl_foldr" tl_foldr,

735+ testProperty "sf_foldr1" sf_foldr1,

736+ testProperty "t_foldr1" t_foldr1,

737+ testProperty "tl_foldr1" tl_foldr1,

738+

739+ testGroup "special" [

740+ testProperty "s_concat_s" s_concat_s,

741+ testProperty "sf_concat" sf_concat,

742+ testProperty "t_concat" t_concat,

743+ testProperty "tl_concat" tl_concat,

744+ testProperty "sf_concatMap" sf_concatMap,

745+ testProperty "t_concatMap" t_concatMap,

746+ testProperty "tl_concatMap" tl_concatMap,

747+ testProperty "sf_any" sf_any,

748+ testProperty "t_any" t_any,

749+ testProperty "tl_any" tl_any,

750+ testProperty "sf_all" sf_all,

751+ testProperty "t_all" t_all,

752+ testProperty "tl_all" tl_all,

753+ testProperty "sf_maximum" sf_maximum,

754+ testProperty "t_maximum" t_maximum,

755+ testProperty "tl_maximum" tl_maximum,

756+ testProperty "sf_minimum" sf_minimum,

757+ testProperty "t_minimum" t_minimum,

758+ testProperty "tl_minimum" tl_minimum

759+ ]

760+ ],

761+

762+ testGroup "construction" [

763+ testGroup "scans" [

764+ testProperty "sf_scanl" sf_scanl,

765+ testProperty "t_scanl" t_scanl,

766+ testProperty "tl_scanl" tl_scanl,

767+ testProperty "t_scanl1" t_scanl1,

768+ testProperty "tl_scanl1" tl_scanl1,

769+ testProperty "t_scanr" t_scanr,

770+ testProperty "tl_scanr" tl_scanr,

771+ testProperty "t_scanr1" t_scanr1,

772+ testProperty "tl_scanr1" tl_scanr1

773+ ],

774+

775+ testGroup "mapAccum" [

776+ testProperty "t_mapAccumL" t_mapAccumL,

777+ testProperty "tl_mapAccumL" tl_mapAccumL,

778+ testProperty "t_mapAccumR" t_mapAccumR,

779+ testProperty "tl_mapAccumR" tl_mapAccumR

780+ ],

781+

782+ testGroup "unfolds" [

783+ testProperty "t_replicate" t_replicate,

784+ testProperty "tl_replicate" tl_replicate,

785+ testProperty "t_unfoldr" t_unfoldr,

786+ testProperty "tl_unfoldr" tl_unfoldr,

787+ testProperty "t_unfoldrN" t_unfoldrN,

788+ testProperty "tl_unfoldrN" tl_unfoldrN

789+ ]

790+ ],

791+

792+ testGroup "substrings" [

793+ testGroup "breaking" [

794+ testProperty "s_take" s_take,

795+ testProperty "s_take_s" s_take_s,

796+ testProperty "sf_take" sf_take,

797+ testProperty "t_take" t_take,

798+ testProperty "tl_take" tl_take,

799+ testProperty "s_drop" s_drop,

800+ testProperty "s_drop_s" s_drop_s,

801+ testProperty "sf_drop" sf_drop,

802+ testProperty "t_drop" t_drop,

803+ testProperty "tl_drop" tl_drop,

804+ testProperty "s_take_drop" s_take_drop,

805+ testProperty "s_take_drop_s" s_take_drop_s,

806+ testProperty "s_takeWhile" s_takeWhile,

807+ testProperty "s_takeWhile_s" s_takeWhile_s,

808+ testProperty "sf_takeWhile" sf_takeWhile,

809+ testProperty "t_takeWhile" t_takeWhile,

810+ testProperty "tl_takeWhile" tl_takeWhile,

811+ testProperty "sf_dropWhile" sf_dropWhile,

812+ testProperty "s_dropWhile" s_dropWhile,

813+ testProperty "s_dropWhile_s" s_dropWhile_s,

814+ testProperty "t_dropWhile" t_dropWhile,

815+ testProperty "tl_dropWhile" tl_dropWhile,

816+ testProperty "t_dropWhileEnd" t_dropWhileEnd,

817+ testProperty "tl_dropWhileEnd" tl_dropWhileEnd,

818+ testProperty "t_dropAround" t_dropAround,

819+ testProperty "tl_dropAround" tl_dropAround,

820+ testProperty "t_stripStart" t_stripStart,

821+ testProperty "tl_stripStart" tl_stripStart,

822+ testProperty "t_stripEnd" t_stripEnd,

823+ testProperty "tl_stripEnd" tl_stripEnd,

824+ testProperty "t_strip" t_strip,

825+ testProperty "tl_strip" tl_strip,

826+ testProperty "t_splitAt" t_splitAt,

827+ testProperty "tl_splitAt" tl_splitAt,

828+ testProperty "t_spanBy" t_spanBy,

829+ testProperty "tl_spanBy" tl_spanBy,

830+ testProperty "t_break_id" t_break_id,

831+ testProperty "tl_break_id" tl_break_id,

832+ testProperty "t_break_start" t_break_start,

833+ testProperty "tl_break_start" tl_break_start,

834+ testProperty "t_breakBy" t_breakBy,

835+ testProperty "tl_breakBy" tl_breakBy,

836+ testProperty "t_group" t_group,

837+ testProperty "tl_group" tl_group,

838+ testProperty "t_groupBy" t_groupBy,

839+ testProperty "tl_groupBy" tl_groupBy,

840+ testProperty "t_inits" t_inits,

841+ testProperty "tl_inits" tl_inits,

842+ testProperty "t_tails" t_tails,

843+ testProperty "tl_tails" tl_tails

844+ ],

845+

846+ testGroup "breaking many" [

847+ testProperty "t_findAppendId" t_findAppendId,

848+ testProperty "tl_findAppendId" tl_findAppendId,

849+ testProperty "t_findContains" t_findContains,

850+ testProperty "tl_findContains" tl_findContains,

851+ testProperty "t_findCount" t_findCount,

852+ testProperty "tl_findCount" tl_findCount,

853+ testProperty "t_split_split" t_split_split,

854+ testProperty "tl_split_split" tl_split_split,

855+ testProperty "t_split_i" t_split_i,

856+ testProperty "tl_split_i" tl_split_i,

857+ testProperty "t_splitBy" t_splitBy,

858+ testProperty "t_splitBy_count" t_splitBy_count,

859+ testProperty "t_splitBy_split" t_splitBy_split,

860+ testProperty "tl_splitBy" tl_splitBy,

861+ testProperty "t_chunksOf_same_lengths" t_chunksOf_same_lengths,

862+ testProperty "t_chunksOf_length" t_chunksOf_length,

863+ testProperty "tl_chunksOf" tl_chunksOf

864+ ],

865+

866+ testGroup "lines and words" [

867+ testProperty "t_lines" t_lines,

868+ testProperty "tl_lines" tl_lines,

869+ --testProperty "t_lines'" t_lines',

870+ testProperty "t_words" t_words,

871+ testProperty "tl_words" tl_words,

872+ testProperty "t_unlines" t_unlines,

873+ testProperty "tl_unlines" tl_unlines,

874+ testProperty "t_unwords" t_unwords,

875+ testProperty "tl_unwords" tl_unwords

876+ ]

877+ ],

878+

879+ testGroup "predicates" [

880+ testProperty "s_isPrefixOf" s_isPrefixOf,

881+ testProperty "sf_isPrefixOf" sf_isPrefixOf,

882+ testProperty "t_isPrefixOf" t_isPrefixOf,

883+ testProperty "tl_isPrefixOf" tl_isPrefixOf,

884+ testProperty "t_isSuffixOf" t_isSuffixOf,

885+ testProperty "tl_isSuffixOf" tl_isSuffixOf,

886+ testProperty "t_isInfixOf" t_isInfixOf,

887+ testProperty "tl_isInfixOf" tl_isInfixOf,

888+

889+ testGroup "view" [

890+ testProperty "t_prefixed" t_prefixed,

891+ testProperty "tl_prefixed" tl_prefixed,

892+ testProperty "t_suffixed" t_suffixed,

893+ testProperty "tl_suffixed" tl_suffixed

894+ ]

895+ ],

896+

897+ testGroup "searching" [

898+ testProperty "sf_elem" sf_elem,

899+ testProperty "sf_filter" sf_filter,

900+ testProperty "t_filter" t_filter,

901+ testProperty "tl_filter" tl_filter,

902+ testProperty "sf_findBy" sf_findBy,

903+ testProperty "t_findBy" t_findBy,

904+ testProperty "tl_findBy" tl_findBy,

905+ testProperty "t_partition" t_partition,

906+ testProperty "tl_partition" tl_partition

907+ ],

908+

909+ testGroup "indexing" [

910+ testProperty "sf_index" sf_index,

911+ testProperty "t_index" t_index,

912+ testProperty "tl_index" tl_index,

913+ testProperty "t_findIndex" t_findIndex,

914+ testProperty "t_count" t_count,

915+ testProperty "tl_count" tl_count,

916+ testProperty "t_indices" t_indices,

917+ testProperty "tl_indices" tl_indices,

918+ testProperty "t_indices_occurs" t_indices_occurs

919+ ],

920+

921+ testGroup "zips" [

922+ testProperty "t_zip" t_zip,

923+ testProperty "tl_zip" tl_zip,

924+ testProperty "sf_zipWith" sf_zipWith,

925+ testProperty "t_zipWith" t_zipWith,

926+ testProperty "tl_zipWith" tl_zipWith

927+ ],

928+

929+ testGroup "regressions" [

930+ testProperty "s_filter_eq" s_filter_eq

931+ ],

932+

933+ testGroup "shifts" [

934+ testProperty "shiftL_Int" shiftL_Int,

935+ testProperty "shiftL_Word16" shiftL_Word16,

936+ testProperty "shiftL_Word32" shiftL_Word32,

937+ testProperty "shiftR_Int" shiftR_Int,

938+ testProperty "shiftR_Word16" shiftR_Word16,

939+ testProperty "shiftR_Word32" shiftR_Word32

940+ ],

941+

942+ testGroup "builder" [

943+ testProperty "t_builderSingleton" t_builderSingleton,

944+ testProperty "t_builderFromText" t_builderFromText,

945+ testProperty "t_builderAssociative" t_builderAssociative

946+ ]

947+ ]

tests/QuickCheckUtils.hsnew file+115

@@ -0,0 +1,115 @@

1+{-# LANGUAGE FlexibleInstances #-}

2+

3+module QuickCheckUtils where

4+

5+import Control.Arrow (first)

6+import Data.Int (Int64)

7+import Data.Word (Word8, Word16, Word32)

8+import qualified Data.Text as T

9+import qualified Data.Text.Lazy as TL

10+import System.Random (Random(..), RandomGen)

11+import Test.QuickCheck (Arbitrary(..), choose, sized, vector)

12+import qualified Data.ByteString as B

13+

14+instance Random Int64 where

15+ randomR = integralRandomR

16+ random = randomR (minBound,maxBound)

17+

18+instance Arbitrary Int64 where

19+ arbitrary = choose (minBound,maxBound)

20+

21+instance Random Word8 where

22+ randomR = integralRandomR

23+ random = randomR (minBound,maxBound)

24+

25+instance Arbitrary Word8 where

26+ arbitrary = choose (minBound,maxBound)

27+

28+instance Arbitrary B.ByteString where

29+ arbitrary = B.pack `fmap` arbitrary

30+

31+instance Random Word16 where

32+ randomR = integralRandomR

33+ random = randomR (minBound,maxBound)

34+

35+instance Arbitrary Word16 where

36+ arbitrary = choose (minBound,maxBound)

37+

38+instance Random Word32 where

39+ randomR = integralRandomR

40+ random = randomR (minBound,maxBound)

41+

42+instance Arbitrary Word32 where

43+ arbitrary = choose (minBound,maxBound)

44+

45+instance Arbitrary T.Text where

46+ arbitrary = T.pack `fmap` arbitrary

47+

48+instance Arbitrary TL.Text where

49+ arbitrary = TL.pack `fmap` arbitrary

50+

51+newtype NotEmpty a = NotEmpty { notEmpty :: a }

52+ deriving (Eq, Ord)

53+

54+instance Show a => Show (NotEmpty a) where

55+ show (NotEmpty a) = show a

56+

57+instance Functor NotEmpty where

58+ fmap f (NotEmpty a) = NotEmpty (f a)

59+

60+instance Arbitrary a => Arbitrary (NotEmpty [a]) where

61+ arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))

62+

63+instance Arbitrary (NotEmpty T.Text) where

64+ arbitrary = (fmap T.pack) `fmap` arbitrary

65+

66+instance Arbitrary (NotEmpty TL.Text) where

67+ arbitrary = (fmap TL.pack) `fmap` arbitrary

68+

69+instance Arbitrary (NotEmpty B.ByteString) where

70+ arbitrary = (fmap B.pack) `fmap` arbitrary

71+

72+data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7

73+ | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15

74+ | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23

75+ | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31

76+ deriving (Eq, Ord, Enum, Bounded)

77+

78+small :: Small -> Int

79+small = fromEnum

80+

81+intf f a b = toEnum ((fromEnum a `f` fromEnum b) `mod` 32)

82+

83+instance Show Small where

84+ show = show . fromEnum

85+

86+instance Read Small where

87+ readsPrec n = map (first toEnum) . readsPrec n

88+

89+instance Num Small where

90+ fromInteger = toEnum . fromIntegral

91+ signum _ = 1

92+ abs = id

93+ (+) = intf (+)

94+ (-) = intf (-)

95+ (*) = intf (*)

96+

97+instance Real Small where

98+ toRational = toRational . fromEnum

99+

100+instance Integral Small where

101+ toInteger = toInteger . fromEnum

102+ quotRem a b = (toEnum x, toEnum y)

103+ where (x, y) = fromEnum a `quotRem` fromEnum b

104+

105+instance Random Small where

106+ randomR = integralRandomR

107+ random = randomR (minBound,maxBound)

108+

109+instance Arbitrary Small where

110+ arbitrary = choose (minBound,maxBound)

111+

112+integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)

113+integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,

114+ fromIntegral b :: Integer) g of

115+ (x,h) -> (fromIntegral x, h)

tests/READMEnew file+2

@@ -0,0 +1,2 @@

1+You also need the test data from:

2+http://projects.haskell.org/text/text-testdata.tar.bz2

tests/Regressions.hsnew file+25

@@ -0,0 +1,25 @@

1+-- Regression tests for specific bugs.

2+

3+import Control.Exception (bracket)

4+import System.Directory (removeFile)

5+import System.IO (hClose, openTempFile)

6+import qualified Data.ByteString.Lazy as LB

7+import qualified Data.Text.Lazy as LT

8+import qualified Data.Text.Lazy.Encoding as LE

9+import qualified Test.Framework as F

10+import qualified Test.Framework.Providers.HUnit as F

11+

12+-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring

13+-- caused either a segfault or attempt to allocate a negative number

14+-- of bytes.

15+lazy_encode_crash =

16+ bracket (openTempFile "." "crashy.txt")

17+ (\(path,h) -> hClose h >> removeFile path) $

18+ \(_,h) -> LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'

19+

20+tests :: F.Test

21+tests = F.testGroup "crashers" [

22+ F.testCase "lazy_encode_crash" lazy_encode_crash

23+ ]

24+

25+main = F.defaultMain [tests]

tests/SearchBench.hsnew file+115

@@ -0,0 +1,115 @@

1+{-# LANGUAGE BangPatterns, OverloadedStrings #-}

2+

3+import Criterion.Main

4+import Data.Text.Encoding

5+import Data.Text.Search

6+import qualified Data.ByteString.Char8 as B

7+import qualified Data.Text as T

8+import qualified SlowFunctions as Slow

9+

10+main = defaultMain [

11+ bench "big/fast" $ (length . search indices)

12+ , bench "big/slow" $ (length . search Slow.indices)

13+ , bench "big/bytestring" $ (length . searchBS)

14+ , bench "dna/fast" $ (length . searchDNA indices)

15+ , bench "dna/slow" $ (length . searchDNA Slow.indices)

16+ , bench "dna/bytestring" $ (length . searchDNABS)

17+ ]

18+

19+search f n = f needle' haystack

20+ where

21+ needle' = T.drop (n `mod` 20) needle

22+ needle = T.replicate 10 "abcdefghijklmnopqrstuvwxyz"

23+ haystack = T.replicate 100 $

24+ T.concat [ T.replicate 1000 "def"

25+ , needle

26+ , T.replicate 1000 "123"

27+ ]

28+

29+searchDNA f n = f needle haystack

30+ where

31+ needle = T.take 4 . T.drop (n `mod` (T.length dna - 4)) $ dna

32+ haystack = T.replicate 100 dna

33+

34+replicateBS n = B.concat . replicate n

35+

36+searchBS n = indicesBS needle' haystack

37+ where

38+ needle' = B.drop (n `mod` 20) needle

39+ needle = replicateBS 10 "abcdefghijklmnopqrstuvwxyz"

40+ haystack = replicateBS 100 $

41+ B.concat [ replicateBS 1000 "def"

42+ , needle

43+ , replicateBS 1000 "123"

44+ ]

45+

46+searchDNABS n = indicesBS needle haystack

47+ where

48+ needle = B.take 4 . B.drop (n `mod` (B.length bdna - 4)) $ bdna

49+ haystack = replicateBS 100 bdna

50+

51+indicesBS :: B.ByteString -> B.ByteString -> [Int]

52+indicesBS pat

53+ | B.null pat = error "empty"

54+ | otherwise = go 0

55+ where

56+ l = B.length pat

57+ go !i src = case B.breakSubstring pat src of

58+ (h,t) | B.null t -> []

59+ | otherwise -> i' : go (i'+l) (B.drop l t)

60+ where i' = i + B.length h

61+

62+dna = decodeASCII bdna

63+

64+bdna :: B.ByteString

65+bdna = "\

66+\CGTAACAAGGTTTCCGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGGGTT\

67+\AATCTGGAGGATCTGTTTACTTTGGTCACCCATGAGCATTTGCTGTTGAAGTGACCTAGAATTGCCATCG\

68+\AGCCTCCTTGGGAGCTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGCAGTTTTGCTCCAAGTCGTT\

69+\TGACACATAATTGGTGAAGGGGGTGGCATCCTTCCCTGACCCTCCCCCAACTATTTTTTTAACAACTCTC\

70+\AGCAACGGAGACTCAGTCTTCGGCAAATGCGATAAATGGTGTGAATTGCAGAATCCCGTGCACCATCGAG\

71+\TCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCTGCCTGGGCATTGCGAGTCATAT\

72+\CTCTCCCTTAACGAGGCTGTCCATACATACTGTTCAGCCGGTGCGGATGTGAGTTTGGCCCCTTGTTCTT\

73+\TGGTACGGGGGGTCTAAGAGCTGCATGGGCTTTTGATGGTCCTAAATACGGCAAGAGGTGGACGAACTAT\

74+\GCTACAACAAAATTGTTGTGCAGAGGCCCCGGGTTGTCGTATTAGATGGGCCACCGTAATCTGAAGACCC\

75+\TTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGGCCATTTGGTTGCGACCCCAGGTCAG\

76+\GTGAGCAACAGCTGTCGTAACAAGGTTTCCGTAGGGTGAACTGCGGAAGGATCATTGTTGAGATCACATA\

77+\ATAATTGATCGAGTTAATCTGGAGGATCTGTTTACTTGGGTCACCCATGGGCATTTGCTGTTGAAGTGAC\

78+\CTAGATTTGCCATCGAGCCTCCTTGGGAGCATCCTTGTTGGCGATATCTAAACCCTCAATTTTTCCCCCA\

79+\ATCAAATTACACAAAATTGGTGGAGGGGGTGGCATTCTTCCCTTACCCTCCCCCAAATATTTTTTTAACA\

80+\ACTCTCAGCAACGGATATCTCAGCTCTTGCATCGATGAAGAACCCACCGAAATGCGATAAATGGTGTGAA\

81+\TTGCAGAATCCCGTGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACG\

82+\CCTGCCTGGGCATTGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACATACTGTTCAGCCGGTGCG\

83+\GATGTGAGTTTGGCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGATGCATGGGCTTTTGATGGTCCTAA\

84+\ATACGGCAAGAGGTGGACGAACTATGCTACAACAAAATTGTTGTGCAAAGGCCCCGGGTTGTCGTATAAG\

85+\ATGGGCCACCGATATCTGAAGACCCTTTTGGACCCCATTGGAGCCCATCAACCCATGTCAGTTGATGGCC\

86+\ATTCGTAACAAGGTTTCCGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGA\

87+\GTTAATCTGGAGGATCTGTTTACTTGGGTCACCCATGGGCATTTGCTGTTGAAGTGACCTAGATTTGCCA\

88+\TCGAGCCTCCTTGGGAGCTTTCTTGTTGGCGATATCTAAACCCTTGCCCGGCAGAGTTTTGGGAATCCCG\

89+\TGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCTGCCTGGGCAT\

90+\TGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACACACCTGTTCAGCCGGTGCGGATGTGAGTTTG\

91+\GCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGCTGCATGGGCTTTTGATGGTCCTAAATACGGCAAGAG\

92+\GTGGACGAACTATGCTACAACAAAATTGTTGTGCAAAGGCCCCGGGTTGTCGTATTAGATGGGCCACCAT\

93+\AATCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGGCCATTTGGTTGC\

94+\GACCCAGTCAGGTGAGGGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGAG\

95+\TTAATCTGGAGGATCTGTTTACTTTGGTCACCCATGGGCATTTGCTGTTGAAGTGACCTAGATTTGCCAT\

96+\CGAGCCTCCTTGGGAGCTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGGAGTTTGGCGCCAAGTCA\

97+\TATGACACATAATTGGTGAAGGGGGTGGCATCCTGCCCTGACCCTCCCCAAATTATTTTTTTAACAACTC\

98+\TCAGCAACGGATATCTCGGCTCTTGCATCGATGAAGAACGCAGCGAAATGCGATAAATGGTGTGAATTGC\

99+\AGAATCCCGTGAACCATCGAGTCTTTGGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCT\

100+\GCCTGGGCATTGGGAATCATATCTCTCCCCTAACGAGGCTATCCAAACATACTGTTCATCCGGTGCGGAT\

101+\GTGAGTTTGGCCCCTTGTTCTTTGGTACCGGGGGTCTAAGAGCTGCATGGGCATTTGATGGTCCTCAAAA\

102+\CGGCAAGAGGTGGACGAACTATGCCACAACAAAATTGTTGTCCCAAGGCCCCGGGTTGTCGTATTAGATG\

103+\GGCCACCGTAACCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGACCA\

104+\TTTGTTGCGACCCCAGTCAGCTGAGCAACCCGCTGAGTGGAAGGTCATTGCCGATATCACATAATAATTG\

105+\ATCGAGTTAATCTGGAGGATCTGTTTACTTGGTCACCCATGAGCATTTGCTGTTGAAGTGACCTAGATTT\

106+\GCCATCGAGCCTCCTTGGGAGTTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGGAGTTGTGCGCCA\

107+\AGTCATATGACACATAATTGGTGAAGGGGGTGGCATCCTGCCCTGACCCTCCCCAAATTATTTTTTTAAC\

108+\AACTCTCAGCAACGGATATCTCGGCTCTTGCATCGATGAAGAACGCAGCGAAATGCGATAAATGGTGTGA\

109+\ATTGCAGAATCCCGTGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCAC\

110+\GCCTGCCTGGGCATTGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACATACTGTTCATCCGGTGC\

111+\GGATGTGAGTTTGGCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGCTGCATGGGCATTTGATGGTCCTC\

112+\AAAACGGCAAGAGGTGGACGAACTATGCTACAACCAAATTGTTGTCCCAAGGCCCCGGGTTGTCGTATTA\

113+\GATGGGCCACCGTAACCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATG\

114+\ACCATGTGTTGCGACCCCAGTCAGCTGAGCAACGCGCTGAGCGTAACAAGGTTTCCGTAGGTGGACCTCC\

115+\GGGAGGATCATTGTTGAGATCACATAATAATTGATCGAGGTAATCTGGAGGATCTGCATATTTTGGTCAC"

tests/Tests/SlowFunctions.hs → tests/SlowFunctions.hsrenamed+9−8

@@ -1,8 +1,9 @@

11{-# LANGUAGE BangPatterns #-}

2−module Tests.SlowFunctions

2+

3+module SlowFunctions

34 (

45 indices

5− , splitOn

6+ , split

67 ) where

78

89import qualified Data.Text as T

@@ -22,12 +23,12 @@ indices needle@(Text _narr _noff nlen) haystack@(Text harr hoff hlen)

2223 where t = Text harr (hoff+i) (hlen-i)

2324 d = iter_ haystack i

2425

25−splitOn :: T.Text -- ^ Text to split on

26− -> T.Text -- ^ Input text

27− -> [T.Text]

28−splitOn pat src0

29− | T.null pat = error "splitOn: empty"

30− | l == 1 = T.split (== (unsafeHead pat)) src0

26+split :: T.Text -- ^ Text to split on

27+ -> T.Text -- ^ Input text

28+ -> [T.Text]

29+split pat src0

30+ | T.null pat = error "split: empty"

31+ | l == 1 = T.splitBy (== (unsafeHead pat)) src0

3132 | otherwise = go src0

3233 where

3334 l = T.length pat

tests/Tests.hsdeleted−13

@@ -1,13 +0,0 @@

1−-- | Provides a simple main function which runs all the tests

2−--

3−module Main

4− ( main

5− ) where

6−

7−import Test.Framework (defaultMain)

8−

9−import qualified Tests.Properties as Properties

10−import qualified Tests.Regressions as Regressions

11−

12−main :: IO ()

13−main = defaultMain [Properties.tests, Regressions.tests]

tests/Tests/IO.hsdeleted−34

@@ -1,34 +0,0 @@

1−-- | Program which exposes some haskell functions as an exutable. The results

2−-- and coverage of this module is meant to be checked using a shell script.

3−--

4−module Main

5− (

6− main

7− ) where

8−

9−import System.Environment (getArgs)

10−import System.Exit (exitFailure)

11−import System.IO (hPutStrLn, stderr)

12−import qualified Data.Text as T

13−import qualified Data.Text.IO as T

14−import qualified Data.Text.Lazy as TL

15−import qualified Data.Text.Lazy.IO as TL

16−

17−main :: IO ()

18−main = do

19− args <- getArgs

20− case args of

21− ["T.readFile", name] -> T.putStr =<< T.readFile name

22− ["T.writeFile", name, t] -> T.writeFile name (T.pack t)

23− ["T.appendFile", name, t] -> T.appendFile name (T.pack t)

24− ["T.interact"] -> T.interact id

25− ["T.getContents"] -> T.putStr =<< T.getContents

26− ["T.getLine"] -> T.putStrLn =<< T.getLine

27−

28− ["TL.readFile", name] -> TL.putStr =<< TL.readFile name

29− ["TL.writeFile", name, t] -> TL.writeFile name (TL.pack t)

30− ["TL.appendFile", name, t] -> TL.appendFile name (TL.pack t)

31− ["TL.interact"] -> TL.interact id

32− ["TL.getContents"] -> TL.putStr =<< TL.getContents

33− ["TL.getLine"] -> TL.putStrLn =<< TL.getLine

34− _ -> hPutStrLn stderr "invalid directive!" >> exitFailure

tests/Tests/Properties.hsdeleted−1363

@@ -1,1363 +0,0 @@

1−-- | QuickCheck properties for the text library.

2−

3−{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,

4− ScopedTypeVariables, TypeSynonymInstances #-}

5−{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}

6−module Tests.Properties

7− (

8− tests

9− ) where

10−

11−import Control.Applicative ((<$>), (<*>))

12−import Control.Arrow ((***), second)

13−import Data.Bits ((.&.))

14−import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)

15−import Data.Int (Int8, Int16, Int32, Int64)

16−import Data.Monoid (Monoid(..))

17−import Data.String (IsString(fromString))

18−import Data.Text.Encoding.Error

19−import 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.Lazy.Read as TL

24−import 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)

28−import Test.Framework (Test, testGroup)

29−import 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

37−import qualified Data.Bits as Bits (shiftL, shiftR)

38−import qualified Data.ByteString as B

39−import qualified Data.ByteString.Lazy as BL

40−import qualified Data.List as L

41−import qualified Data.Text as T

42−import qualified Data.Text.Encoding as E

43−import 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

49−import qualified Data.Text.Lazy as TL

50−import 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

53−import qualified Data.Text.Lazy.Encoding as EL

54−import qualified Data.Text.Lazy.IO as TL

55−import qualified System.IO as IO

56−import qualified Tests.Properties.Mul as Mul

57−import qualified Tests.SlowFunctions as Slow

58−

59−t_pack_unpack = (T.unpack . T.pack) `eq` id

60−tl_pack_unpack = (TL.unpack . TL.pack) `eq` id

61−t_stream_unstream = (S.unstream . S.stream) `eq` id

62−tl_stream_unstream = (SL.unstream . SL.stream) `eq` id

63−t_reverse_stream t = (S.reverse . S.reverseStream) t == t

64−t_singleton c = [c] == (T.unpack . T.singleton) c

65−tl_singleton c = [c] == (TL.unpack . TL.singleton) c

66−tl_unstreamChunks x = f 11 x == f 1000 x

67− where f n = SL.unstreamChunks n . S.streamList

68−tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id

69−tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id

70−

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−

77−t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a

78− where a = T.map (\c -> chr (ord c `mod` 128)) t

79−tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a

80− 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

85−t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id

86−t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)

87−tl_utf8 = forAll genUnicode $ (EL.decodeUtf8 . EL.encodeUtf8) `eq` id

88−tl_utf8' = forAll genUnicode $ (EL.decodeUtf8' . EL.encodeUtf8) `eq` (id . Right)

89−t_utf16LE = forAll genUnicode $ (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id

90−tl_utf16LE = forAll genUnicode $ (EL.decodeUtf16LE . EL.encodeUtf16LE) `eq` id

91−t_utf16BE = forAll genUnicode $ (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id

92−tl_utf16BE = forAll genUnicode $ (EL.decodeUtf16BE . EL.encodeUtf16BE) `eq` id

93−t_utf32LE = forAll genUnicode $ (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id

94−tl_utf32LE = forAll genUnicode $ (EL.decodeUtf32LE . EL.encodeUtf32LE) `eq` id

95−t_utf32BE = forAll genUnicode $ (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id

96−tl_utf32BE = forAll genUnicode $ (EL.decodeUtf32BE . EL.encodeUtf32BE) `eq` id

97−

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

138−

139−t_utf8_err' :: B.ByteString -> Property

140−t_utf8_err' bs = monadicIO . assert $ case E.decodeUtf8' bs of

141− Left err -> length (show err) >= 0

142− Right t -> T.length t >= 0

143−

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−

180−s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)

181− where _types = s :: String

182−sf_Eq p s =

183− ((L.filter p s==) . L.filter p) `eq`

184− (((S.filter p $ S.streamList s)==) . S.filter p . S.streamList)

185−t_Eq s = (s==) `eq` ((T.pack s==) . T.pack)

186−tl_Eq s = (s==) `eq` ((TL.pack s==) . TL.pack)

187−s_Ord s = (compare s) `eq` (compare (S.streamList s) . S.streamList)

188− where _types = s :: String

189−sf_Ord p s =

190− ((compare $ L.filter p s) . L.filter p) `eq`

191− (compare (S.filter p $ S.streamList s) . S.filter p . S.streamList)

192−t_Ord s = (compare s) `eq` (compare (T.pack s) . T.pack)

193−tl_Ord s = (compare s) `eq` (compare (TL.pack s) . TL.pack)

194−t_Read = id `eq` (T.unpack . read . show)

195−tl_Read = id `eq` (TL.unpack . read . show)

196−t_Show = show `eq` (show . T.pack)

197−tl_Show = show `eq` (show . TL.pack)

198−t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))

199−tl_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)

204−t_mempty = mempty == (unpackS (mempty :: T.Text))

205−tl_mempty = mempty == (unpackS (mempty :: TL.Text))

206−t_IsString = fromString `eqP` (T.unpack . fromString)

207−tl_IsString = fromString `eqP` (TL.unpack . fromString)

208−

209−s_cons x = (x:) `eqP` (unpackS . S.cons x)

210−s_cons_s x = (x:) `eqP` (unpackS . S.unstream . S.cons x)

211−sf_cons p x = ((x:) . L.filter p) `eqP` (unpackS . S.cons x . S.filter p)

212−t_cons x = (x:) `eqP` (unpackS . T.cons x)

213−tl_cons x = (x:) `eqP` (unpackS . TL.cons x)

214−s_snoc x = (++ [x]) `eqP` (unpackS . (flip S.snoc) x)

215−t_snoc x = (++ [x]) `eqP` (unpackS . (flip T.snoc) x)

216−tl_snoc x = (++ [x]) `eqP` (unpackS . (flip TL.snoc) x)

217−s_append s = (s++) `eqP` (unpackS . S.append (S.streamList s))

218−s_append_s s = (s++) `eqP`

219− (unpackS . S.unstream . S.append (S.streamList s))

220−sf_append p s = (L.filter p s++) `eqP`

221− (unpackS . S.append (S.filter p $ S.streamList s))

222−t_append s = (s++) `eqP` (unpackS . T.append (packS s))

223−

224−uncons (x:xs) = Just (x,xs)

225−uncons _ = Nothing

226−

227−s_uncons = uncons `eqP` (fmap (second unpackS) . S.uncons)

228−sf_uncons p = (uncons . L.filter p) `eqP`

229− (fmap (second unpackS) . S.uncons . S.filter p)

230−t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)

231−tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)

232−s_head = head `eqP` S.head

233−sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)

234−t_head = head `eqP` T.head

235−tl_head = head `eqP` TL.head

236−s_last = last `eqP` S.last

237−sf_last p = (last . L.filter p) `eqP` (S.last . S.filter p)

238−t_last = last `eqP` T.last

239−tl_last = last `eqP` TL.last

240−s_tail = tail `eqP` (unpackS . S.tail)

241−s_tail_s = tail `eqP` (unpackS . S.unstream . S.tail)

242−sf_tail p = (tail . L.filter p) `eqP` (unpackS . S.tail . S.filter p)

243−t_tail = tail `eqP` (unpackS . T.tail)

244−tl_tail = tail `eqP` (unpackS . TL.tail)

245−s_init = init `eqP` (unpackS . S.init)

246−s_init_s = init `eqP` (unpackS . S.unstream . S.init)

247−sf_init p = (init . L.filter p) `eqP` (unpackS . S.init . S.filter p)

248−t_init = init `eqP` (unpackS . T.init)

249−tl_init = init `eqP` (unpackS . TL.init)

250−s_null = null `eqP` S.null

251−sf_null p = (null . L.filter p) `eqP` (S.null . S.filter p)

252−t_null = null `eqP` T.null

253−tl_null = null `eqP` TL.null

254−s_length = length `eqP` S.length

255−sf_length p = (length . L.filter p) `eqP` (S.length . S.filter p)

256−sl_length = (fromIntegral . length) `eqP` SL.length

257−t_length = length `eqP` T.length

258−tl_length = L.genericLength `eqP` TL.length

259−t_compareLength t = (compare (T.length t)) `eq` T.compareLength t

260−tl_compareLength t= (compare (TL.length t)) `eq` TL.compareLength t

261−

262−s_map f = map f `eqP` (unpackS . S.map f)

263−s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)

264−sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)

265−t_map f = map f `eqP` (unpackS . T.map f)

266−tl_map f = map f `eqP` (unpackS . TL.map f)

267−s_intercalate c = unsquare $

268− L.intercalate c `eq`

269− (unpackS . S.intercalate (packS c) . map packS)

270−t_intercalate c = unsquare $

271− L.intercalate c `eq`

272− (unpackS . T.intercalate (packS c) . map packS)

273−tl_intercalate c = unsquare $

274− L.intercalate c `eq`

275− (unpackS . TL.intercalate (TL.pack c) . map TL.pack)

276−s_intersperse c = L.intersperse c `eqP`

277− (unpackS . S.intersperse c)

278−s_intersperse_s c = L.intersperse c `eqP`

279− (unpackS . S.unstream . S.intersperse c)

280−sf_intersperse p c= (L.intersperse c . L.filter p) `eqP`

281− (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)

290−t_reverse = L.reverse `eqP` (unpackS . T.reverse)

291−tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)

292−t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)

293−

294−t_replace s d = (L.intercalate d . splitOn s) `eqP`

295− (unpackS . T.replace (T.pack s) (T.pack d))

296−tl_replace s d = (L.intercalate d . splitOn s) `eqP`

297− (unpackS . TL.replace (TL.pack s) (TL.pack d))

298−

299−splitOn :: (Eq a) => [a] -> [a] -> [[a]]

300−splitOn pat src0

301− | l == 0 = error "splitOn: empty"

302− | otherwise = go src0

303− where

304− l = length pat

305− go src = search 0 src

306− where

307− search _ [] = [src]

308− search !n s@(_:s')

309− | pat `L.isPrefixOf` s = take n src : go (drop l s)

310− | otherwise = search (n+1) s'

311−

312−s_toCaseFold_length xs = S.length (S.toCaseFold s) >= length xs

313− where s = S.streamList xs

314−sf_toCaseFold_length p xs =

315− (S.length . S.toCaseFold . S.filter p $ s) >= (length . L.filter p $ xs)

316− where s = S.streamList xs

317−t_toCaseFold_length t = T.length (T.toCaseFold t) >= T.length t

318−tl_toCaseFold_length t = TL.length (TL.toCaseFold t) >= TL.length t

319−t_toLower_length t = T.length (T.toLower t) >= T.length t

320−t_toLower_lower t = p (T.toLower t) >= p t

321− where p = T.length . T.filter isLower

322−tl_toLower_lower t = p (TL.toLower t) >= p t

323− where p = TL.length . TL.filter isLower

324−t_toUpper_length t = T.length (T.toUpper t) >= T.length t

325−t_toUpper_upper t = p (T.toUpper t) >= p t

326− where p = T.length . T.filter isUpper

327−tl_toUpper_upper t = p (TL.toUpper t) >= p t

328− where p = TL.length . TL.filter isUpper

329−

330−justifyLeft k c xs = xs ++ L.replicate (k - length xs) c

331−justifyRight m n xs = L.replicate (m - length xs) n ++ xs

332−center k c xs

333− | len >= k = xs

334− | otherwise = L.replicate l c ++ xs ++ L.replicate r c

335− where len = length xs

336− d = k - len

337− r = d `div` 2

338− l = d - r

339−

340−s_justifyLeft k c = justifyLeft j c `eqP` (unpackS . S.justifyLeftI j c)

341− where j = fromIntegral (k :: Word8)

342−s_justifyLeft_s k c = justifyLeft j c `eqP`

343− (unpackS . S.unstream . S.justifyLeftI j c)

344− where j = fromIntegral (k :: Word8)

345−sf_justifyLeft p k c = (justifyLeft j c . L.filter p) `eqP`

346− (unpackS . S.justifyLeftI j c . S.filter p)

347− where j = fromIntegral (k :: Word8)

348−t_justifyLeft k c = justifyLeft j c `eqP` (unpackS . T.justifyLeft j c)

349− where j = fromIntegral (k :: Word8)

350−tl_justifyLeft k c = justifyLeft j c `eqP`

351− (unpackS . TL.justifyLeft (fromIntegral j) c)

352− where j = fromIntegral (k :: Word8)

353−t_justifyRight k c = justifyRight j c `eqP` (unpackS . T.justifyRight j c)

354− where j = fromIntegral (k :: Word8)

355−tl_justifyRight k c = justifyRight j c `eqP`

356− (unpackS . TL.justifyRight (fromIntegral j) c)

357− where j = fromIntegral (k :: Word8)

358−t_center k c = center j c `eqP` (unpackS . T.center j c)

359− where j = fromIntegral (k :: Word8)

360−tl_center k c = center j c `eqP` (unpackS . TL.center (fromIntegral j) c)

361− where j = fromIntegral (k :: Word8)

362−

363−sf_foldl p f z = (L.foldl f z . L.filter p) `eqP` (S.foldl f z . S.filter p)

364− where _types = f :: Char -> Char -> Char

365−t_foldl f z = L.foldl f z `eqP` (T.foldl f z)

366− where _types = f :: Char -> Char -> Char

367−tl_foldl f z = L.foldl f z `eqP` (TL.foldl f z)

368− where _types = f :: Char -> Char -> Char

369−sf_foldl' p f z = (L.foldl' f z . L.filter p) `eqP`

370− (S.foldl' f z . S.filter p)

371− where _types = f :: Char -> Char -> Char

372−t_foldl' f z = L.foldl' f z `eqP` T.foldl' f z

373− where _types = f :: Char -> Char -> Char

374−tl_foldl' f z = L.foldl' f z `eqP` TL.foldl' f z

375− where _types = f :: Char -> Char -> Char

376−sf_foldl1 p f = (L.foldl1 f . L.filter p) `eqP` (S.foldl1 f . S.filter p)

377−t_foldl1 f = L.foldl1 f `eqP` T.foldl1 f

378−tl_foldl1 f = L.foldl1 f `eqP` TL.foldl1 f

379−sf_foldl1' p f = (L.foldl1' f . L.filter p) `eqP` (S.foldl1' f . S.filter p)

380−t_foldl1' f = L.foldl1' f `eqP` T.foldl1' f

381−tl_foldl1' f = L.foldl1' f `eqP` TL.foldl1' f

382−sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)

383− where _types = f :: Char -> Char -> Char

384−t_foldr f z = L.foldr f z `eqP` T.foldr f z

385− where _types = f :: Char -> Char -> Char

386−tl_foldr f z = unsquare $

387− L.foldr f z `eqP` TL.foldr f z

388− 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)

391−t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f

392−tl_foldr1 f = unsquare $

393− L.foldr1 f `eqP` TL.foldr1 f

394−

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`

399− (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)

404−sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`

405− (unpackS . S.concatMap (packS . f) . S.filter p)

406−t_concatMap f = unsquare $

407− L.concatMap f `eqP` (unpackS . T.concatMap (packS . f))

408−tl_concatMap f = unsquare $

409− L.concatMap f `eqP` (unpackS . TL.concatMap (TL.pack . f))

410−sf_any q p = (L.any p . L.filter q) `eqP` (S.any p . S.filter q)

411−t_any p = L.any p `eqP` T.any p

412−tl_any p = L.any p `eqP` TL.any p

413−sf_all q p = (L.all p . L.filter q) `eqP` (S.all p . S.filter q)

414−t_all p = L.all p `eqP` T.all p

415−tl_all p = L.all p `eqP` TL.all p

416−sf_maximum p = (L.maximum . L.filter p) `eqP` (S.maximum . S.filter p)

417−t_maximum = L.maximum `eqP` T.maximum

418−tl_maximum = L.maximum `eqP` TL.maximum

419−sf_minimum p = (L.minimum . L.filter p) `eqP` (S.minimum . S.filter p)

420−t_minimum = L.minimum `eqP` T.minimum

421−tl_minimum = L.minimum `eqP` TL.minimum

422−

423−sf_scanl p f z = (L.scanl f z . L.filter p) `eqP`

424− (unpackS . S.scanl f z . S.filter p)

425−t_scanl f z = L.scanl f z `eqP` (unpackS . T.scanl f z)

426−tl_scanl f z = L.scanl f z `eqP` (unpackS . TL.scanl f z)

427−t_scanl1 f = L.scanl1 f `eqP` (unpackS . T.scanl1 f)

428−tl_scanl1 f = L.scanl1 f `eqP` (unpackS . TL.scanl1 f)

429−t_scanr f z = L.scanr f z `eqP` (unpackS . T.scanr f z)

430−tl_scanr f z = L.scanr f z `eqP` (unpackS . TL.scanr f z)

431−t_scanr1 f = L.scanr1 f `eqP` (unpackS . T.scanr1 f)

432−tl_scanr1 f = L.scanr1 f `eqP` (unpackS . TL.scanr1 f)

433−

434−t_mapAccumL f z = L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z)

435− where _types = f :: Int -> Char -> (Int,Char)

436−tl_mapAccumL f z = L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z)

437− where _types = f :: Int -> Char -> (Int,Char)

438−t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)

439− where _types = f :: Int -> Char -> (Int,Char)

440−tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)

441− where _types = f :: Int -> Char -> (Int,Char)

442−

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−

447−replicate n l = concat (L.replicate n l)

448−

449−s_replicate n = replicate m `eq`

450− (unpackS . S.replicateI (fromIntegral m) . packS)

451− where m = fromIntegral (n :: Word8)

452−t_replicate n = replicate m `eq` (unpackS . T.replicate m . packS)

453− where m = fromIntegral (n :: Word8)

454−tl_replicate n = replicate m `eq`

455− (unpackS . TL.replicate (fromIntegral m) . packS)

456− where m = fromIntegral (n :: Word8)

457−

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−

466−unf :: Int -> Char -> Maybe (Char, Char)

467−unf n c | fromEnum c * 100 > n = Nothing

468− | otherwise = Just (c, succ c)

469−

470−t_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . T.unfoldr (unf m))

471− where m = fromIntegral (n :: Word16)

472−tl_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . TL.unfoldr (unf m))

473− where m = fromIntegral (n :: Word16)

474−t_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`

475− (unpackS . T.unfoldrN i (unf j))

476− where i = fromIntegral (n :: Word16)

477− j = fromIntegral (m :: Word16)

478−tl_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`

479− (unpackS . TL.unfoldrN (fromIntegral i) (unf j))

480− where i = fromIntegral (n :: Word16)

481− j = fromIntegral (m :: Word16)

482−

483−unpack2 :: (Stringy s) => (s,s) -> (String,String)

484−unpack2 = unpackS *** unpackS

485−

486−s_take n = L.take n `eqP` (unpackS . S.take n)

487−s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)

488− where n = small m

489−sf_take p n = (L.take n . L.filter p) `eqP`

490− (unpackS . S.take n . S.filter p)

491−t_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)

494−tl_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)

497−s_drop n = L.drop n `eqP` (unpackS . S.drop n)

498−s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)

499− where n = small m

500−sf_drop p n = (L.drop n . L.filter p) `eqP`

501− (unpackS . S.drop n . S.filter p)

502−t_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)

505−tl_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))

508−s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)

509− where n = small m

510−s_take_drop_s m = (L.take n . L.drop n) `eqP`

511− (unpackS . S.unstream . S.take n . S.drop n)

512− where n = small m

513−s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)

514−s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)

515−sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`

516− (unpackS . S.takeWhile p . S.filter q)

517−t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)

518−tl_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)

523−s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

524−s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)

525−sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`

526− (unpackS . S.dropWhile p . S.filter q)

527−t_dropWhile p = L.dropWhile p `eqP` (unpackS . T.dropWhile p)

528−tl_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

529−t_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP`

530− (unpackS . T.dropWhileEnd p)

531−tl_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP`

532− (unpackS . TL.dropWhileEnd p)

533−t_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse)

534− `eqP` (unpackS . T.dropAround p)

535−tl_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse)

536− `eqP` (unpackS . TL.dropAround p)

537−t_stripStart = T.dropWhile isSpace `eq` T.stripStart

538−tl_stripStart = TL.dropWhile isSpace `eq` TL.stripStart

539−t_stripEnd = T.dropWhileEnd isSpace `eq` T.stripEnd

540−tl_stripEnd = TL.dropWhileEnd isSpace `eq` TL.stripEnd

541−t_strip = T.dropAround isSpace `eq` T.strip

542−tl_strip = TL.dropAround isSpace `eq` TL.strip

543−t_splitAt n = L.splitAt n `eqP` (unpack2 . T.splitAt n)

544−tl_splitAt n = L.splitAt n `eqP` (unpack2 . TL.splitAt (fromIntegral n))

545−t_span p = L.span p `eqP` (unpack2 . T.span p)

546−tl_span p = L.span p `eqP` (unpack2 . TL.span p)

547−

548−t_breakOn_id s = squid `eq` (uncurry T.append . T.breakOn s)

549− where squid t | T.null s = error "empty"

550− | otherwise = t

551−tl_breakOn_id s = squid `eq` (uncurry TL.append . TL.breakOn s)

552− where squid t | TL.null s = error "empty"

553− | otherwise = t

554−t_breakOn_start (NotEmpty s) t =

555− let (k,m) = T.breakOn s t

556− in k `T.isPrefixOf` t && (T.null m || s `T.isPrefixOf` m)

557−tl_breakOn_start (NotEmpty s) t =

558− let (k,m) = TL.breakOn s t

559− in k `TL.isPrefixOf` t && TL.null m || s `TL.isPrefixOf` m

560−t_breakOnEnd_end (NotEmpty s) t =

561− let (m,k) = T.breakOnEnd s t

562− in k `T.isSuffixOf` t && (T.null m || s `T.isSuffixOf` m)

563−tl_breakOnEnd_end (NotEmpty s) t =

564− let (m,k) = TL.breakOnEnd s t

565− in k `TL.isSuffixOf` t && (TL.null m || s `TL.isSuffixOf` m)

566−t_break p = L.break p `eqP` (unpack2 . T.break p)

567−tl_break p = L.break p `eqP` (unpack2 . TL.break p)

568−t_group = L.group `eqP` (map unpackS . T.group)

569−tl_group = L.group `eqP` (map unpackS . TL.group)

570−t_groupBy p = L.groupBy p `eqP` (map unpackS . T.groupBy p)

571−tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)

572−t_inits = L.inits `eqP` (map unpackS . T.inits)

573−tl_inits = L.inits `eqP` (map unpackS . TL.inits)

574−t_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 ->

578− let t = T.intercalate s ts

579− in all (==t) $ map (uncurry T.append) (T.breakOnAll s t)

580−tl_findAppendId = unsquare $ \(NotEmpty s) ts ->

581− let t = TL.intercalate s ts

582− 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) .

586− TL.breakOnAll s . TL.intercalate s

587−sl_filterCount c = (L.genericLength . L.filter (==c)) `eqP` SL.countChar c

588−t_findCount s = (L.length . T.breakOnAll s) `eq` T.count s

589−tl_findCount s = (L.genericLength . TL.breakOnAll s) `eq` TL.count s

590−

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

596−t_splitOn_i (NotEmpty t) = id `eq` (T.intercalate t . T.splitOn t)

597−tl_splitOn_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.splitOn t)

598−

599−t_split p = split p `eqP` (map unpackS . T.split p)

600−t_split_count c = (L.length . T.split (==c)) `eq`

601− ((1+) . T.count (T.singleton c))

602−t_split_splitOn c = T.split (==c) `eq` T.splitOn (T.singleton c)

603−tl_split p = split p `eqP` (map unpackS . TL.split p)

604−

605−split :: (a -> Bool) -> [a] -> [[a]]

606−split _ [] = [[]]

607−split p xs = loop xs

608− where loop s | null s' = [l]

609− | otherwise = l : loop (tail s')

610− where (l, s') = break p s

611−

612−t_chunksOf_same_lengths k = all ((==k) . T.length) . ini . T.chunksOf k

613− where ini [] = []

614− ini xs = init xs

615−

616−t_chunksOf_length k t = len == T.length t || (k <= 0 && len == 0)

617− where len = L.sum . L.map T.length $ T.chunksOf k t

618−

619−tl_chunksOf k = T.chunksOf k `eq` (map (T.concat . TL.toChunks) .

620− TL.chunksOf (fromIntegral k) . TL.fromStrict)

621−

622−t_lines = L.lines `eqP` (map unpackS . T.lines)

623−tl_lines = L.lines `eqP` (map unpackS . TL.lines)

624−{-

625−t_lines' = lines' `eqP` (map unpackS . T.lines')

626− where lines' "" = []

627− lines' s = let (l, s') = break eol s

628− in l : case s' of

629− [] -> []

630− ('\r':'\n':s'') -> lines' s''

631− (_:s'') -> lines' s''

632− eol c = c == '\r' || c == '\n'

633−-}

634−t_words = L.words `eqP` (map unpackS . T.words)

635−

636−tl_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)

645−

646−s_isPrefixOf s = L.isPrefixOf s `eqP`

647− (S.isPrefixOf (S.stream $ packS s) . S.stream)

648−sf_isPrefixOf p s = (L.isPrefixOf s . L.filter p) `eqP`

649− (S.isPrefixOf (S.stream $ packS s) . S.filter p . S.stream)

650−t_isPrefixOf s = L.isPrefixOf s`eqP` T.isPrefixOf (packS s)

651−tl_isPrefixOf s = L.isPrefixOf s`eqP` TL.isPrefixOf (packS s)

652−t_isSuffixOf s = L.isSuffixOf s`eqP` T.isSuffixOf (packS s)

653−tl_isSuffixOf s = L.isSuffixOf s`eqP` TL.isSuffixOf (packS s)

654−t_isInfixOf s = L.isInfixOf s `eqP` T.isInfixOf (packS s)

655−tl_isInfixOf s = L.isInfixOf s `eqP` TL.isInfixOf (packS s)

656−

657−t_stripPrefix s = (fmap packS . L.stripPrefix s) `eqP` T.stripPrefix (packS s)

658−tl_stripPrefix s = (fmap packS . L.stripPrefix s) `eqP` TL.stripPrefix (packS s)

659−

660−stripSuffix p t = reverse `fmap` L.stripPrefix (reverse p) (reverse t)

661−

662−t_stripSuffix s = (fmap packS . stripSuffix s) `eqP` T.stripSuffix (packS s)

663−tl_stripSuffix s = (fmap packS . stripSuffix s) `eqP` TL.stripSuffix (packS s)

664−

665−commonPrefixes a0@(_:_) b0@(_:_) = Just (go a0 b0 [])

666− where go (a:as) (b:bs) ps

667− | a == b = go as bs (a:ps)

668− go as bs ps = (reverse ps,as,bs)

669−commonPrefixes _ _ = Nothing

670−

671−t_commonPrefixes a b (NonEmpty p)

672− = commonPrefixes pa pb ==

673− repack `fmap` T.commonPrefixes (packS pa) (packS pb)

674− where repack (x,y,z) = (unpackS x,unpackS y,unpackS z)

675− pa = p ++ a

676− pb = p ++ b

677−

678−tl_commonPrefixes a b (NonEmpty p)

679− = commonPrefixes pa pb ==

680− repack `fmap` TL.commonPrefixes (packS pa) (packS pb)

681− where repack (x,y,z) = (unpackS x,unpackS y,unpackS z)

682− pa = p ++ a

683− pb = p ++ b

684−

685−sf_elem p c = (L.elem c . L.filter p) `eqP` (S.elem c . S.filter p)

686−sf_filter q p = (L.filter p . L.filter q) `eqP`

687− (unpackS . S.filter p . S.filter q)

688−t_filter p = L.filter p `eqP` (unpackS . T.filter p)

689−tl_filter p = L.filter p `eqP` (unpackS . TL.filter p)

690−sf_findBy q p = (L.find p . L.filter q) `eqP` (S.findBy p . S.filter q)

691−t_find p = L.find p `eqP` T.find p

692−tl_find p = L.find p `eqP` TL.find p

693−t_partition p = L.partition p `eqP` (unpack2 . T.partition p)

694−tl_partition p = L.partition p `eqP` (unpack2 . TL.partition p)

695−

696−sf_index p s = forAll (choose (-l,l*2))

697− ((L.filter p s L.!!) `eq` S.index (S.filter p $ packS s))

698− where l = L.length s

699−t_index s = forAll (choose (-l,l*2)) ((s L.!!) `eq` T.index (packS s))

700− where l = L.length s

701−

702−tl_index s = forAll (choose (-l,l*2))

703− ((s L.!!) `eq` (TL.index (packS s) . fromIntegral))

704− where l = L.length s

705−

706−t_findIndex p = L.findIndex p `eqP` T.findIndex p

707−t_count (NotEmpty t) = (subtract 1 . L.length . T.splitOn t) `eq` T.count t

708−tl_count (NotEmpty t) = (subtract 1 . L.genericLength . TL.splitOn t) `eq`

709− TL.count t

710−t_zip s = L.zip s `eqP` T.zip (packS s)

711−tl_zip s = L.zip s `eqP` TL.zip (packS s)

712−sf_zipWith p c s = (L.zipWith c (L.filter p s) . L.filter p) `eqP`

713− (unpackS . S.zipWith c (S.filter p $ packS s) . S.filter p)

714−t_zipWith c s = L.zipWith c s `eqP` (unpackS . T.zipWith c (packS s))

715−tl_zipWith c s = L.zipWith c s `eqP` (unpackS . TL.zipWith c (packS s))

716−

717−t_indices (NotEmpty s) = Slow.indices s `eq` indices s

718−tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s

719− where lazyIndices ss t = map fromIntegral $ Slow.indices (conc ss) (conc t)

720− 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

724−

725−-- Bit shifts.

726−shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k

727− where width = round (log (fromIntegral m) / log 2 :: Double)

728− (m,_) = (maxBound, m == w)

729−shiftR w = forAll (choose (0,width-1)) $ \k -> Bits.shiftR w k == U.shiftR w k

730− where width = round (log (fromIntegral m) / log 2 :: Double)

731− (m,_) = (maxBound, m == w)

732−

733−shiftL_Int = shiftL :: Int -> Property

734−shiftL_Word16 = shiftL :: Word16 -> Property

735−shiftL_Word32 = shiftL :: Word32 -> Property

736−shiftR_Int = shiftR :: Int -> Property

737−shiftR_Word16 = shiftR :: Word16 -> Property

738−shiftR_Word32 = shiftR :: Word32 -> Property

739−

740−-- Builder.

741−

742−tb_singleton = id `eqP`

743− (unpackS . TB.toLazyText . mconcat . map TB.singleton)

744−tb_fromText = L.concat `eq` (unpackS . TB.toLazyText . mconcat .

745− map (TB.fromText . packS))

746−tb_associative s1 s2 s3 =

747− TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) ==

748− TB.toLazyText ((b1 `mappend` b2) `mappend` b3)

749− where b1 = TB.fromText (packS s1)

750− b2 = TB.fromText (packS s2)

751− b3 = TB.fromText (packS s3)

752−

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−

812−-- Reading.

813−

814−t_decimal (n::Int) s =

815− T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)

816− where t = T.dropWhile isDigit s

817−tl_decimal (n::Int) s =

818− TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)

819− where t = TL.dropWhile isDigit s

820−t_hexadecimal m s ox =

821− T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)

822− where t = T.dropWhile isHexDigit s

823− p = if ox then "0x" else ""

824− n = getPositive m :: Int

825−tl_hexadecimal m s ox =

826− TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)

827− where t = TL.dropWhile isHexDigit s

828− p = if ox then "0x" else ""

829− n = getPositive m :: Int

830−

831−isFloaty c = c `elem` ("+-.0123456789eE" :: String)

832−

833−t_read_rational p tol (n::Double) s =

834− case p (T.pack (show n) `T.append` t) of

835− Left _err -> False

836− Right (n',t') -> t == t' && abs (n-n') <= tol

837− where t = T.dropWhile isFloaty s

838−

839−tl_read_rational p tol (n::Double) s =

840− case p (TL.pack (show n) `TL.append` t) of

841− Left _err -> False

842− Right (n',t') -> t == t' && abs (n-n') <= tol

843− where t = TL.dropWhile isFloaty s

844−

845−t_double = t_read_rational T.double 1e-13

846−tl_double = tl_read_rational TL.double 1e-13

847−t_rational = t_read_rational T.rational 1e-16

848−tl_rational = tl_read_rational TL.rational 1e-16

849−

850−-- Input and output.

851−

852−t_put_get = write_read T.unlines T.filter put get

853− where put h = withRedirect h IO.stdout . T.putStr

854− get h = withRedirect h IO.stdin T.getContents

855−tl_put_get = write_read TL.unlines TL.filter put get

856− where put h = withRedirect h IO.stdout . TL.putStr

857− get h = withRedirect h IO.stdin TL.getContents

858−t_write_read = write_read T.unlines T.filter T.hPutStr T.hGetContents

859−tl_write_read = write_read TL.unlines TL.filter TL.hPutStr TL.hGetContents

860−

861−t_write_read_line e m b t = write_read head T.filter T.hPutStrLn

862− T.hGetLine e m b [t]

863−tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn

864− TL.hGetLine e m b [t]

865−

866−-- Low-level.

867−

868−t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t

869−t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t

870−t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t

871− where n = small m

872−t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)

873−

874−t_copy t = T.copy t == t

875−

876−-- Regression tests.

877−s_filter_eq s = S.filter p t == S.streamList (filter p s)

878− where p = (/= S.last t)

879− t = S.streamList s

880−

881−-- Make a stream appear shorter than it really is, to ensure that

882−-- functions that consume inaccurately sized streams behave

883−-- themselves.

884−shorten :: Int -> S.Stream a -> S.Stream a

885−shorten n t@(S.Stream arr off len)

886− | n > 0 = S.Stream arr off (smaller (exactSize n) len)

887− | otherwise = t

888−

889−tests :: Test

890−tests =

891− testGroup "Properties" [

892− testGroup "creation/elimination" [

893− testProperty "t_pack_unpack" t_pack_unpack,

894− testProperty "tl_pack_unpack" tl_pack_unpack,

895− testProperty "t_stream_unstream" t_stream_unstream,

896− testProperty "tl_stream_unstream" tl_stream_unstream,

897− testProperty "t_reverse_stream" t_reverse_stream,

898− testProperty "t_singleton" t_singleton,

899− testProperty "tl_singleton" tl_singleton,

900− testProperty "tl_unstreamChunks" tl_unstreamChunks,

901− testProperty "tl_chunk_unchunk" tl_chunk_unchunk,

902− testProperty "tl_from_to_strict" tl_from_to_strict

903− ],

904−

905− testGroup "transcoding" [

906− testProperty "t_ascii" t_ascii,

907− testProperty "tl_ascii" tl_ascii,

908− testProperty "t_latin1" t_latin1,

909− testProperty "tl_latin1" tl_latin1,

910− testProperty "t_utf8" t_utf8,

911− testProperty "t_utf8'" t_utf8',

912− testProperty "t_utf8_incr" t_utf8_incr,

913− testProperty "t_utf8_undecoded" t_utf8_undecoded,

914− testProperty "tl_utf8" tl_utf8,

915− testProperty "tl_utf8'" tl_utf8',

916− testProperty "t_utf16LE" t_utf16LE,

917− testProperty "tl_utf16LE" tl_utf16LE,

918− testProperty "t_utf16BE" t_utf16BE,

919− testProperty "tl_utf16BE" tl_utf16BE,

920− testProperty "t_utf32LE" t_utf32LE,

921− testProperty "tl_utf32LE" tl_utf32LE,

922− testProperty "t_utf32BE" t_utf32BE,

923− testProperty "tl_utf32BE" tl_utf32BE,

924− testGroup "errors" [

925− testProperty "t_utf8_err" t_utf8_err,

926− testProperty "t_utf8_err'" t_utf8_err'

927− ]

928− ],

929−

930− testGroup "instances" [

931− testProperty "s_Eq" s_Eq,

932− testProperty "sf_Eq" sf_Eq,

933− testProperty "t_Eq" t_Eq,

934− testProperty "tl_Eq" tl_Eq,

935− testProperty "s_Ord" s_Ord,

936− testProperty "sf_Ord" sf_Ord,

937− testProperty "t_Ord" t_Ord,

938− testProperty "tl_Ord" tl_Ord,

939− testProperty "t_Read" t_Read,

940− testProperty "tl_Read" tl_Read,

941− testProperty "t_Show" t_Show,

942− testProperty "tl_Show" tl_Show,

943− testProperty "t_mappend" t_mappend,

944− testProperty "tl_mappend" tl_mappend,

945− testProperty "t_mconcat" t_mconcat,

946− testProperty "tl_mconcat" tl_mconcat,

947− testProperty "t_mempty" t_mempty,

948− testProperty "tl_mempty" tl_mempty,

949− testProperty "t_IsString" t_IsString,

950− testProperty "tl_IsString" tl_IsString

951− ],

952−

953− testGroup "basics" [

954− testProperty "s_cons" s_cons,

955− testProperty "s_cons_s" s_cons_s,

956− testProperty "sf_cons" sf_cons,

957− testProperty "t_cons" t_cons,

958− testProperty "tl_cons" tl_cons,

959− testProperty "s_snoc" s_snoc,

960− testProperty "t_snoc" t_snoc,

961− testProperty "tl_snoc" tl_snoc,

962− testProperty "s_append" s_append,

963− testProperty "s_append_s" s_append_s,

964− testProperty "sf_append" sf_append,

965− testProperty "t_append" t_append,

966− testProperty "s_uncons" s_uncons,

967− testProperty "sf_uncons" sf_uncons,

968− testProperty "t_uncons" t_uncons,

969− testProperty "tl_uncons" tl_uncons,

970− testProperty "s_head" s_head,

971− testProperty "sf_head" sf_head,

972− testProperty "t_head" t_head,

973− testProperty "tl_head" tl_head,

974− testProperty "s_last" s_last,

975− testProperty "sf_last" sf_last,

976− testProperty "t_last" t_last,

977− testProperty "tl_last" tl_last,

978− testProperty "s_tail" s_tail,

979− testProperty "s_tail_s" s_tail_s,

980− testProperty "sf_tail" sf_tail,

981− testProperty "t_tail" t_tail,

982− testProperty "tl_tail" tl_tail,

983− testProperty "s_init" s_init,

984− testProperty "s_init_s" s_init_s,

985− testProperty "sf_init" sf_init,

986− testProperty "t_init" t_init,

987− testProperty "tl_init" tl_init,

988− testProperty "s_null" s_null,

989− testProperty "sf_null" sf_null,

990− testProperty "t_null" t_null,

991− testProperty "tl_null" tl_null,

992− testProperty "s_length" s_length,

993− testProperty "sf_length" sf_length,

994− testProperty "sl_length" sl_length,

995− testProperty "t_length" t_length,

996− testProperty "tl_length" tl_length,

997− testProperty "t_compareLength" t_compareLength,

998− testProperty "tl_compareLength" tl_compareLength

999− ],

1000−

1001− testGroup "transformations" [

1002− testProperty "s_map" s_map,

1003− testProperty "s_map_s" s_map_s,

1004− testProperty "sf_map" sf_map,

1005− testProperty "t_map" t_map,

1006− testProperty "tl_map" tl_map,

1007− testProperty "s_intercalate" s_intercalate,

1008− testProperty "t_intercalate" t_intercalate,

1009− testProperty "tl_intercalate" tl_intercalate,

1010− testProperty "s_intersperse" s_intersperse,

1011− testProperty "s_intersperse_s" s_intersperse_s,

1012− testProperty "sf_intersperse" sf_intersperse,

1013− testProperty "t_intersperse" t_intersperse,

1014− testProperty "tl_intersperse" tl_intersperse,

1015− testProperty "t_transpose" t_transpose,

1016− testProperty "tl_transpose" tl_transpose,

1017− testProperty "t_reverse" t_reverse,

1018− testProperty "tl_reverse" tl_reverse,

1019− testProperty "t_reverse_short" t_reverse_short,

1020− testProperty "t_replace" t_replace,

1021− testProperty "tl_replace" tl_replace,

1022−

1023− testGroup "case conversion" [

1024− testProperty "s_toCaseFold_length" s_toCaseFold_length,

1025− testProperty "sf_toCaseFold_length" sf_toCaseFold_length,

1026− testProperty "t_toCaseFold_length" t_toCaseFold_length,

1027− testProperty "tl_toCaseFold_length" tl_toCaseFold_length,

1028− testProperty "t_toLower_length" t_toLower_length,

1029− testProperty "t_toLower_lower" t_toLower_lower,

1030− testProperty "tl_toLower_lower" tl_toLower_lower,

1031− testProperty "t_toUpper_length" t_toUpper_length,

1032− testProperty "t_toUpper_upper" t_toUpper_upper,

1033− testProperty "tl_toUpper_upper" tl_toUpper_upper

1034− ],

1035−

1036− testGroup "justification" [

1037− testProperty "s_justifyLeft" s_justifyLeft,

1038− testProperty "s_justifyLeft_s" s_justifyLeft_s,

1039− testProperty "sf_justifyLeft" sf_justifyLeft,

1040− testProperty "t_justifyLeft" t_justifyLeft,

1041− testProperty "tl_justifyLeft" tl_justifyLeft,

1042− testProperty "t_justifyRight" t_justifyRight,

1043− testProperty "tl_justifyRight" tl_justifyRight,

1044− testProperty "t_center" t_center,

1045− testProperty "tl_center" tl_center

1046− ]

1047− ],

1048−

1049− testGroup "folds" [

1050− testProperty "sf_foldl" sf_foldl,

1051− testProperty "t_foldl" t_foldl,

1052− testProperty "tl_foldl" tl_foldl,

1053− testProperty "sf_foldl'" sf_foldl',

1054− testProperty "t_foldl'" t_foldl',

1055− testProperty "tl_foldl'" tl_foldl',

1056− testProperty "sf_foldl1" sf_foldl1,

1057− testProperty "t_foldl1" t_foldl1,

1058− testProperty "tl_foldl1" tl_foldl1,

1059− testProperty "t_foldl1'" t_foldl1',

1060− testProperty "sf_foldl1'" sf_foldl1',

1061− testProperty "tl_foldl1'" tl_foldl1',

1062− testProperty "sf_foldr" sf_foldr,

1063− testProperty "t_foldr" t_foldr,

1064− testProperty "tl_foldr" tl_foldr,

1065− testProperty "sf_foldr1" sf_foldr1,

1066− testProperty "t_foldr1" t_foldr1,

1067− testProperty "tl_foldr1" tl_foldr1,

1068−

1069− testGroup "special" [

1070− testProperty "s_concat_s" s_concat_s,

1071− testProperty "sf_concat" sf_concat,

1072− testProperty "t_concat" t_concat,

1073− testProperty "tl_concat" tl_concat,

1074− testProperty "sf_concatMap" sf_concatMap,

1075− testProperty "t_concatMap" t_concatMap,

1076− testProperty "tl_concatMap" tl_concatMap,

1077− testProperty "sf_any" sf_any,

1078− testProperty "t_any" t_any,

1079− testProperty "tl_any" tl_any,

1080− testProperty "sf_all" sf_all,

1081− testProperty "t_all" t_all,

1082− testProperty "tl_all" tl_all,

1083− testProperty "sf_maximum" sf_maximum,

1084− testProperty "t_maximum" t_maximum,

1085− testProperty "tl_maximum" tl_maximum,

1086− testProperty "sf_minimum" sf_minimum,

1087− testProperty "t_minimum" t_minimum,

1088− testProperty "tl_minimum" tl_minimum

1089− ]

1090− ],

1091−

1092− testGroup "construction" [

1093− testGroup "scans" [

1094− testProperty "sf_scanl" sf_scanl,

1095− testProperty "t_scanl" t_scanl,

1096− testProperty "tl_scanl" tl_scanl,

1097− testProperty "t_scanl1" t_scanl1,

1098− testProperty "tl_scanl1" tl_scanl1,

1099− testProperty "t_scanr" t_scanr,

1100− testProperty "tl_scanr" tl_scanr,

1101− testProperty "t_scanr1" t_scanr1,

1102− testProperty "tl_scanr1" tl_scanr1

1103− ],

1104−

1105− testGroup "mapAccum" [

1106− testProperty "t_mapAccumL" t_mapAccumL,

1107− testProperty "tl_mapAccumL" tl_mapAccumL,

1108− testProperty "t_mapAccumR" t_mapAccumR,

1109− testProperty "tl_mapAccumR" tl_mapAccumR

1110− ],

1111−

1112− testGroup "unfolds" [

1113− testProperty "tl_repeat" tl_repeat,

1114− testProperty "s_replicate" s_replicate,

1115− testProperty "t_replicate" t_replicate,

1116− testProperty "tl_replicate" tl_replicate,

1117− testProperty "tl_cycle" tl_cycle,

1118− testProperty "tl_iterate" tl_iterate,

1119− testProperty "t_unfoldr" t_unfoldr,

1120− testProperty "tl_unfoldr" tl_unfoldr,

1121− testProperty "t_unfoldrN" t_unfoldrN,

1122− testProperty "tl_unfoldrN" tl_unfoldrN

1123− ]

1124− ],

1125−

1126− testGroup "substrings" [

1127− testGroup "breaking" [

1128− testProperty "s_take" s_take,

1129− testProperty "s_take_s" s_take_s,

1130− testProperty "sf_take" sf_take,

1131− testProperty "t_take" t_take,

1132− testProperty "t_takeEnd" t_takeEnd,

1133− testProperty "tl_take" tl_take,

1134− testProperty "tl_takeEnd" tl_takeEnd,

1135− testProperty "s_drop" s_drop,

1136− testProperty "s_drop_s" s_drop_s,

1137− testProperty "sf_drop" sf_drop,

1138− testProperty "t_drop" t_drop,

1139− testProperty "t_dropEnd" t_dropEnd,

1140− testProperty "tl_drop" tl_drop,

1141− testProperty "tl_dropEnd" tl_dropEnd,

1142− testProperty "s_take_drop" s_take_drop,

1143− testProperty "s_take_drop_s" s_take_drop_s,

1144− testProperty "s_takeWhile" s_takeWhile,

1145− testProperty "s_takeWhile_s" s_takeWhile_s,

1146− testProperty "sf_takeWhile" sf_takeWhile,

1147− testProperty "t_takeWhile" t_takeWhile,

1148− testProperty "tl_takeWhile" tl_takeWhile,

1149− testProperty "t_takeWhileEnd" t_takeWhileEnd,

1150− testProperty "tl_takeWhileEnd" tl_takeWhileEnd,

1151− testProperty "sf_dropWhile" sf_dropWhile,

1152− testProperty "s_dropWhile" s_dropWhile,

1153− testProperty "s_dropWhile_s" s_dropWhile_s,

1154− testProperty "t_dropWhile" t_dropWhile,

1155− testProperty "tl_dropWhile" tl_dropWhile,

1156− testProperty "t_dropWhileEnd" t_dropWhileEnd,

1157− testProperty "tl_dropWhileEnd" tl_dropWhileEnd,

1158− testProperty "t_dropAround" t_dropAround,

1159− testProperty "tl_dropAround" tl_dropAround,

1160− testProperty "t_stripStart" t_stripStart,

1161− testProperty "tl_stripStart" tl_stripStart,

1162− testProperty "t_stripEnd" t_stripEnd,

1163− testProperty "tl_stripEnd" tl_stripEnd,

1164− testProperty "t_strip" t_strip,

1165− testProperty "tl_strip" tl_strip,

1166− testProperty "t_splitAt" t_splitAt,

1167− testProperty "tl_splitAt" tl_splitAt,

1168− testProperty "t_span" t_span,

1169− testProperty "tl_span" tl_span,

1170− testProperty "t_breakOn_id" t_breakOn_id,

1171− testProperty "tl_breakOn_id" tl_breakOn_id,

1172− testProperty "t_breakOn_start" t_breakOn_start,

1173− testProperty "tl_breakOn_start" tl_breakOn_start,

1174− testProperty "t_breakOnEnd_end" t_breakOnEnd_end,

1175− testProperty "tl_breakOnEnd_end" tl_breakOnEnd_end,

1176− testProperty "t_break" t_break,

1177− testProperty "tl_break" tl_break,

1178− testProperty "t_group" t_group,

1179− testProperty "tl_group" tl_group,

1180− testProperty "t_groupBy" t_groupBy,

1181− testProperty "tl_groupBy" tl_groupBy,

1182− testProperty "t_inits" t_inits,

1183− testProperty "tl_inits" tl_inits,

1184− testProperty "t_tails" t_tails,

1185− testProperty "tl_tails" tl_tails

1186− ],

1187−

1188− testGroup "breaking many" [

1189− testProperty "t_findAppendId" t_findAppendId,

1190− testProperty "tl_findAppendId" tl_findAppendId,

1191− testProperty "t_findContains" t_findContains,

1192− testProperty "tl_findContains" tl_findContains,

1193− testProperty "sl_filterCount" sl_filterCount,

1194− testProperty "t_findCount" t_findCount,

1195− testProperty "tl_findCount" tl_findCount,

1196− testProperty "t_splitOn_split" t_splitOn_split,

1197− testProperty "tl_splitOn_split" tl_splitOn_split,

1198− testProperty "t_splitOn_i" t_splitOn_i,

1199− testProperty "tl_splitOn_i" tl_splitOn_i,

1200− testProperty "t_split" t_split,

1201− testProperty "t_split_count" t_split_count,

1202− testProperty "t_split_splitOn" t_split_splitOn,

1203− testProperty "tl_split" tl_split,

1204− testProperty "t_chunksOf_same_lengths" t_chunksOf_same_lengths,

1205− testProperty "t_chunksOf_length" t_chunksOf_length,

1206− testProperty "tl_chunksOf" tl_chunksOf

1207− ],

1208−

1209− testGroup "lines and words" [

1210− testProperty "t_lines" t_lines,

1211− testProperty "tl_lines" tl_lines,

1212− --testProperty "t_lines'" t_lines',

1213− testProperty "t_words" t_words,

1214− testProperty "tl_words" tl_words,

1215− testProperty "t_unlines" t_unlines,

1216− testProperty "tl_unlines" tl_unlines,

1217− testProperty "t_unwords" t_unwords,

1218− testProperty "tl_unwords" tl_unwords

1219− ]

1220− ],

1221−

1222− testGroup "predicates" [

1223− testProperty "s_isPrefixOf" s_isPrefixOf,

1224− testProperty "sf_isPrefixOf" sf_isPrefixOf,

1225− testProperty "t_isPrefixOf" t_isPrefixOf,

1226− testProperty "tl_isPrefixOf" tl_isPrefixOf,

1227− testProperty "t_isSuffixOf" t_isSuffixOf,

1228− testProperty "tl_isSuffixOf" tl_isSuffixOf,

1229− testProperty "t_isInfixOf" t_isInfixOf,

1230− testProperty "tl_isInfixOf" tl_isInfixOf,

1231−

1232− testGroup "view" [

1233− testProperty "t_stripPrefix" t_stripPrefix,

1234− testProperty "tl_stripPrefix" tl_stripPrefix,

1235− testProperty "t_stripSuffix" t_stripSuffix,

1236− testProperty "tl_stripSuffix" tl_stripSuffix,

1237− testProperty "t_commonPrefixes" t_commonPrefixes,

1238− testProperty "tl_commonPrefixes" tl_commonPrefixes

1239− ]

1240− ],

1241−

1242− testGroup "searching" [

1243− testProperty "sf_elem" sf_elem,

1244− testProperty "sf_filter" sf_filter,

1245− testProperty "t_filter" t_filter,

1246− testProperty "tl_filter" tl_filter,

1247− testProperty "sf_findBy" sf_findBy,

1248− testProperty "t_find" t_find,

1249− testProperty "tl_find" tl_find,

1250− testProperty "t_partition" t_partition,

1251− testProperty "tl_partition" tl_partition

1252− ],

1253−

1254− testGroup "indexing" [

1255− testProperty "sf_index" sf_index,

1256− testProperty "t_index" t_index,

1257− testProperty "tl_index" tl_index,

1258− testProperty "t_findIndex" t_findIndex,

1259− testProperty "t_count" t_count,

1260− testProperty "tl_count" tl_count,

1261− testProperty "t_indices" t_indices,

1262− testProperty "tl_indices" tl_indices,

1263− testProperty "t_indices_occurs" t_indices_occurs

1264− ],

1265−

1266− testGroup "zips" [

1267− testProperty "t_zip" t_zip,

1268− testProperty "tl_zip" tl_zip,

1269− testProperty "sf_zipWith" sf_zipWith,

1270− testProperty "t_zipWith" t_zipWith,

1271− testProperty "tl_zipWith" tl_zipWith

1272− ],

1273−

1274− testGroup "regressions" [

1275− testProperty "s_filter_eq" s_filter_eq

1276− ],

1277−

1278− testGroup "shifts" [

1279− testProperty "shiftL_Int" shiftL_Int,

1280− testProperty "shiftL_Word16" shiftL_Word16,

1281− testProperty "shiftL_Word32" shiftL_Word32,

1282− testProperty "shiftR_Int" shiftR_Int,

1283− testProperty "shiftR_Word16" shiftR_Word16,

1284− testProperty "shiftR_Word32" shiftR_Word32

1285− ],

1286−

1287− 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

1328− ],

1329−

1330− testGroup "read" [

1331− testProperty "t_decimal" t_decimal,

1332− testProperty "tl_decimal" tl_decimal,

1333− testProperty "t_hexadecimal" t_hexadecimal,

1334− testProperty "tl_hexadecimal" tl_hexadecimal,

1335− testProperty "t_double" t_double,

1336− testProperty "tl_double" tl_double,

1337− testProperty "t_rational" t_rational,

1338− testProperty "tl_rational" tl_rational

1339− ],

1340−

1341− {-

1342− testGroup "input-output" [

1343− testProperty "t_write_read" t_write_read,

1344− testProperty "tl_write_read" tl_write_read,

1345− testProperty "t_write_read_line" t_write_read_line,

1346− testProperty "tl_write_read_line" tl_write_read_line

1347− -- These tests are subject to I/O race conditions when run under

1348− -- test-framework-quickcheck2.

1349− -- testProperty "t_put_get" t_put_get

1350− -- testProperty "tl_put_get" tl_put_get

1351− ],

1352− -}

1353−

1354− testGroup "lowlevel" [

1355− testProperty "t_dropWord16" t_dropWord16,

1356− testProperty "t_takeWord16" t_takeWord16,

1357− 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

1363− ]

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− ]

tests/Tests/QuickCheckUtils.hsdeleted−360

@@ -1,360 +0,0 @@

1−-- | This module provides quickcheck utilities, e.g. arbitrary and show

2−-- instances, and comparison functions, so we can focus on the actual properties

3−-- in the 'Tests.Properties' module.

4−--

5−{-# LANGUAGE CPP, FlexibleInstances, TypeSynonymInstances #-}

6−{-# OPTIONS_GHC -fno-warn-orphans #-}

7−module Tests.QuickCheckUtils

8− (

9− genUnicode

10− , unsquare

11− , smallArbitrary

12−

13− , BigBounded(..)

14− , BigInt(..)

15− , NotEmpty(..)

16−

17− , Small(..)

18− , small

19−

20− , Precision(..)

21− , precision

22−

23− , integralRandomR

24−

25− , DecodeErr(..)

26− , genDecodeErr

27−

28− , Stringy(..)

29− , eq

30− , eqP

31−

32− , Encoding(..)

33−

34− , write_read

35− ) where

36−

37−import Control.Applicative ((<$>))

38−import Control.Arrow (first, (***))

39−import Control.DeepSeq (NFData (..), deepseq)

40−import Control.Exception (bracket)

41−import Data.String (IsString, fromString)

42−import Data.Text.Foreign (I16)

43−import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))

44−import Data.Word (Word8, Word16)

45−import Debug.Trace (trace)

46−import System.Random (Random(..), RandomGen)

47−import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))

48−import Test.QuickCheck.Monadic (assert, monadicIO, run)

49−import Test.QuickCheck.Unicode (string)

50−import Tests.Utils

51−import qualified Data.ByteString as B

52−import qualified Data.Text as T

53−import 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

58−import qualified Data.Text.Lazy as TL

59−import qualified System.IO as IO

60−

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

68−

69−instance Random I16 where

70− randomR = integralRandomR

71− random = randomR (minBound,maxBound)

72−

73−instance Arbitrary I16 where

74− arbitrary = arbitrarySizedIntegral

75− shrink = shrinkIntegral

76−

77−instance Arbitrary B.ByteString where

78− 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)

89−

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

98−

99−-- For tests that have O(n^2) running times or input sizes, resize

100−-- their inputs to the square root of the originals.

101−unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property

102−unsquare = forAll smallArbitrary

103−

104−smallArbitrary :: (Arbitrary a, Show a) => Gen a

105−smallArbitrary = sized $ \n -> resize (smallish n) arbitrary

106− where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs

107−

108−instance Arbitrary T.Text where

109− arbitrary = T.pack `fmap` arbitrary

110− shrink = map T.pack . shrink . T.unpack

111−

112−instance Arbitrary TL.Text where

113− 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)

129−

130−newtype NotEmpty a = NotEmpty { notEmpty :: a }

131− deriving (Eq, Ord)

132−

133−instance Show a => Show (NotEmpty a) where

134− show (NotEmpty a) = show a

135−

136−instance Functor NotEmpty where

137− fmap f (NotEmpty a) = NotEmpty (f a)

138−

139−instance Arbitrary a => Arbitrary (NotEmpty [a]) where

140− arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))

141− shrink = shrinkNotEmpty null

142−

143−instance Arbitrary (NotEmpty T.Text) where

144− arbitrary = (fmap T.pack) `fmap` arbitrary

145− shrink = shrinkNotEmpty T.null

146−

147−instance Arbitrary (NotEmpty TL.Text) where

148− arbitrary = (fmap TL.pack) `fmap` arbitrary

149− shrink = shrinkNotEmpty TL.null

150−

151−instance Arbitrary (NotEmpty B.ByteString) where

152− 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') ]

158−

159−data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7

160− | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15

161− | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23

162− | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31

163− deriving (Eq, Ord, Enum, Bounded)

164−

165−small :: Integral a => Small -> a

166−small = fromIntegral . fromEnum

167−

168−intf :: (Int -> Int -> Int) -> Small -> Small -> Small

169−intf f a b = toEnum ((fromEnum a `f` fromEnum b) `mod` 32)

170−

171−instance Show Small where

172− show = show . fromEnum

173−

174−instance Read Small where

175− readsPrec n = map (first toEnum) . readsPrec n

176−

177−instance Num Small where

178− fromInteger = toEnum . fromIntegral

179− signum _ = 1

180− abs = id

181− (+) = intf (+)

182− (-) = intf (-)

183− (*) = intf (*)

184−

185−instance Real Small where

186− toRational = toRational . fromEnum

187−

188−instance Integral Small where

189− toInteger = toInteger . fromEnum

190− quotRem a b = (toEnum x, toEnum y)

191− where (x, y) = fromEnum a `quotRem` fromEnum b

192−

193−instance Random Small where

194− randomR = integralRandomR

195− random = randomR (minBound,maxBound)

196−

197−instance Arbitrary Small where

198− arbitrary = choose (minBound, maxBound)

199− shrink = shrinkIntegral

200−

201−integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)

202−integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,

203− fromIntegral b :: Integer) g of

204− (x,h) -> (fromIntegral x, h)

205−

206−data DecodeErr = Lenient | Ignore | Strict | Replace

207− deriving (Show, Eq)

208−

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

214−

215−instance Arbitrary DecodeErr where

216− arbitrary = elements [Lenient, Ignore, Strict, Replace]

217−

218−class Stringy s where

219− packS :: String -> s

220− unpackS :: s -> String

221− splitAtS :: Int -> s -> (s,s)

222− packSChunkSize :: Int -> String -> s

223− packSChunkSize _ = packS

224−

225−instance Stringy String where

226− packS = id

227− unpackS = id

228− splitAtS = splitAt

229−

230−instance Stringy (TF.Stream Char) where

231− packS = TF.streamList

232− unpackS = TF.unstreamList

233− splitAtS n s = (TF.take n s, TF.drop n s)

234−

235−instance Stringy T.Text where

236− packS = T.pack

237− unpackS = T.unpack

238− splitAtS = T.splitAt

239−

240−instance Stringy TL.Text where

241− packSChunkSize k = TLF.unstreamChunks k . TF.streamList

242− packS = TL.pack

243− unpackS = TL.unpack

244− splitAtS = ((TL.lazyInvariant *** TL.lazyInvariant) .) .

245− TL.splitAt . fromIntegral

246−

247−-- Do two functions give the same answer?

248−eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool

249−eq a b s = a s =^= b s

250−

251−-- What about with the RHS packed?

252−eqP :: (Eq a, Show a, Stringy s) =>

253− (String -> a) -> (s -> a) -> String -> Word8 -> Bool

254−eqP f g s w = eql "orig" (f s) (g t) &&

255− eql "mini" (f s) (g mini) &&

256− eql "head" (f sa) (g ta) &&

257− eql "tail" (f sb) (g tb)

258− where t = packS s

259− mini = packSChunkSize 10 s

260− (sa,sb) = splitAt m s

261− (ta,tb) = splitAtS m t

262− l = length s

263− m | l == 0 = n

264− | otherwise = n `mod` l

265− n = fromIntegral w

266− eql d a b

267− | a =^= b = True

268− | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False

269−

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−

294−-- Work around lack of Show instance for TextEncoding.

295−data Encoding = E String IO.TextEncoding

296−

297−instance Show Encoding where show (E n _) = "utf" ++ n

298−

299−instance Arbitrary Encoding where

300− arbitrary = oneof . map return $

301− [ E "8" IO.utf8, E "8_bom" IO.utf8_bom, E "16" IO.utf16

302− , E "16le" IO.utf16le, E "16be" IO.utf16be, E "32" IO.utf32

303− , E "32le" IO.utf32le, E "32be" IO.utf32be

304− ]

305−

306−windowsNewlineMode :: IO.NewlineMode

307−windowsNewlineMode = IO.NewlineMode

308− { IO.inputNL = IO.CRLF, IO.outputNL = IO.CRLF

309− }

310−

311−instance Arbitrary IO.NewlineMode where

312− arbitrary = oneof . map return $

313− [ IO.noNewlineTranslation, IO.universalNewlineMode, IO.nativeNewlineMode

314− , windowsNewlineMode

315− ]

316−

317−instance Arbitrary IO.BufferMode where

318− arbitrary = oneof [ return IO.NoBuffering,

319− return IO.LineBuffering,

320− return (IO.BlockBuffering Nothing),

321− (IO.BlockBuffering . Just . (+1) . fromIntegral) `fmap`

322− (arbitrary :: Gen Word16) ]

323−

324−-- This test harness is complex! What property are we checking?

325−--

326−-- Reading after writing a multi-line file should give the same

327−-- results as were written.

328−--

329−-- What do we vary while checking this property?

330−-- * The lines themselves, scrubbed to contain neither CR nor LF. (By

331−-- working with a list of lines, we ensure that the data will

332−-- sometimes contain line endings.)

333−-- * Encoding.

334−-- * Newline translation mode.

335−-- * Buffering.

336−write_read :: (NFData a, Eq a)

337− => ([b] -> a)

338− -> ((Char -> Bool) -> a -> b)

339− -> (IO.Handle -> a -> IO ())

340− -> (IO.Handle -> IO a)

341− -> Encoding

342− -> IO.NewlineMode

343− -> IO.BufferMode

344− -> [a]

345− -> Property

346−write_read unline filt writer reader (E _ _) nl buf ts =

347− monadicIO $ assert . (==t) =<< run act

348− where t = unline . map (filt (not . (`elem` "\r\n"))) $ ts

349− act = withTempFile $ \path h -> do

350− -- hSetEncoding h enc

351− IO.hSetNewlineMode h nl

352− IO.hSetBuffering h buf

353− () <- writer h t

354− IO.hClose h

355− bracket (IO.openFile path IO.ReadMode) IO.hClose $ \h' -> do

356− -- hSetEncoding h' enc

357− IO.hSetNewlineMode h' nl

358− IO.hSetBuffering h' buf

359− r <- reader h'

360− r `deepseq` return r

tests/Tests/Regressions.hsdeleted−82

@@ -1,82 +0,0 @@

1−-- | Regression tests for specific bugs.

2−--

3−{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}

4−module Tests.Regressions

5− (

6− tests

7− ) where

8−

9−import Control.Exception (SomeException, handle)

10−import System.IO

11−import Test.HUnit (assertBool, assertEqual, assertFailure)

12−import qualified Data.ByteString as B

13−import Data.ByteString.Char8 ()

14−import qualified Data.ByteString.Lazy as LB

15−import qualified Data.Text as T

16−import qualified Data.Text.Encoding as TE

17−import qualified Data.Text.IO as T

18−import qualified Data.Text.Lazy as LT

19−import qualified Data.Text.Lazy.Encoding as LE

20−import qualified Data.Text.Unsafe as T

21−import qualified Test.Framework as F

22−import qualified Test.Framework.Providers.HUnit as F

23−

24−import Tests.Utils (withTempFile)

25−

26−-- Reported by Michael Snoyman: UTF-8 encoding a large lazy bytestring

27−-- caused either a segfault or attempt to allocate a negative number

28−-- of bytes.

29−lazy_encode_crash :: IO ()

30−lazy_encode_crash = withTempFile $ \ _ h ->

31− LB.hPut h . LE.encodeUtf8 . LT.pack . replicate 100000 $ 'a'

32−

33−-- Reported by Pieter Laeremans: attempting to read an incorrectly

34−-- encoded file can result in a crash in the RTS (i.e. not merely an

35−-- exception).

36−hGetContents_crash :: IO ()

37−hGetContents_crash = withTempFile $ \ path h -> do

38− B.hPut h (B.pack [0x78, 0xc4 ,0x0a]) >> hClose h

39− h' <- openFile path ReadMode

40− hSetEncoding h' utf8

41− handle (\(_::SomeException) -> return ()) $

42− T.hGetContents h' >> assertFailure "T.hGetContents should crash"

43−

44−-- Reported by Ian Lynagh: attempting to allocate a sufficiently large

45−-- string (via either Array.new or Text.replicate) could result in an

46−-- integer overflow.

47−replicate_crash :: IO ()

48−replicate_crash = handle (\(_::SomeException) -> return ()) $

49− T.replicate (2^power) "0123456789abcdef" `seq`

50− assertFailure "T.replicate should crash"

51− where

52− power | maxBound == (2147483647::Int) = 28

53− | otherwise = 60 :: Int

54−

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−

75−tests :: F.Test

76−tests = F.testGroup "Regressions"

77− [ F.testCase "hGetContents_crash" hGetContents_crash

78− , F.testCase "lazy_encode_crash" lazy_encode_crash

79− , F.testCase "mapAccumL_resize" mapAccumL_resize

80− , F.testCase "replicate_crash" replicate_crash

81− , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe

82− ]

tests/Tests/Utils.hsdeleted−52

@@ -1,52 +0,0 @@

1−-- | Miscellaneous testing utilities

2−--

3−{-# LANGUAGE ScopedTypeVariables #-}

4−module Tests.Utils

5− (

6− (=^=)

7− , withRedirect

8− , withTempFile

9− ) where

10−

11−import Control.Exception (SomeException, bracket, bracket_, evaluate, try)

12−import Control.Monad (when)

13−import Debug.Trace (trace)

14−import GHC.IO.Handle.Internals (withHandle)

15−import System.Directory (removeFile)

16−import System.IO (Handle, hClose, hFlush, hIsOpen, hIsWritable, openTempFile)

17−import System.IO.Unsafe (unsafePerformIO)

18−

19−-- Ensure that two potentially bottom values (in the sense of crashing

20−-- for some inputs, not looping infinitely) either both crash, or both

21−-- give comparable results for some input.

22−(=^=) :: (Eq a, Show a) => a -> a -> Bool

23−i =^= j = unsafePerformIO $ do

24− x <- try (evaluate i)

25− y <- try (evaluate j)

26− case (x,y) of

27− (Left (_ :: SomeException), Left (_ :: SomeException))

28− -> return True

29− (Right a, Right b) -> return (a == b)

30− e -> trace ("*** Divergence: " ++ show e) return False

31−infix 4 =^=

32−{-# NOINLINE (=^=) #-}

33−

34−withTempFile :: (FilePath -> Handle -> IO a) -> IO a

35−withTempFile = bracket (openTempFile "." "crashy.txt") cleanupTemp . uncurry

36− where

37− cleanupTemp (path,h) = do

38− open <- hIsOpen h

39− when open (hClose h)

40− removeFile path

41−

42−withRedirect :: Handle -> Handle -> IO a -> IO a

43−withRedirect tmp h = bracket_ swap swap

44− where

45− whenM p a = p >>= (`when` a)

46− swap = do

47− whenM (hIsOpen tmp) $ whenM (hIsWritable tmp) $ hFlush tmp

48− whenM (hIsOpen h) $ whenM (hIsWritable h) $ hFlush h

49− withHandle "spam" tmp $ \tmph -> do

50− hh <- withHandle "spam" h $ \hh ->

51− return (tmph,hh)

52− return (hh,())

tests/benchmarks/FileIndices.hsnew file+25

@@ -0,0 +1,25 @@

1+{-# LANGUAGE BangPatterns #-}

2+

3+import System.Environment (getArgs)

4+import qualified Data.Text.Lazy.IO as T

5+import qualified Data.Text.Lazy as T

6+import qualified Data.Text.Lazy.Encoding as T

7+import qualified Data.ByteString.Lazy.Char8 as B

8+import qualified Data.ByteString.Char8 as BS

9+import qualified Data.ByteString.Lazy.Search as B

10+

11+text :: FilePath -> String -> IO ()

12+text file pat = T.readFile file >>= print . T.count (T.pack pat)

13+

14+textBS :: FilePath -> String -> IO ()

15+textBS file pat = B.readFile file >>= print . T.count (T.pack pat) . T.decodeUtf8

16+

17+bytestring :: FilePath -> String -> IO ()

18+bytestring file pat = B.readFile file >>= print . length . B.indices (BS.pack pat)

19+

20+main = do

21+ (name : file : pat : _) <- getArgs

22+ case name of

23+ "bs" -> bytestring file pat

24+ "text" -> text file pat

25+ "textBS" -> textBS file pat

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/scripts/cover-stdio.shdeleted−62

@@ -1,62 +0,0 @@

1−#!/bin/bash

2−

3−if [[ $# < 1 ]]; then

4− echo "Usage: $0 <exe>"

5− exit 1

6−fi

7−

8−exe=$1

9−

10−rm -f $exe.tix

11−

12−f=$(mktemp stdio-f.XXXXXX)

13−g=$(mktemp stdio-g.XXXXXX)

14−

15−for t in T TL; do

16− echo $t.readFile > $f

17− $exe $t.readFile $f > $g

18− if ! diff -u $f $g; then

19− errs=$((errs+1))

20− echo FAIL: $t.readFile 1>&2

21− fi

22−

23− $exe $t.writeFile $f $t.writeFile

24− echo -n $t.writeFile > $g

25− if ! diff -u $f $g; then

26− errs=$((errs+1))

27− echo FAIL: $t.writeFile 1>&2

28− fi

29−

30− echo -n quux > $f

31− $exe $t.appendFile $f $t.appendFile

32− echo -n quux$t.appendFile > $g

33− if ! diff -u $f $g; then

34− errs=$((errs+1))

35− echo FAIL: $t.appendFile 1>&2

36− fi

37−

38− echo $t.interact | $exe $t.interact > $f

39− echo $t.interact > $g

40− if ! diff -u $f $g; then

41− errs=$((errs+1))

42− echo FAIL: $t.interact 1>&2

43− fi

44−

45− echo $t.getContents | $exe $t.getContents > $f

46− echo $t.getContents > $g

47− if ! diff -u $f $g; then

48− errs=$((errs+1))

49− echo FAIL: $t.getContents 1>&2

50− fi

51−

52− echo $t.getLine | $exe $t.getLine > $f

53− echo $t.getLine > $g

54− if ! diff -u $f $g; then

55− errs=$((errs+1))

56− echo FAIL: $t.getLine 1>&2

57− fi

58−done

59−

60−rm -f $f $g

61−

62−exit $errs

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+55−175

@@ -1,208 +1,88 @@

11name: text

2−version: 1.2.2.1

3−homepage: https://github.com/bos/text

4−bug-reports: https://github.com/bos/text/issues

5−synopsis: An efficient packed Unicode text type.

6−description:

7− .

8− An efficient packed, immutable Unicode text type (both strict and

9− lazy), with a powerful loop fusion optimization framework.

10− .

11− The 'Text' type represents Unicode character strings, in a time and

12− space-efficient manner. This package provides text processing

13− capabilities that are optimized for performance critical use, both

14− in terms of large data quantities and high speed.

15− .

16− The 'Text' type provides character-encoding, type-safe case

17− conversion via whole-string case conversion functions. It also

18− provides a range of functions for converting 'Text' values to and from

19− 'ByteStrings', using several standard encodings.

20− .

21− Efficient locale-sensitive support for text IO is also supported.

22− .

23− These modules are intended to be imported qualified, to avoid name

24− clashes with Prelude functions, e.g.

25− .

26− > import qualified Data.Text as T

27− .

28− To use an extended and very rich family of functions for working

29− with Unicode text (including normalization, regular expressions,

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

31− the @text-icu@ package:

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

33−

34−license: BSD2

2+version: 0.8.0.0

3+synopsis: An efficient packed Unicode text type

4+description: An efficient packed Unicode text type.

5+license: BSD3

356license-file: LICENSE

36−author: Bryan O'Sullivan <bos@serpentine.com>

7+author: Tom Harper <rtharper@aftereternity.co.uk>

378maintainer: Bryan O'Sullivan <bos@serpentine.com>

38−copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper

9+ Tom Harper <rtharper@aftereternity.co.uk>

10+ Duncan Coutts <duncan@haskell.org>

11+copyright: 2008-2009 Tom Harper, 2009-2010 Bryan O'Sullivan

3912category: Data, Text

4013build-type: Simple

41−cabal-version: >= 1.8

14+cabal-version: >= 1.2.3

4215extra-source-files:

16+ README

17+ TODO

18+ scripts/ApiCompare.hs

19+ scripts/Arsec.hs

20+ scripts/CaseFolding.hs

4321 -- scripts/CaseFolding.txt

22+ scripts/CaseMapping.hs

23+ scripts/SpecialCasing.hs

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

56− scripts/*.hs

57− tests-and-benchmarks.markdown

58− tests/*.hs

59− tests/.ghci

6025 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

26+ tests/Benchmarks.hs

27+ tests/Properties.hs

28+ tests/QuickCheckUtils.hs

29+ tests/SlowFunctions.hs

7130

7231flag developer

7332 description: operate in developer mode

7433 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

8134

8235library

83− c-sources: cbits/cbits.c

84− include-dirs: include

85−

8636 exposed-modules:

8737 Data.Text

88− Data.Text.Array

8938 Data.Text.Encoding

9039 Data.Text.Encoding.Error

9140 Data.Text.Foreign

9241 Data.Text.IO

93− 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

12042 Data.Text.Lazy

121− Data.Text.Lazy.Builder

122− Data.Text.Lazy.Builder.Int

123− Data.Text.Lazy.Builder.RealFloat

12443 Data.Text.Lazy.Encoding

12544 Data.Text.Lazy.IO

45+ other-modules:

46+ Data.Text.Array

47+ Data.Text.Encoding.Fusion

48+ Data.Text.Encoding.Fusion.Common

49+ Data.Text.Encoding.Utf16

50+ Data.Text.Encoding.Utf32

51+ Data.Text.Encoding.Utf8

52+ Data.Text.Fusion

53+ Data.Text.Fusion.CaseMapping

54+ Data.Text.Fusion.Common

55+ Data.Text.Fusion.Internal

56+ Data.Text.Fusion.Size

57+ Data.Text.IO.Internal

58+ Data.Text.Internal

59+ Data.Text.Lazy.Builder

60+ Data.Text.Lazy.Encoding.Fusion

61+ Data.Text.Lazy.Fusion

12662 Data.Text.Lazy.Internal

127− Data.Text.Lazy.Read

128− Data.Text.Read

63+ Data.Text.Lazy.Search

64+ Data.Text.Search

12965 Data.Text.Unsafe

130−

131− other-modules:

132− Data.Text.Show

66+ Data.Text.UnsafeChar

67+ Data.Text.UnsafeShift

13368

13469 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

70+ base < 5,

71+ bytestring >= 0.9 && < 1.0

72+ if impl(ghc >= 6.10)

73+ build-depends:

74+ ghc-prim, base >= 4, deepseq >= 1.1.0.0

75+ cpp-options: -DHAVE_DEEPSEQ

14476 else

145− build-depends: bytestring >= 0.10.4

77+ build-depends: extensible-exceptions

78+ extensions: PatternSignatures

79+

80+ -- gather extensive profiling data for now

81+ ghc-prof-options: -auto-all

14682

147− cpp-options: -DHAVE_DEEPSEQ

148− ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

83+ ghc-options: -Wall -funbox-strict-fields -O2

84+ if impl(ghc >= 6.8)

85+ ghc-options: -fwarn-tabs

14986 if flag(developer)

150− ghc-prof-options: -auto-all

15187 ghc-options: -Werror

15288 cpp-options: -DASSERTS

153−

154− if flag(integer-simple)

155− cpp-options: -DINTEGER_SIMPLE

156− build-depends: integer-simple >= 0.1 && < 0.5

157− else

158− cpp-options: -DINTEGER_GMP

159− build-depends: integer-gmp >= 0.2

160−

161−test-suite tests

162− type: exitcode-stdio-1.0

163− hs-source-dirs: tests .

164− main-is: Tests.hs

165− c-sources: cbits/cbits.c

166− include-dirs: include

167−

168− ghc-options:

169− -Wall -threaded -O0 -rtsopts

170−

171− cpp-options:

172− -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE

173−

174− 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

201−

202−source-repository head

203− type: git

204− location: https://github.com/bos/text

205−

206−source-repository head

207− type: mercurial

208− location: https://bitbucket.org/bos/text