d545ea0...master · text

.gitignorenew file+3

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

1+dist

2+cabal-dev

3+cabal.sandbox.config

.hgignorenew file+14

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

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

.hgtagsnew file+66

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

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+789−265

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

1−{-# LANGUAGE BangPatterns #-}

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

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

3+#if __GLASGOW_HASKELL__ >= 702

4+{-# LANGUAGE Trustworthy #-}

5+#endif

6+#if __GLASGOW_HASKELL__ >= 708

7+{-# LANGUAGE TypeFamilies #-}

8+#endif

39

410-- |

511-- Module : Data.Text

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

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

8−-- (c) Duncan Coutts 2009

915--

1016-- License : BSD-style

11−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

12−-- duncan@haskell.org

17+-- Maintainer : bos@serpentine.com

1318-- Stability : experimental

1419-- Portability : GHC

1520--

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.

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.

1927--

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

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

2230--

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

2437

2538module Data.Text

2639 (

40+ -- * Strict vs lazy types

41+ -- $strict

42+

43+ -- * Acceptable data

44+ -- $replacement

45+

2746 -- * Fusion

2847 -- $fusion

2948

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

4766 , init

4867 , null

4968 , length

69+ , compareLength

5070

5171 -- * Transformations

5272 , map

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

6181 , toCaseFold

6282 , toLower

6383 , toUpper

84+ , toTitle

6485

6586 -- ** Justification

6687 , justifyLeft

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

104125

105126 -- ** Breaking strings

106127 , take

128+ , takeEnd

107129 , drop

130+ , dropEnd

108131 , takeWhile

132+ , takeWhileEnd

109133 , dropWhile

110134 , dropWhileEnd

111135 , dropAround

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

113137 , stripStart

114138 , stripEnd

115139 , splitAt

116− , spanBy

140+ , breakOn

141+ , breakOnEnd

117142 , break

118− , breakBy

143+ , span

119144 , group

120145 , groupBy

121146 , inits

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

123148

124149 -- ** Breaking into many substrings

125150 -- $split

151+ , splitOn

126152 , split

127− , splitBy

128153 , chunksOf

129154

130155 -- ** Breaking into lines and words

@@ -139,131 +164,309 @@ module Data.Text

139164 , isSuffixOf

140165 , isInfixOf

141166

167+ -- ** View patterns

168+ , stripPrefix

169+ , stripSuffix

170+ , commonPrefixes

171+

142172 -- * Searching

143173 , filter

174+ , breakOnAll

144175 , find

145− , findBy

146− , partitionBy

176+ , partition

147177

148178 -- , findSubstring

149−

179+

150180 -- * Indexing

151181 -- $index

152182 , index

153183 , findIndex

154184 , count

155185

156− -- * Zipping and unzipping

186+ -- * Zipping

157187 , zip

158188 , zipWith

159189

160190 -- -* Ordered text

161191 -- , sort

192+

193+ -- * Low level operations

194+ , copy

195+ , unpackCString#

162196 ) where

163197

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

165− Eq(..), Ord(..), (++),

166− Read(..), Show(..),

167− (&&), (||), (+), (-), (.), ($),

168− fromIntegral, div, not, return, otherwise)

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

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

200+ Read(..),

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

202+ not, return, otherwise, quot)

203+#if defined(HAVE_DEEPSEQ)

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

205+#endif

206+#if defined(ASSERTS)

169207import Control.Exception (assert)

208+#endif

170209import Data.Char (isSpace)

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

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

212+import Control.Monad (foldM)

171213import Control.Monad.ST (ST)

172214import qualified Data.Text.Array as A

173215import qualified Data.List as L

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

174217import Data.Monoid (Monoid(..))

175−import Data.Word (Word16)

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

219+import Data.Semigroup (Semigroup(..))

220+#endif

176221import Data.String (IsString(..))

177−import qualified Data.Text.Fusion as S

178−import qualified Data.Text.Fusion.Common as S

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

180−import Data.Text.Internal (Text(..), empty, text, textP)

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

181229import qualified Prelude as P

182−import Data.Text.Unsafe (iter, iter_, reverseIter, unsafeHead, unsafeTail)

183−import Data.Text.UnsafeChar (unsafeChr)

184−import qualified Data.Text.Encoding.Utf16 as U16

185−import Data.Text.Search (indices)

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

186298

187299-- $fusion

188300--

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

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

191303-- 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\".

192323

193324instance Eq Text where

194− t1 == t2 = stream t1 == stream t2

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

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

327+ | otherwise = False

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

196329

197330instance Ord Text where

198− compare t1 t2 = compare (stream t1) (stream t2)

199− {-# INLINE compare #-}

200−

201−instance Show Text where

202− showsPrec p ps r = showsPrec p (unpack ps) r

331+ compare = compareText

203332

204333instance Read Text where

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

206335

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+

207344instance Monoid Text where

208345 mempty = empty

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

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

348+#else

209349 mappend = append

350+#endif

210351 mconcat = concat

211352

212353instance IsString Text where

213354 fromString = pack

214355

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+

363+#if defined(HAVE_DEEPSEQ)

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

365+#endif

366+

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.

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

377+--

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

389+

390+instance Data Text where

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

402+#endif

403+

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+

215424-- -----------------------------------------------------------------------------

216425-- * Conversion to/from 'Text'

217426

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

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

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

219429pack :: String -> Text

220−pack = unstream . S.streamList

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

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

222432

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

224−unpack :: Text -> String

225−unpack = S.unstreamList . stream

226−{-# INLINE [1] unpack #-}

227−

228−-- | /O(1)/ Convert a character into a Text.

229−-- Subject to fusion.

230−singleton :: Char -> Text

231−singleton = unstream . S.singleton

232−{-# INLINE [1] singleton #-}

233−

234433-- -----------------------------------------------------------------------------

235434-- * Basic functions

236435

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

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

239−-- copying a new array. Subject to fusion.

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

439+-- invalid scalar values.

240440cons :: Char -> Text -> Text

241−cons c t = unstream (S.cons c (stream t))

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

242442{-# INLINE cons #-}

243443

444+infixr 5 `cons`

445+

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

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

448+-- Performs replacement on invalid scalar values.

246449snoc :: Text -> Char -> Text

247−snoc t c = unstream (S.snoc (stream t) c)

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

248451{-# INLINE snoc #-}

249452

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

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

252455append :: Text -> Text -> Text

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

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"

254461 where

255462 len = len1+len2

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

256464 x = do

257− arr <- A.unsafeNew len :: ST s (A.MArray s Word16)

258− copy arr1 off1 (len1+off1) arr 0

259− copy arr2 off2 (len2+off2) arr len1

465+ arr <- A.new len

466+ A.copyI arr 0 arr1 off1 len1

467+ A.copyI arr len1 arr2 off2 len

260468 return arr

261− where

262− copy arr i top arr' j

263− | i >= top = return ()

264− | otherwise = do A.unsafeWrite arr' j (arr `A.unsafeIndex` i)

265− copy arr (i+1) top arr' (j+1)

266−{-# INLINE append #-}

469+{-# NOINLINE append #-}

267470

268471{-# RULES

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

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

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

284487uncons t@(Text arr off len)

285488 | len <= 0 = Nothing

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

287− where (c,d) = iter t 0

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

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

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

289492

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

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

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

293496

294−{-# RULES

295−"TEXT uncons -> fused" [~1] forall t.

296− uncons t = fmap (second unstream) (S.uncons (stream t))

297−"TEXT uncons -> unfused" [1] forall t.

298− fmap (second unstream) (S.uncons (stream t)) = uncons t

299− #-}

300−

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

302498-- non-empty. Subject to fusion.

303499last :: Text -> Char

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

321517tail :: Text -> Text

322518tail t@(Text arr off len)

323519 | len <= 0 = emptyError "tail"

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

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

325521 where d = iter_ t 0

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

327523

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

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

337533init :: Text -> Text

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

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

340− | otherwise = textP arr off (len-1)

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

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

341537 where

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

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

@@ -352,7 +548,11 @@ init (Text arr off len) | len <= 0 = emptyError "init"

352548-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to

353549-- fusion.

354550null :: Text -> Bool

355−null (Text _arr _off len) = assert (len >= 0) $ len <= 0

551+null (Text _arr _off len) =

552+#if defined(ASSERTS)

553+ assert (len >= 0) $

554+#endif

555+ len <= 0

356556{-# INLINE [1] null #-}

357557

358558{-# RULES

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

372572-- Subject to fusion.

373573length :: Text -> Int

374574length t = S.length (stream t)

375−{-# INLINE length #-}

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

376623

377624-- -----------------------------------------------------------------------------

378625-- * Transformations

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

380−-- each element of @t@. Subject to fusion.

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

628+-- invalid scalar values.

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

382−map f t = unstream (S.map f (stream t))

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

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

384632

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

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

387635-- argument between each element of the list.

388636intercalate :: Text -> [Text] -> Text

389−intercalate t ts = unstream (S.intercalate (stream t) (L.map stream ts))

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

390638{-# INLINE intercalate #-}

391639

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

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

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

642+-- replacement on invalid scalar values.

394643intersperse :: Char -> Text -> Text

395−intersperse c t = unstream (S.intersperse c (stream t))

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

396645{-# INLINE intersperse #-}

397646

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

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

400649reverse t = S.reverse (stream t)

401650{-# INLINE reverse #-}

402651

403−-- | /O(m*n)/ Replace every occurrence of one substring with another.

404−replace :: Text -- ^ Text to search for

405− -> Text -- ^ Replacement text

406− -> Text -- ^ Input text

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.

407682 -> Text

408−replace s d = intercalate d . split s

409−{-# INLINE replace #-}

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

410705

411706-- ----------------------------------------------------------------------------

412707-- ** Case conversions (folds)

@@ -421,10 +716,17 @@ replace s d = intercalate d . split s

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

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

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

424725

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

426−-- useful for performing caseless (also known as case insensitive)

427−-- string comparisons.

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.

428730--

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

430732--

@@ -439,27 +741,56 @@ replace s d = intercalate d . split s

439741-- instead of itself.

440742toCaseFold :: Text -> Text

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

442−{-# INLINE [0] toCaseFold #-}

744+{-# INLINE toCaseFold #-}

443745

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

445−-- conversion. The result string may be longer than the input string.

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

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

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

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

449753toLower :: Text -> Text

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

451755{-# INLINE toLower #-}

452756

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

454−-- conversion. The result string may be longer than the input string.

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

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

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

457763toUpper :: Text -> Text

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

459765{-# INLINE toUpper #-}

460766

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+

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

462−-- specified fill character on the right. Subject to fusion. Examples:

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

791+-- Performs replacement on invalid scalar values.

792+--

793+-- Examples:

463794--

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

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

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

478809 #-}

479810

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

481−-- specified fill character on the left. Examples:

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

813+-- invalid scalar values.

814+--

815+-- Examples:

482816--

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

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

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

489823 where len = length t

490824{-# INLINE justifyRight #-}

491825

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

493−-- specified fill character on either side. Examples:

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:

494831--

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

496833center :: Int -> Char -> Text -> Text

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

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

500837 where len = length t

501838 d = k - len

502− r = d `div` 2

839+ r = d `quot` 2

503840 l = d - r

504841{-# INLINE center #-}

505842

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

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

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

519856-- Subject to fusion.

520−foldl :: (b -> Char -> b) -> b -> Text -> b

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

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

522859{-# INLINE foldl #-}

523860

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

525−foldl' :: (b -> Char -> b) -> b -> Text -> b

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

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

527864{-# INLINE foldl' #-}

528865

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

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

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

543880-- Subject to fusion.

544−foldr :: (Char -> b -> b) -> b -> Text -> b

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

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

546883{-# INLINE foldr #-}

547884

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

549−-- and thust must be applied to a non-empty 'Text'. Subject to

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

550887-- fusion.

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

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

@@ -555,28 +892,36 @@ foldr1 f t = S.foldr1 f (stream t)

555892-- -----------------------------------------------------------------------------

556893-- ** Special folds

557894

558−-- | /O(n)/ Concatenate a list of 'Text's. Subject to fusion.

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

559896concat :: [Text] -> Text

560−concat ts = unstream (S.concat (L.map stream ts))

561−{-# INLINE concat #-}

897+concat ts = case ts' of

898+ [] -> empty

899+ [t] -> t

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

901+ where

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

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

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

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

562910

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

564−-- concatenate the results. Subject to fusion.

565−--

566−-- Note: if in 'concatMap' @f@ @t@, @f@ is defined in terms of fusible

567−-- functions, it will also be fusible.

912+-- concatenate the results.

568913concatMap :: (Char -> Text) -> Text -> Text

569−concatMap f t = unstream (S.concatMap (stream . f) (stream t))

914+concatMap f = concat . foldr ((:) . f) []

570915{-# INLINE concatMap #-}

571916

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

573−-- 'Text' @t@ satisifes the predicate @p@. Subject to fusion.

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

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

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

576921{-# INLINE any #-}

577922

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

579−-- 'Text' @t@ satisify the predicate @p@. Subject to fusion.

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

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

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

582927{-# INLINE all #-}

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

598943

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

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

946+-- Performs replacement on invalid scalar values.

601947--

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

603949--

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

605951--

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

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

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

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

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

609956{-# INLINE scanl #-}

610957

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

612−-- value argument. Subject to fusion.

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

960+-- invalid scalar values.

613961--

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

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

@@ -617,50 +965,63 @@ scanl1 f t | null t = empty

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

618966{-# INLINE scanl1 #-}

619967

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

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

969+-- replacement on invalid scalar values.

621970--

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

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

624−scanr f z = S.reverse . S.reverseScanr f z . reverseStream

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

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

625975{-# INLINE scanr #-}

626976

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

628−-- value argument. Subject to fusion.

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

979+-- invalid scalar values.

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

630981scanr1 f t | null t = empty

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

632983{-# INLINE scanr1 #-}

633984

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

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

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

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

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

988+-- replacement on invalid scalar values.

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

638−mapAccumL f s t = case uncons t of

639− Nothing -> (s, empty)

640− Just (x, xs) -> (s'', cons y ys)

641− where (s', y ) = f s x

642− (s'',ys) = mapAccumL f s' xs

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

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

992+{-# INLINE mapAccumL #-}

643993

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

645−-- 'foldr'; it applies a function to each element of a 'Text', passing

646−-- an accumulating parameter from right to left, and returning a final

647−-- value of this accumulator together with the new 'Text'.

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.

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

649−mapAccumR f s t = case uncons t of

650− Nothing -> (s, empty)

651− Just (x, xs) -> (s'', cons y ys)

652− where (s'',y ) = f s' x

653− (s', ys) = mapAccumR f s xs

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

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

1003+{-# INLINE mapAccumR #-}

6541004

6551005-- -----------------------------------------------------------------------------

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

6571007

6581008-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input

659−-- @t@ repeated @n@ times. Subject to fusion.

1009+-- @t@ repeated @n@ times.

6601010replicate :: Int -> Text -> Text

661−replicate n t

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

663− | otherwise = unstream (S.replicateI (fromIntegral n) (S.stream t))

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

1016+ where

1017+ len = l `mul` n

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

1019+ x = do

1020+ arr <- A.new len

1021+ let loop !d !i | i >= n = return arr

1022+ | otherwise = let m = d + l

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

1024+ loop 0 0

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

6651026

6661027{-# RULES

@@ -671,7 +1032,7 @@ replicate n t

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

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

6731034replicateChar :: Int -> Char -> Text

674−replicateChar n c = unstream (S.replicateCharI n c)

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

6751036{-# INLINE replicateChar #-}

6761037

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

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

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

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

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

683−-- to fusion.

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

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

685−unfoldr f s = unstream (S.unfoldr f s)

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

6861047{-# INLINE unfoldr #-}

6871048

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

@@ -690,9 +1051,9 @@ unfoldr f s = unstream (S.unfoldr f s)

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

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

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

693−-- to fusion.

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

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

695−unfoldrN n f s = unstream (S.unfoldrN n f s)

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

6961057{-# INLINE unfoldrN #-}

6971058

6981059-- -----------------------------------------------------------------------------

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

7051066take n t@(Text arr off len)

7061067 | n <= 0 = empty

7071068 | n >= len = t

708− | otherwise = Text arr off (loop 0 0)

709− where

710− loop !i !cnt

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

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

713− where d = iter_ t i

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

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

7151071

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+

7161079{-# RULES

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

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

@@ -720,18 +1083,36 @@ take n t@(Text arr off len)

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

7211084 #-}

7221085

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+

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

724−-- 'Text' of length @n@, or the empty 'Text' if @n@ is greater than the

725−-- length of the 'Text'. Subject to fusion.

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

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

7261110drop :: Int -> Text -> Text

7271111drop n t@(Text arr off len)

7281112 | n <= 0 = t

7291113 | n >= len = empty

730− | otherwise = loop 0 0

731− where loop !i !cnt

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

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

734− where d = iter_ t i

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

1115+ where i = iterN n t

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

7361117

7371118{-# RULES

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

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

7421123 #-}

7431124

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+

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

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

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

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

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

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

7501143 | p c = loop (i+d)

751− | otherwise = textP arr off i

752− where (c,d) = iter t i

1144+ | otherwise = text arr off i

1145+ where Iter c d = iter t i

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

7541147

7551148{-# RULES

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

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

7601153 #-}

7611154

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+

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

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

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

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

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

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

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

769− where (c,d) = iter t i

1183+ where Iter c d = iter t i

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

7711185

7721186{-# RULES

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

7771191 #-}

7781192

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

780−-- dropping characters that fail the predicate @p@ from the end of

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

7811195-- @t@. Subject to fusion.

1196+--

7821197-- Examples:

7831198--

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

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

7981213 #-}

7991214

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

801−-- dropping characters that fail the predicate @p@ from both the

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

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

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

8041219dropAround p = dropWhile p . dropWhileEnd p

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

8331248splitAt n t@(Text arr off len)

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

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

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

837− where k = loop 0 0

838− loop !i !cnt

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

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

841− where d = iter_ t i

842−{-# INLINE splitAt #-}

1251+ | otherwise = let k = iterN n t

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

8431253

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

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

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

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

8471257-- remainder of the list.

848−spanBy :: (Char -> Bool) -> Text -> (Text, Text)

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

850− where k = loop 0

851− loop !i | i >= len || not (p c) = i

852− | otherwise = loop (i+d)

853− where (c,d) = iter t i

854−{-# INLINE spanBy #-}

855−

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

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

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

858−breakBy :: (Char -> Bool) -> Text -> (Text, Text)

859−breakBy p = spanBy (not . p)

860−{-# INLINE breakBy #-}

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

1266+break p = span (not . p)

1267+{-# INLINE break #-}

8611268

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

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

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

8661273 loop t@(Text arr off len)

8671274 | null t = []

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

869− where (c,d) = iter t 0

1276+ where Iter c d = iter t 0

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

8711278

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

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

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

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

8781285 | otherwise = go (i+d)

879− where (c,d) = iter t i

880−

1286+ where Iter c d = iter t i

1287+

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

8821289group :: Text -> [Text]

8831290group = groupBy (==)

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

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

9021309-- are slices of the original.

9031310

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

905−-- 'Text' argument, consuming the delimiter. An empty delimiter is

906−-- invalid, and will cause an error to be raised.

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.

9071314--

9081315-- Examples:

9091316--

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

911−-- > split "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]

912−-- > split "x" "x" == ["",""]

913−--

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

9141321-- and

9151322--

916−-- > intercalate s . split s == id

917−-- > split (singleton c) == splitBy (==c)

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

9181327--

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

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

921−split :: Text -> Text -> [Text]

922−split pat@(Text _ _ l) src@(Text arr off len)

923− | l <= 0 = emptyError "split"

924− | isSingleton pat = splitBy (== unsafeHead pat) src

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

9251339 | otherwise = go 0 (indices pat src)

9261340 where

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

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

929−{-# INLINE [1] split #-}

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

9301344

9311345{-# RULES

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

933− split (singleton c) t = splitBy (==c) t

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

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

9341348 #-}

9351349

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

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

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

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

9401354--

941−-- > splitBy (=='a') "aabbaca" == ["","","bb","c",""]

942−-- > splitBy (=='a') "" == [""]

943−splitBy :: (Char -> Bool) -> Text -> [Text]

944−splitBy _ t@(Text _off _arr 0) = [t]

945−splitBy p t = loop t

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

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

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

948− where (l, s') = breakBy p s

949−{-# INLINE splitBy #-}

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

1363+{-# INLINE split #-}

9501364

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

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

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

9681382-------------------------------------------------------------------------------

9691383-- ** Searching with a predicate

9701384

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

972−-- returns the first element in matching the predicate, or 'Nothing'

973−-- if there is no such element.

974−findBy :: (Char -> Bool) -> Text -> Maybe Char

975−findBy p t = S.findBy p (stream t)

976−{-# INLINE findBy #-}

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

9771391

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

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

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

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

9811395--

982−-- > partitionBy p t == (filter p t, filter (not . p) t)

983−partitionBy :: (Char -> Bool) -> Text -> (Text, Text)

984−partitionBy p t = (filter p t, filter (not . p) t)

985−{-# INLINE partitionBy #-}

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

9861400

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

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

@@ -998,59 +1412,69 @@ filter p t = unstream (S.filter p (stream t))

9981412--

9991413-- Examples:

10001414--

1001−-- > break "::" "a::b::c" ==> ("a", "::b::c")

1002−-- > break "/" "foobar" ==> ("foobar", "")

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

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

10031417--

10041418-- Laws:

10051419--

10061420-- > append prefix match == haystack

1007−-- > where (prefix, match) = break needle haystack

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

10081422--

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

1010−-- want to break on every instance of a substring), use 'find'

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

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

10121426--

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

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

1015−break :: Text -> Text -> (Text, Text)

1016−break pat src@(Text arr off len)

1017− | null pat = emptyError "break"

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

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

1431+ | null pat = emptyError "breakOn"

10181432 | otherwise = case indices pat src of

10191433 [] -> (src, empty)

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

1021−{-# INLINE break #-}

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

1435+{-# INLINE breakOn #-}

1436+

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

1438+-- string.

1439+--

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

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

1442+-- remainder of @haystack@, following the match.

1443+--

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

10221449

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

1024−-- @haystack@. The first element of the returned pair is the prefix

1025−-- of @haystack@ prior to any matches of @needle@. The second is a

1026−-- list of pairs.

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

1452+--

1453+-- * The entire string prior to the /k/th match (i.e. the prefix)

10271454--

1028−-- The first element of each pair in the list is a span from the

1029−-- beginning of a match to the beginning of the next match, while the

1030−-- second is a span from the beginning of the match to the end of the

1031−-- input.

1455+-- * The /k/th match, followed by the remainder of the string

10321456--

10331457-- Examples:

10341458--

1035−-- > find "::" ""

1036−-- > ==> ("", [])

1037−-- > find "/" "a/b/c/d"

1038−-- > ==> ("a", [("/b","/b/c/d"), ("/c","/c/d"), ("/d","/d")])

1459+-- > breakOnAll "::" ""

1460+-- > ==> []

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

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

10391463--

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

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

1042−find :: Text -> Text -> (Text, [(Text, Text)])

1043−find pat src@(Text arr off len)

1044− | null pat = emptyError "find"

1045− | otherwise = case indices pat src of

1046− [] -> (src, [])

1047− (x:xs) -> (chunk 0 x, go x xs)

1466+--

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

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

10481474 where

1049− go !s (x:xs) = (chunk s (x-s), chunk s (len-s)) : go x xs

1050− go s _ = let c = chunk s (len-s)

1051− in [(c,c)]

1052− chunk !n !l = textP arr (n+off) l

1053−{-# INLINE find #-}

1475+ step x = (chunk 0 x, chunk x (slen-x))

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

1477+{-# INLINE breakOnAll #-}

10541478

10551479-------------------------------------------------------------------------------

10561480-- ** Indexing 'Text's

@@ -1069,7 +1493,7 @@ find pat src@(Text arr off len)

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

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

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

1072−-- before and after that index, you would instead use @find "::"@.

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

10731497

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

10751499index :: Text -> Int -> Char

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

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

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

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

1119−{-# INLINE [0] zip #-}

1543+{-# INLINE zip #-}

11201544

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

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

1547+-- Performs replacement on invalid scalar values.

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

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

1125−{-# INLINE [0] zipWith #-}

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

11261552

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

11281554-- representing white space.

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

11381564 then loop (start+1) (start+1)

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

11401566 | otherwise = loop start (n+d)

1141− where (c,d) = iter t n

1567+ where Iter c d = iter t n

11421568{-# INLINE words #-}

11431569

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

@@ -1148,9 +1574,10 @@ lines ps | null ps = []

11481574 | otherwise = h : if null t

11491575 then []

11501576 else lines (unsafeTail t)

1151− where (h,t) = spanBy (/= '\n') ps

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

11521578{-# INLINE lines #-}

11531579

1580+{-

11541581-- | /O(n)/ Portably breaks a 'Text' up into a list of 'Text's at line

11551582-- boundaries.

11561583--

@@ -1158,7 +1585,6 @@ lines ps | null ps = []

11581585-- return immediately followed by a line feed, or a carriage return.

11591586-- This accounts for both Unix and Windows line ending conventions,

11601587-- and for the old convention used on Mac OS 9 and earlier.

1161−{-

11621588lines' :: Text -> [Text]

11631589lines' ps | null ps = []

11641590 | otherwise = h : case uncons t of

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

11851611{-# INLINE unwords #-}

11861612

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

1188−-- 'True' iff the first is a prefix of the second. This function is

1189−-- subject to fusion.

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

11901615isPrefixOf :: Text -> Text -> Bool

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

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

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

11951620{-# RULES

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

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

1198−"TEXT isPrefixOf -> unfused" [1] forall s t.

1199− S.isPrefixOf (stream s) (stream t) = isPrefixOf s t

12001623 #-}

12011624

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

@@ -1227,5 +1650,106 @@ isInfixOf needle haystack

12271650 isInfixOf (singleton n) h = S.elem n (S.stream h)

12281651 #-}

12291652

1653+-------------------------------------------------------------------------------

1654+-- * View patterns

1655+

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

1657+-- matches the entire first string.

1658+--

1659+-- Examples:

1660+--

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

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

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

1664+--

1665+-- This is particularly useful with the @ViewPatterns@ extension to

1666+-- GHC, as follows:

1667+--

1668+-- > {-# LANGUAGE ViewPatterns #-}

1669+-- > import Data.Text as T

1670+-- >

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

1677+ | otherwise = Nothing

1678+

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

1685+--

1686+-- Examples:

1687+--

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

1710+--

1711+-- This is particularly useful with the @ViewPatterns@ extension to

1712+-- GHC, as follows:

1713+--

1714+-- > {-# LANGUAGE ViewPatterns #-}

1715+-- > import Data.Text as T

1716+-- >

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

1723+ | otherwise = Nothing

1724+

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+

12301734emptyError :: String -> a

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

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

Data/Text/Array.hs+166−232

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

1−{-# LANGUAGE BangPatterns, CPP, ExistentialQuantification, MagicHash,

2− Rank2Types, ScopedTypeVariables, UnboxedTuples #-}

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

2+ RecordWildCards, UnboxedTuples, UnliftedFFITypes #-}

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

44-- |

55-- Module : Data.Text.Array

6−-- Copyright : (c) Bryan O'Sullivan 2009

77--

88-- License : BSD-style

9−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

10−-- duncan@haskell.org

9+-- Maintainer : bos@serpentine.com

1110-- Stability : experimental

1211-- Portability : portable

1312--

@@ -21,292 +20,227 @@

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

2221--

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

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

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

2524-- naming.

2625module Data.Text.Array

2726 (

2827 -- * Types

29− IArray(..)

30− , Elt(..)

31− , Array

32− , MArray

28+ Array(Array, aBA)

29+ , MArray(MArray, maBA)

3330

3431 -- * Functions

32+ , copyM

33+ , copyI

3534 , empty

36− , new

37− , unsafeNew

38− , unsafeFreeze

35+ , equal

36+#if defined(ASSERTS)

37+ , length

38+#endif

3939 , run

4040 , run2

4141 , toList

42− , copy

43− , unsafeCopy

42+ , unsafeFreeze

43+ , unsafeIndex

44+ , new

45+ , unsafeWrite

4446 ) where

4547

46−#if 0

47−#define BOUNDS_CHECKING

48+#if defined(ASSERTS)

4849-- This fugly hack is brought by GHC's apparent reluctance to deal

4950-- with MagicHash and UnboxedTuples when inferring types. Eek!

50−#define CHECK_BOUNDS(_func_,_len_,_k_) \

51+# define CHECK_BOUNDS(_func_,_len_,_k_) \

5152if (_k_) < 0 || (_k_) >= (_len_) then error ("Data.Text.Array." ++ (_func_) ++ ": bounds error, offset " ++ show (_k_) ++ ", length " ++ show (_len_)) else

5253#else

53−#define CHECK_BOUNDS(_func_,_len_,_k_)

54+# define CHECK_BOUNDS(_func_,_len_,_k_)

5455#endif

5556

56−#if defined(__GLASGOW_HASKELL__)

5757#include "MachDeps.h"

5858

59−import GHC.Base (ByteArray#, MutableByteArray#, Int(..), indexIntArray#,

60− indexWord16Array#, newByteArray#, readIntArray#,

61− readWord16Array#, unsafeCoerce#, writeIntArray#,

62− writeWord16Array#, (+#), (*#))

63−import GHC.Prim (Int#)

64−import GHC.ST (ST(..), runST)

65−import GHC.Word (Word16(..))

66−

67−#elif defined(__HUGS__)

68−

69−import Hugs.ByteArray (ByteArray, MutableByteArray, readByteArray,

70− newMutableByteArray, readMutableByteArray,

71− unsafeFreezeMutableByteArray, writeMutableByteArray)

72−import Foreign.Storable (Storable, sizeOf)

73−import Hugs.ST (ST(..), runST)

74−

59+#if defined(ASSERTS)

60+import Control.Exception (assert)

61+#endif

62+#if __GLASGOW_HASKELL__ >= 702

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

7564#else

76−# error not implemented for this compiler

65+import Control.Monad.ST (unsafeIOToST)

7766#endif

78−

79−import Control.Exception (assert)

80−import Data.Typeable (Typeable1(..), Typeable2(..), TyCon, mkTyCon, mkTyConApp)

81−import Data.Word (Word16)

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

75+import GHC.Base (ByteArray#, MutableByteArray#, Int(..),

76+ indexWord16Array#, newByteArray#,

77+ unsafeFreezeByteArray#, writeWord16Array#)

78+import GHC.ST (ST(..), runST)

79+import GHC.Word (Word16(..))

8280import Prelude hiding (length, read)

8381

84−#include "Typeable.h"

85−

8682-- | Immutable array type.

87−data Array e = Array

88− {-# UNPACK #-} !Int -- length (in units of e, not bytes)

89−#if defined(__GLASGOW_HASKELL__)

90− ByteArray#

91−#elif defined(__HUGS__)

92− !ByteArray

83+data Array = Array {

84+ aBA :: ByteArray#

85+#if defined(ASSERTS)

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

9387#endif

94−

95−INSTANCE_TYPEABLE1(Array,arrayTc,"Array")

88+ }

9689

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

98−data MArray s e = MArray

99− {-# UNPACK #-} !Int -- length (in units of e, not bytes)

100−#if defined(__GLASGOW_HASKELL__)

101− (MutableByteArray# s)

102−#elif defined(__HUGS__)

103− !(MutableByteArray s)

91+data MArray s = MArray {

92+ maBA :: MutableByteArray# s

93+#if defined(ASSERTS)

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

10495#endif

96+ }

10597

106−INSTANCE_TYPEABLE2(MArray,mArrayTc,"MArray")

107−

98+#if defined(ASSERTS)

10899-- | Operations supported by all arrays.

109100class IArray a where

110101 -- | Return the length of an array.

111102 length :: a -> Int

112103

113−instance IArray (Array e) where

114− length (Array len _ba) = len

104+instance IArray Array where

105+ length = aLen

115106 {-# INLINE length #-}

116107

117−instance (Elt e, Show e) => Show (Array e) where

118− show = show . toList

119−

120−instance IArray (MArray s e) where

121− length (MArray len _ba) = len

108+instance IArray (MArray s) where

109+ length = maLen

122110 {-# INLINE length #-}

123−

124−check :: IArray a => String -> a -> Int -> (a -> Int -> b) -> b

125−check func ary i f

126− | i >= 0 && i < length ary = f ary i

127− | otherwise = error ("Data.Array.Flat." ++ func ++ ": index out of bounds")

128−{-# INLINE check #-}

129−

130−-- | Operations supported by all elements that can be stored in

131−-- arrays.

132−class Elt e where

133− -- | Indicate how many bytes would be used for an array of the

134− -- given size.

135− bytesInArray :: Int -> e -> Int

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

137− -- crash on an out-of-bounds access.

138− unsafeIndex :: Array e -> Int -> e

139− -- | Unchecked read of a mutable array. May return garbage or

140− -- crash on an out-of-bounds access.

141− unsafeRead :: MArray s e -> Int -> ST s e

142− -- | Unchecked write of a mutable array. May return garbage or

143− -- crash on an out-of-bounds access.

144− unsafeWrite :: MArray s e -> Int -> e -> ST s ()

145−

146− -- | Read an immutable array. An invalid index results in a

147− -- runtime error.

148− index :: Array e -> Int -> e

149− index ary i = check "index" ary i unsafeIndex

150− {-# INLINE index #-}

151−

152− -- | Read a mutable array. An invalid index results in a runtime

153− -- error.

154− read :: Array e -> Int -> ST s e

155− read ary i = check "read" ary i read

156− {-# INLINE read #-}

157−

158− -- | Write a mutable array. An invalid index results in a runtime

159− -- error.

160− write :: Array e -> Int -> ST s e

161− write ary i = check "write" ary i write

162− {-# INLINE write #-}

163−

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

165−unsafeFreeze :: MArray s e -> ST s (Array e)

166−

167−#if defined(__GLASGOW_HASKELL__)

168−

169−wORD16_SCALE :: Int# -> Int#

170−wORD16_SCALE n# = scale# *# n# where I# scale# = SIZEOF_WORD16

171−

172−-- | Create an uninitialized mutable array.

173−unsafeNew :: forall s e. Elt e => Int -> ST s (MArray s e)

174−unsafeNew n = assert (n >= 0) . ST $ \s1# ->

175− case bytesInArray n (undefined :: e) of

176− len@(I# len#) ->

177−#if defined(BOUNDS_CHECKING)

178− if len < 0 then error (show ("unsafeNew",len)) else

179111#endif

180− case newByteArray# len# s1# of

181− (# s2#, marr# #) -> (# s2#, MArray n marr# #)

182−{-# INLINE unsafeNew #-}

183−

184−unsafeFreeze (MArray len mba#) = ST $ \s# ->

185− (# s#, Array len (unsafeCoerce# mba#) #)

186−{-# INLINE unsafeFreeze #-}

187−

188−-- | Create a mutable array, with its elements initialized with the

189−-- given value.

190−new :: forall s e. Elt e => Int -> e -> ST s (MArray s e)

191−

192−#elif defined(__HUGS__)

193−

194−unsafeIndexArray :: Storable e => Array e -> Int -> e

195−unsafeIndexArray (Array off len arr) i =

196− assert (i >= 0 && i < len) $ readByteArray arr (off + i)

197−

198−unsafeReadMArray :: Storable e => MArray s e -> Int -> ST s e

199−unsafeReadMArray (MArray _len marr) i =

200− assert (i >= 0 && i < len) $ readMutableByteArray marr

201−

202−unsafeWriteMArray :: Storable e => MArray s e -> Int -> e -> ST s ()

203−unsafeWriteMArray (MArray len marr) i =

204− assert (i >= 0 && i < len) $ writeMutableByteArray marr

205112

206113-- | Create an uninitialized mutable array.

207−unsafeNew :: (Storable e) => Int -> ST s (MArray s e)

208−unsafeNew n = new undefined

209− where new :: (Storable e) => e -> ST s (MArray s e)

210− new unused = do

211− marr <- newMutableByteArray (n * sizeOf unused)

212− return (MArray n marr)

213−

214−unsafeFreeze (MArray len mba) = do

215− ba <- unsafeFreezeMutableByteArray mba

216− return (Array 0 len ba)

217−

218−-- | Create a mutable array, with its elements initialized with the

219−-- given value.

220−new :: (Storable e) => Int -> e -> ST s (MArray s e)

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#

120+#if defined(ASSERTS)

121+ n

221122#endif

123+ #)

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

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

126+{-# INLINE new #-}

222127

223−new len initVal = do

224− marr <- unsafeNew len

225− sequence_ [unsafeWrite marr i initVal | i <- [0..len-1]]

226− return marr

227−

228−instance Elt Word16 where

229−#if defined(__GLASGOW_HASKELL__)

230−

231− bytesInArray (I# i#) _ = I# (wORD16_SCALE i#)

232− {-# INLINE bytesInArray #-}

233−

234− unsafeIndex (Array len ba#) i@(I# i#) =

235− CHECK_BOUNDS("unsafeIndex",len,i)

236− case indexWord16Array# ba# i# of r# -> (W16# r#)

237− {-# INLINE unsafeIndex #-}

238−

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

240− CHECK_BOUNDS("unsafeRead",len,i)

241− case readWord16Array# mba# i# s# of

242− (# s2#, r# #) -> (# s2#, W16# r# #)

243− {-# INLINE unsafeRead #-}

244−

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

246− CHECK_BOUNDS("unsafeWrite",len,i)

247− case writeWord16Array# marr# i# e# s1# of

248− s2# -> (# s2#, () #)

249− {-# INLINE unsafeWrite #-}

250−

251−#elif defined(__HUGS__)

252−

253− bytesInArray n w = sizeOf w * n

254− unsafeIndex = unsafeIndexArray

255− unsafeRead = unsafeReadMArray

256− unsafeWrite = unsafeWriteMArray

128+array_size_error :: a

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

257130

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#

136+#if defined(ASSERTS)

137+ maLen

258138#endif

139+ #)

140+{-# INLINE unsafeFreeze #-}

141+

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

143+-- size.

144+bytesInArray :: Int -> Int

145+bytesInArray n = n `shiftL` 1

146+{-# INLINE bytesInArray #-}

147+

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

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

150+unsafeIndex :: Array -> Int -> Word16

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

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

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

154+{-# INLINE unsafeIndex #-}

155+

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

157+-- on an out-of-bounds access.

158+unsafeWrite :: 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

162+ s2# -> (# s2#, () #)

163+{-# INLINE unsafeWrite #-}

259164

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

261−toList :: Elt e => Array e -> [e]

262−toList a = loop 0

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

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)

264169 | otherwise = []

265− len = length a

266170

267171-- | An empty immutable array.

268−empty :: Elt e => Array e

269−empty = runST (unsafeNew 0 >>= unsafeFreeze)

172+empty :: Array

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

270174

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

272176-- its result.

273−run :: Elt e => (forall s. ST s (MArray s e)) -> Array e

177+run :: (forall s. ST s (MArray s)) -> Array

274178run k = runST (k >>= unsafeFreeze)

275179

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

277181-- its result paired with whatever else the action returns.

278−run2 :: Elt e => (forall s. ST s (MArray s e, a)) -> (Array e, a)

182+run2 :: (forall s. ST s (MArray s, a)) -> (Array, a)

279183run2 k = runST (do

280184 (marr,b) <- k

281185 arr <- unsafeFreeze marr

282186 return (arr,b))

283−

284−-- | Copy an array in its entirety. The destination array must be at

285−-- least as big as the source.

286−copy :: Elt e => MArray s e -- ^ source array

287− -> MArray s e -- ^ destination array

288− -> ST s ()

289−copy src dest

290− | length dest >= length src = copy_loop 0

291− | otherwise = fail "Data.Text.Array.copy: array too small"

292− where

293− len = length src

294− copy_loop i

295− | i >= len = return ()

296− | otherwise = do unsafeRead src i >>= unsafeWrite dest i

297− copy_loop (i+1)

298−{-# INLINE copy #-}

299−

300−-- | Unsafely copy the elements of an array.

301−unsafeCopy :: Elt e =>

302− MArray s e -> Int -> MArray s e -> Int -> Int -> ST s ()

303−unsafeCopy src sidx dest didx count =

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 =

199+#if defined(ASSERTS)

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

305− assert (didx + count <= length dest) $

306− copy_loop sidx didx 0

307− where

308− copy_loop !i !j !c

309− | c >= count = return ()

310− | otherwise = do unsafeRead src i >>= unsafeWrite dest j

311− copy_loop (i+1) (j+1) (c+1)

312−{-# INLINE unsafeCopy #-}

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

202+#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 ()

Data/Text/Encoding.hs+375−23

@@ -1,30 +1,40 @@

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

2+ UnliftedFFITypes #-}

3+#if __GLASGOW_HASKELL__ >= 702

4+{-# LANGUAGE Trustworthy #-}

5+#endif

16-- |

27-- Module : Data.Text.Encoding

3−-- Copyright : (c) Tom Harper 2008-2009,

4−-- (c) Bryan O'Sullivan 2009,

5−-- (c) Duncan Coutts 2009

611--

712-- License : BSD-style

8−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

9−-- duncan@haskell.org

13+-- Maintainer : bos@serpentine.com

1014-- Stability : experimental

1115-- Portability : portable

1216--

1317-- Functions for converting 'Text' values to and from 'ByteString',

1418-- using several standard encodings.

1519--

16−-- To make use of a much larger variety of encodings, use the @text-icu@

17−-- package.

20+-- To gain access to a much larger family of encodings, use the

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

1822

1923module Data.Text.Encoding

2024 (

2125 -- * Decoding ByteStrings to Text

26+ -- $strict

2227 decodeASCII

28+ , decodeLatin1

2329 , decodeUtf8

2430 , decodeUtf16LE

2531 , decodeUtf16BE

2632 , decodeUtf32LE

2733 , decodeUtf32BE

34+

35+ -- ** Catchable failure

36+ , decodeUtf8'

37+

2838 -- ** Controllable error handling

2939 , decodeUtf8With

3040 , decodeUtf16LEWith

@@ -32,39 +42,350 @@ module Data.Text.Encoding

3242 , decodeUtf32LEWith

3343 , decodeUtf32BEWith

3444

45+ -- ** Stream oriented decoding

46+ -- $stream

47+ , streamDecodeUtf8

48+ , streamDecodeUtf8With

49+ , Decoding(..)

50+

3551 -- * Encoding Text to ByteStrings

3652 , encodeUtf8

3753 , encodeUtf16LE

3854 , encodeUtf16BE

3955 , encodeUtf32LE

4056 , encodeUtf32BE

57+

58+ -- * Encoding Text using ByteString Builders

59+ , encodeUtf8Builder

60+ , encodeUtf8BuilderEscaped

4161 ) where

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.

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.

50114decodeASCII :: ByteString -> Text

51−decodeASCII bs = F.unstream (E.streamASCII bs)

52−{-# INLINE decodeASCII #-}

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

53129

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

55131decodeUtf8With :: OnDecodeError -> ByteString -> Text

56−decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)

57−{-# INLINE decodeUtf8With #-}

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

58157

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

158+-- $stream

159+--

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

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

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

163+--

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

165+-- given input.

166+--

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

168+-- insufficient input.

169+--

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

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

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

173+--

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

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

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

177+--

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

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

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

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

182+-- as we receive each one.

183+--

184+-- @

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

186+-- ghci> s0

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

188+-- @

189+--

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

191+--

192+-- @

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

194+-- ghci> s1

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

196+-- @

197+--

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

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

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

201+--

202+-- @

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

204+-- ghci> s2

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

206+-- @

207+--

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

209+-- or continuation where it is encountered.

210+

211+-- | A stream oriented decoding result.

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

213+

214+instance Show Decoding where

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

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

217+ showChar ' ' . showsPrec prec' bs .

218+ showString " _"

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

220+

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

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

223+

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

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

226+--

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

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

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

230+-- data, use 'streamDecodeUtf8With'.

231+streamDecodeUtf8 :: ByteString -> Decoding

232+streamDecodeUtf8 = streamDecodeUtf8With strictDecode

233+

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

235+-- encoded text.

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

237+streamDecodeUtf8With onErr = decodeChunk B.empty 0 0

238+ where

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

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

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

242+ -> Decoding

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

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

245+ where

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

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

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

249+ with codepoint0 $ \codepointPtr ->

250+ with state0 $ \statePtr ->

251+ with nullPtr $ \curPtrPtr ->

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

253+ loop curPtr = do

254+ poke curPtrPtr curPtr

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

256+ curPtrPtr end codepointPtr statePtr

257+ state <- peek statePtr

258+ case state of

259+ UTF8_REJECT -> do

260+ -- We encountered an encoding error

261+ x <- peek curPtr'

262+ poke statePtr 0

263+ case onErr desc (Just x) of

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

265+ Just c -> do

266+ destOff <- peek destOffPtr

267+ w <- unsafeSTToIO $

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

269+ poke destOffPtr (destOff + fromIntegral w)

270+ loop $ curPtr' `plusPtr` 1

271+

272+ _ -> do

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

274+ n <- peek destOffPtr

275+ codepoint <- peek codepointPtr

276+ chunkText <- unsafeSTToIO $ do

277+ arr <- A.unsafeFreeze dest

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

279+ lastPtr <- peek curPtrPtr

280+ let left = lastPtr `minusPtr` curPtr

281+ !undecoded = case state of

282+ UTF8_ACCEPT -> B.empty

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

284+ return $ Some chunkText undecoded

285+ (decodeChunk undecoded codepoint state)

286+ in loop (ptr `plusPtr` off)

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

288+

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

60296decodeUtf8 :: ByteString -> Text

61297decodeUtf8 = decodeUtf8With strictDecode

62−{-# INLINE decodeUtf8 #-}

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)

63370

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

65372encodeUtf8 :: Text -> ByteString

66−encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))

67−{-# INLINE encodeUtf8 #-}

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)

68389

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

70391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text

@@ -72,6 +393,10 @@ decodeUtf16LEWith onErr bs = F.unstream (E.streamUtf16LE onErr bs)

72393{-# INLINE decodeUtf16LEWith #-}

73394

74395-- | 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'.

75400decodeUtf16LE :: ByteString -> Text

76401decodeUtf16LE = decodeUtf16LEWith strictDecode

77402{-# INLINE decodeUtf16LE #-}

@@ -82,6 +407,10 @@ decodeUtf16BEWith onErr bs = F.unstream (E.streamUtf16BE onErr bs)

82407{-# INLINE decodeUtf16BEWith #-}

83408

84409-- | 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'.

85414decodeUtf16BE :: ByteString -> Text

86415decodeUtf16BE = decodeUtf16BEWith strictDecode

87416{-# INLINE decodeUtf16BE #-}

@@ -102,6 +431,10 @@ decodeUtf32LEWith onErr bs = F.unstream (E.streamUtf32LE onErr bs)

102431{-# INLINE decodeUtf32LEWith #-}

103432

104433-- | 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'.

105438decodeUtf32LE :: ByteString -> Text

106439decodeUtf32LE = decodeUtf32LEWith strictDecode

107440{-# INLINE decodeUtf32LE #-}

@@ -112,6 +445,10 @@ decodeUtf32BEWith onErr bs = F.unstream (E.streamUtf32BE onErr bs)

112445{-# INLINE decodeUtf32BEWith #-}

113446

114447-- | 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'.

115452decodeUtf32BE :: ByteString -> Text

116453decodeUtf32BE = decodeUtf32BEWith strictDecode

117454{-# INLINE decodeUtf32BE #-}

@@ -125,3 +462,18 @@ encodeUtf32LE txt = E.unstream (E.restreamUtf32LE (F.stream txt))

125462encodeUtf32BE :: Text -> ByteString

126463encodeUtf32BE txt = E.unstream (E.restreamUtf32BE (F.stream txt))

127464{-# 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+25−8

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

1−{-# LANGUAGE DeriveDataTypeable #-}

1+{-# LANGUAGE CPP, DeriveDataTypeable #-}

2+#if __GLASGOW_HASKELL__ >= 704

3+{-# LANGUAGE Safe #-}

4+#elif __GLASGOW_HASKELL__ >= 702

5+{-# LANGUAGE Trustworthy #-}

6+#endif

27-- |

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

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

510--

611-- License : BSD-style

7−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

8−-- duncan@haskell.org

12+-- Maintainer : bos@serpentine.com

913-- Stability : experimental

1014-- Portability : GHC

1115--

@@ -35,6 +39,7 @@ module Data.Text.Encoding.Error

3539 , replace

3640 ) where

3741

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

3843import Control.Exception (Exception, throw)

3944import Data.Typeable (Typeable)

4045import Data.Word (Word8)

@@ -58,7 +63,12 @@ import Numeric (showHex)

5863-- use the description provided to construct a more helpful error

5964-- report.

6065type OnError a b = String -> Maybe a -> Maybe b

66+

67+-- | A handler for a decoding error.

6168type 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." #-}

6272type OnEncodeError = OnError Char Word8

6373

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

@@ -69,7 +79,9 @@ data UnicodeException =

6979 | EncodeError String (Maybe Char)

7080 -- ^ Tried to encode a character that could not be represented

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

72− deriving (Typeable)

82+ deriving (Eq, Typeable)

83+

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

7385

7486showUnicodeException :: UnicodeException -> String

7587showUnicodeException (DecodeError desc (Just w))

@@ -80,23 +92,28 @@ showUnicodeException (EncodeError desc (Just c))

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

8193showUnicodeException (EncodeError desc Nothing)

8294 = "Cannot encode input: " ++ desc

83−

95+

8496instance Show UnicodeException where

8597 show = showUnicodeException

8698

8799instance Exception UnicodeException

88100

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+

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

90−strictDecode :: OnError Word8 Char

106+strictDecode :: OnDecodeError

91107strictDecode desc c = throw (DecodeError desc c)

92108

93109-- | Replace an invalid input byte with the Unicode replacement

94110-- character U+FFFD.

95−lenientDecode :: OnError Word8 Char

111+lenientDecode :: OnDecodeError

96112lenientDecode _ _ = Just '\xfffd'

97113

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

99−strictEncode :: OnError Char Word8

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

116+strictEncode :: OnEncodeError

100117strictEncode desc c = throw (EncodeError desc c)

101118

102119-- | Ignore an invalid input, substituting nothing in the output.

Data/Text/Encoding/Fusion/Common.hsdeleted−162

@@ -1,162 +0,0 @@

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 : rtharper@aftereternity.co.uk, bos@serpentine.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.Char (ord)

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

33−import Data.Text.Fusion.Internal (M(..), S(..))

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/Encoding/Utf16.hsdeleted−42

@@ -1,42 +0,0 @@

1−{-# LANGUAGE MagicHash #-}

2−

3−-- |

4−-- Module : Data.Text.Encoding.Utf16

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 : rtharper@aftereternity.co.uk, bos@serpentine.com,

11−-- duncan@haskell.org

12−-- Stability : experimental

13−-- Portability : GHC

14−--

15−-- Basic UTF-16 validation and character manipulation.

16−module Data.Text.Encoding.Utf16

17− (

18− chr2

19− , validate1

20− , validate2

21− ) where

22−

23−import GHC.Exts

24−import GHC.Word (Word16(..))

25−

26−chr2 :: Word16 -> Word16 -> Char

27−chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))

28− where

29− x# = word2Int# a#

30− y# = word2Int# b#

31− upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#

32− lower# = y# -# 0xDC00#

33−{-# INLINE chr2 #-}

34−

35−validate1 :: Word16 -> Bool

36−validate1 x1 = (x1 >= 0 && x1 < 0xD800) || x1 > 0xDFFF

37−{-# INLINE validate1 #-}

38−

39−validate2 :: Word16 -> Word16 -> Bool

40−validate2 x1 x2 = x1 >= 0xD800 && x1 <= 0xDBFF &&

41− x2 >= 0xDC00 && x2 <= 0xDFFF

42−{-# INLINE validate2 #-}

Data/Text/Encoding/Utf32.hsdeleted−23

@@ -1,23 +0,0 @@

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 : rtharper@aftereternity.co.uk, bos@serpentine.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/Foreign.hs+102−18

@@ -1,11 +1,10 @@

1−{-# LANGUAGE BangPatterns #-}

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

22-- |

33-- Module : Data.Text.Foreign

4−-- Copyright : (c) Bryan O'Sullivan 2009

55--

66-- License : BSD-style

7−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

8−-- duncan@haskell.org

7+-- Maintainer : bos@serpentine.com

98-- Stability : experimental

109-- Portability : GHC

1110--

@@ -16,23 +15,42 @@ module Data.Text.Foreign

1615 (

1716 -- * Interoperability with native code

1817 -- $interop

19−

18+ I16

2019 -- * Safe conversion functions

21− fromPtr

20+ , fromPtr

2221 , useAsPtr

22+ , asForeignPtr

23+ -- ** Encoding as UTF-8

24+ , peekCStringLen

25+ , withCStringLen

2326 -- * Unsafe conversion code

2427 , lengthWord16

2528 , unsafeCopyToPtr

29+ -- * Low-level manipulation

30+ -- $lowlevel

31+ , dropWord16

32+ , takeWord16

2633 ) where

2734

35+#if defined(ASSERTS)

2836import Control.Exception (assert)

37+#endif

38+#if __GLASGOW_HASKELL__ >= 702

39+import Control.Monad.ST.Unsafe (unsafeIOToST)

40+#else

2941import Control.Monad.ST (unsafeIOToST)

42+#endif

43+import Data.ByteString.Unsafe (unsafePackCStringLen, unsafeUseAsCStringLen)

44+import Data.Text.Encoding (decodeUtf8, encodeUtf8)

3045import Data.Text.Internal (Text(..), empty)

31−import qualified Data.Text.Array as A

46+import Data.Text.Unsafe (lengthWord16)

3247import Data.Word (Word16)

48+import Foreign.C.String (CStringLen)

49+import Foreign.ForeignPtr (ForeignPtr, mallocForeignPtrArray, withForeignPtr)

3350import Foreign.Marshal.Alloc (allocaBytes)

3451import Foreign.Ptr (Ptr, castPtr, plusPtr)

3552import Foreign.Storable (peek, poke)

53+import qualified Data.Text.Array as A

3654

3755-- $interop

3856--

@@ -47,15 +65,23 @@ import Foreign.Storable (peek, poke)

4765-- internal representations, such as UTF-8 or UTF-32, consider using

4866-- the functions in the 'Data.Text.Encoding' module.

4967

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+

5072-- | /O(n)/ Create a new 'Text' from a 'Ptr' 'Word16' by copying the

5173-- contents of the array.

5274fromPtr :: Ptr Word16 -- ^ source array

53− -> Int -- ^ length of source array (in 'Word16' units)

75+ -> I16 -- ^ length of source array (in 'Word16' units)

5476 -> IO Text

55−fromPtr _ 0 = return empty

56−fromPtr ptr len = assert (len > 0) $ return (Text arr 0 len)

77+fromPtr _ (I16 0) = return empty

78+fromPtr ptr (I16 len) =

79+#if defined(ASSERTS)

80+ assert (len > 0) $

81+#endif

82+ return $! Text arr 0 len

5783 where

58− arr = A.run (A.unsafeNew len >>= copy)

84+ arr = A.run (A.new len >>= copy)

5985 copy marr = loop ptr 0

6086 where

6187 loop !p !i | i == len = return marr

@@ -63,11 +89,44 @@ fromPtr ptr len = assert (len > 0) $ return (Text arr 0 len)

6389 A.unsafeWrite marr i =<< unsafeIOToST (peek p)

6490 loop (p `plusPtr` 2) (i + 1)

6591

66−-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This

67−-- is useful for sizing a target array appropriately before using

68−-- 'unsafeCopyToPtr'.

69−lengthWord16 :: Text -> Int

70−lengthWord16 (Text _arr _off len) = len

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)

71130

72131-- | /O(n)/ Copy a 'Text' to an array. The array is assumed to be big

73132-- enough to hold the contents of the entire 'Text'.

@@ -82,8 +141,33 @@ unsafeCopyToPtr (Text arr off len) ptr = loop ptr off

82141

83142-- | /O(n)/ Perform an action on a temporary, mutable copy of a

84143-- 'Text'. The copy is freed as soon as the action returns.

85−useAsPtr :: Text -> (Ptr Word16 -> Int -> IO a) -> IO a

144+useAsPtr :: Text -> (Ptr Word16 -> I16 -> IO a) -> IO a

86145useAsPtr t@(Text _arr _off len) action =

87146 allocaBytes (len * 2) $ \buf -> do

88147 unsafeCopyToPtr t buf

89− action (castPtr buf) len

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

Data/Text/Fusion/CaseMapping.hsdeleted−456

@@ -1,456 +0,0 @@

1−{-# LANGUAGE Rank2Types #-}

2−-- AUTOMATICALLY GENERATED - DO NOT EDIT

3−-- Generated by scripts/SpecialCasing.hs

4−module Data.Text.Fusion.CaseMapping where

5−import Data.Char

6−import Data.Text.Fusion.Internal

7−

8−upperMapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char

9−{-# INLINE upperMapping #-}

10−-- LATIN SMALL LETTER SHARP S

11−upperMapping '\x00df' s = Yield '\x0053' (s :*: '\x0053' :*: '\x0000')

12−-- LATIN SMALL LIGATURE FF

13−upperMapping '\xfb00' s = Yield '\x0046' (s :*: '\x0046' :*: '\x0000')

14−-- LATIN SMALL LIGATURE FI

15−upperMapping '\xfb01' s = Yield '\x0046' (s :*: '\x0049' :*: '\x0000')

16−-- LATIN SMALL LIGATURE FL

17−upperMapping '\xfb02' s = Yield '\x0046' (s :*: '\x004c' :*: '\x0000')

18−-- LATIN SMALL LIGATURE FFI

19−upperMapping '\xfb03' s = Yield '\x0046' (s :*: '\x0046' :*: '\x0049')

20−-- LATIN SMALL LIGATURE FFL

21−upperMapping '\xfb04' s = Yield '\x0046' (s :*: '\x0046' :*: '\x004c')

22−-- LATIN SMALL LIGATURE LONG S T

23−upperMapping '\xfb05' s = Yield '\x0053' (s :*: '\x0054' :*: '\x0000')

24−-- LATIN SMALL LIGATURE ST

25−upperMapping '\xfb06' s = Yield '\x0053' (s :*: '\x0054' :*: '\x0000')

26−-- ARMENIAN SMALL LIGATURE ECH YIWN

27−upperMapping '\x0587' s = Yield '\x0535' (s :*: '\x0552' :*: '\x0000')

28−-- ARMENIAN SMALL LIGATURE MEN NOW

29−upperMapping '\xfb13' s = Yield '\x0544' (s :*: '\x0546' :*: '\x0000')

30−-- ARMENIAN SMALL LIGATURE MEN ECH

31−upperMapping '\xfb14' s = Yield '\x0544' (s :*: '\x0535' :*: '\x0000')

32−-- ARMENIAN SMALL LIGATURE MEN INI

33−upperMapping '\xfb15' s = Yield '\x0544' (s :*: '\x053b' :*: '\x0000')

34−-- ARMENIAN SMALL LIGATURE VEW NOW

35−upperMapping '\xfb16' s = Yield '\x054e' (s :*: '\x0546' :*: '\x0000')

36−-- ARMENIAN SMALL LIGATURE MEN XEH

37−upperMapping '\xfb17' s = Yield '\x0544' (s :*: '\x053d' :*: '\x0000')

38−-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE

39−upperMapping '\x0149' s = Yield '\x02bc' (s :*: '\x004e' :*: '\x0000')

40−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS

41−upperMapping '\x0390' s = Yield '\x0399' (s :*: '\x0308' :*: '\x0301')

42−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS

43−upperMapping '\x03b0' s = Yield '\x03a5' (s :*: '\x0308' :*: '\x0301')

44−-- LATIN SMALL LETTER J WITH CARON

45−upperMapping '\x01f0' s = Yield '\x004a' (s :*: '\x030c' :*: '\x0000')

46−-- LATIN SMALL LETTER H WITH LINE BELOW

47−upperMapping '\x1e96' s = Yield '\x0048' (s :*: '\x0331' :*: '\x0000')

48−-- LATIN SMALL LETTER T WITH DIAERESIS

49−upperMapping '\x1e97' s = Yield '\x0054' (s :*: '\x0308' :*: '\x0000')

50−-- LATIN SMALL LETTER W WITH RING ABOVE

51−upperMapping '\x1e98' s = Yield '\x0057' (s :*: '\x030a' :*: '\x0000')

52−-- LATIN SMALL LETTER Y WITH RING ABOVE

53−upperMapping '\x1e99' s = Yield '\x0059' (s :*: '\x030a' :*: '\x0000')

54−-- LATIN SMALL LETTER A WITH RIGHT HALF RING

55−upperMapping '\x1e9a' s = Yield '\x0041' (s :*: '\x02be' :*: '\x0000')

56−-- GREEK SMALL LETTER UPSILON WITH PSILI

57−upperMapping '\x1f50' s = Yield '\x03a5' (s :*: '\x0313' :*: '\x0000')

58−-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA

59−upperMapping '\x1f52' s = Yield '\x03a5' (s :*: '\x0313' :*: '\x0300')

60−-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA

61−upperMapping '\x1f54' s = Yield '\x03a5' (s :*: '\x0313' :*: '\x0301')

62−-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI

63−upperMapping '\x1f56' s = Yield '\x03a5' (s :*: '\x0313' :*: '\x0342')

64−-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI

65−upperMapping '\x1fb6' s = Yield '\x0391' (s :*: '\x0342' :*: '\x0000')

66−-- GREEK SMALL LETTER ETA WITH PERISPOMENI

67−upperMapping '\x1fc6' s = Yield '\x0397' (s :*: '\x0342' :*: '\x0000')

68−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA

69−upperMapping '\x1fd2' s = Yield '\x0399' (s :*: '\x0308' :*: '\x0300')

70−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA

71−upperMapping '\x1fd3' s = Yield '\x0399' (s :*: '\x0308' :*: '\x0301')

72−-- GREEK SMALL LETTER IOTA WITH PERISPOMENI

73−upperMapping '\x1fd6' s = Yield '\x0399' (s :*: '\x0342' :*: '\x0000')

74−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI

75−upperMapping '\x1fd7' s = Yield '\x0399' (s :*: '\x0308' :*: '\x0342')

76−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA

77−upperMapping '\x1fe2' s = Yield '\x03a5' (s :*: '\x0308' :*: '\x0300')

78−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA

79−upperMapping '\x1fe3' s = Yield '\x03a5' (s :*: '\x0308' :*: '\x0301')

80−-- GREEK SMALL LETTER RHO WITH PSILI

81−upperMapping '\x1fe4' s = Yield '\x03a1' (s :*: '\x0313' :*: '\x0000')

82−-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI

83−upperMapping '\x1fe6' s = Yield '\x03a5' (s :*: '\x0342' :*: '\x0000')

84−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI

85−upperMapping '\x1fe7' s = Yield '\x03a5' (s :*: '\x0308' :*: '\x0342')

86−-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI

87−upperMapping '\x1ff6' s = Yield '\x03a9' (s :*: '\x0342' :*: '\x0000')

88−-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI

89−upperMapping '\x1f80' s = Yield '\x1f08' (s :*: '\x0399' :*: '\x0000')

90−-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI

91−upperMapping '\x1f81' s = Yield '\x1f09' (s :*: '\x0399' :*: '\x0000')

92−-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI

93−upperMapping '\x1f82' s = Yield '\x1f0a' (s :*: '\x0399' :*: '\x0000')

94−-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI

95−upperMapping '\x1f83' s = Yield '\x1f0b' (s :*: '\x0399' :*: '\x0000')

96−-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI

97−upperMapping '\x1f84' s = Yield '\x1f0c' (s :*: '\x0399' :*: '\x0000')

98−-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI

99−upperMapping '\x1f85' s = Yield '\x1f0d' (s :*: '\x0399' :*: '\x0000')

100−-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

101−upperMapping '\x1f86' s = Yield '\x1f0e' (s :*: '\x0399' :*: '\x0000')

102−-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

103−upperMapping '\x1f87' s = Yield '\x1f0f' (s :*: '\x0399' :*: '\x0000')

104−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI

105−upperMapping '\x1f88' s = Yield '\x1f08' (s :*: '\x0399' :*: '\x0000')

106−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI

107−upperMapping '\x1f89' s = Yield '\x1f09' (s :*: '\x0399' :*: '\x0000')

108−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI

109−upperMapping '\x1f8a' s = Yield '\x1f0a' (s :*: '\x0399' :*: '\x0000')

110−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI

111−upperMapping '\x1f8b' s = Yield '\x1f0b' (s :*: '\x0399' :*: '\x0000')

112−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI

113−upperMapping '\x1f8c' s = Yield '\x1f0c' (s :*: '\x0399' :*: '\x0000')

114−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI

115−upperMapping '\x1f8d' s = Yield '\x1f0d' (s :*: '\x0399' :*: '\x0000')

116−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

117−upperMapping '\x1f8e' s = Yield '\x1f0e' (s :*: '\x0399' :*: '\x0000')

118−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

119−upperMapping '\x1f8f' s = Yield '\x1f0f' (s :*: '\x0399' :*: '\x0000')

120−-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI

121−upperMapping '\x1f90' s = Yield '\x1f28' (s :*: '\x0399' :*: '\x0000')

122−-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI

123−upperMapping '\x1f91' s = Yield '\x1f29' (s :*: '\x0399' :*: '\x0000')

124−-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI

125−upperMapping '\x1f92' s = Yield '\x1f2a' (s :*: '\x0399' :*: '\x0000')

126−-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI

127−upperMapping '\x1f93' s = Yield '\x1f2b' (s :*: '\x0399' :*: '\x0000')

128−-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI

129−upperMapping '\x1f94' s = Yield '\x1f2c' (s :*: '\x0399' :*: '\x0000')

130−-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI

131−upperMapping '\x1f95' s = Yield '\x1f2d' (s :*: '\x0399' :*: '\x0000')

132−-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

133−upperMapping '\x1f96' s = Yield '\x1f2e' (s :*: '\x0399' :*: '\x0000')

134−-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

135−upperMapping '\x1f97' s = Yield '\x1f2f' (s :*: '\x0399' :*: '\x0000')

136−-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI

137−upperMapping '\x1f98' s = Yield '\x1f28' (s :*: '\x0399' :*: '\x0000')

138−-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI

139−upperMapping '\x1f99' s = Yield '\x1f29' (s :*: '\x0399' :*: '\x0000')

140−-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI

141−upperMapping '\x1f9a' s = Yield '\x1f2a' (s :*: '\x0399' :*: '\x0000')

142−-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI

143−upperMapping '\x1f9b' s = Yield '\x1f2b' (s :*: '\x0399' :*: '\x0000')

144−-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI

145−upperMapping '\x1f9c' s = Yield '\x1f2c' (s :*: '\x0399' :*: '\x0000')

146−-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI

147−upperMapping '\x1f9d' s = Yield '\x1f2d' (s :*: '\x0399' :*: '\x0000')

148−-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

149−upperMapping '\x1f9e' s = Yield '\x1f2e' (s :*: '\x0399' :*: '\x0000')

150−-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

151−upperMapping '\x1f9f' s = Yield '\x1f2f' (s :*: '\x0399' :*: '\x0000')

152−-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI

153−upperMapping '\x1fa0' s = Yield '\x1f68' (s :*: '\x0399' :*: '\x0000')

154−-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI

155−upperMapping '\x1fa1' s = Yield '\x1f69' (s :*: '\x0399' :*: '\x0000')

156−-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI

157−upperMapping '\x1fa2' s = Yield '\x1f6a' (s :*: '\x0399' :*: '\x0000')

158−-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI

159−upperMapping '\x1fa3' s = Yield '\x1f6b' (s :*: '\x0399' :*: '\x0000')

160−-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI

161−upperMapping '\x1fa4' s = Yield '\x1f6c' (s :*: '\x0399' :*: '\x0000')

162−-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI

163−upperMapping '\x1fa5' s = Yield '\x1f6d' (s :*: '\x0399' :*: '\x0000')

164−-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

165−upperMapping '\x1fa6' s = Yield '\x1f6e' (s :*: '\x0399' :*: '\x0000')

166−-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

167−upperMapping '\x1fa7' s = Yield '\x1f6f' (s :*: '\x0399' :*: '\x0000')

168−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI

169−upperMapping '\x1fa8' s = Yield '\x1f68' (s :*: '\x0399' :*: '\x0000')

170−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI

171−upperMapping '\x1fa9' s = Yield '\x1f69' (s :*: '\x0399' :*: '\x0000')

172−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI

173−upperMapping '\x1faa' s = Yield '\x1f6a' (s :*: '\x0399' :*: '\x0000')

174−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI

175−upperMapping '\x1fab' s = Yield '\x1f6b' (s :*: '\x0399' :*: '\x0000')

176−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI

177−upperMapping '\x1fac' s = Yield '\x1f6c' (s :*: '\x0399' :*: '\x0000')

178−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI

179−upperMapping '\x1fad' s = Yield '\x1f6d' (s :*: '\x0399' :*: '\x0000')

180−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

181−upperMapping '\x1fae' s = Yield '\x1f6e' (s :*: '\x0399' :*: '\x0000')

182−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

183−upperMapping '\x1faf' s = Yield '\x1f6f' (s :*: '\x0399' :*: '\x0000')

184−-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI

185−upperMapping '\x1fb3' s = Yield '\x0391' (s :*: '\x0399' :*: '\x0000')

186−-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI

187−upperMapping '\x1fbc' s = Yield '\x0391' (s :*: '\x0399' :*: '\x0000')

188−-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI

189−upperMapping '\x1fc3' s = Yield '\x0397' (s :*: '\x0399' :*: '\x0000')

190−-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI

191−upperMapping '\x1fcc' s = Yield '\x0397' (s :*: '\x0399' :*: '\x0000')

192−-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI

193−upperMapping '\x1ff3' s = Yield '\x03a9' (s :*: '\x0399' :*: '\x0000')

194−-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

195−upperMapping '\x1ffc' s = Yield '\x03a9' (s :*: '\x0399' :*: '\x0000')

196−-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI

197−upperMapping '\x1fb2' s = Yield '\x1fba' (s :*: '\x0399' :*: '\x0000')

198−-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI

199−upperMapping '\x1fb4' s = Yield '\x0386' (s :*: '\x0399' :*: '\x0000')

200−-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI

201−upperMapping '\x1fc2' s = Yield '\x1fca' (s :*: '\x0399' :*: '\x0000')

202−-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI

203−upperMapping '\x1fc4' s = Yield '\x0389' (s :*: '\x0399' :*: '\x0000')

204−-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI

205−upperMapping '\x1ff2' s = Yield '\x1ffa' (s :*: '\x0399' :*: '\x0000')

206−-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI

207−upperMapping '\x1ff4' s = Yield '\x038f' (s :*: '\x0399' :*: '\x0000')

208−-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI

209−upperMapping '\x1fb7' s = Yield '\x0391' (s :*: '\x0342' :*: '\x0399')

210−-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI

211−upperMapping '\x1fc7' s = Yield '\x0397' (s :*: '\x0342' :*: '\x0399')

212−-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI

213−upperMapping '\x1ff7' s = Yield '\x03a9' (s :*: '\x0342' :*: '\x0399')

214−upperMapping c s = Yield (toUpper c) (s :*: '\0' :*: '\0')

215−lowerMapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char

216−{-# INLINE lowerMapping #-}

217−-- LATIN CAPITAL LETTER I WITH DOT ABOVE

218−lowerMapping '\x0130' s = Yield '\x0069' (s :*: '\x0307' :*: '\x0000')

219−lowerMapping c s = Yield (toLower c) (s :*: '\0' :*: '\0')

220−foldMapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char

221−{-# INLINE foldMapping #-}

222−-- MICRO SIGN

223−foldMapping '\x00b5' s = Yield '\x03bc' (s :*: '\x0000' :*: '\x0000')

224−-- LATIN SMALL LETTER SHARP S

225−foldMapping '\x00df' s = Yield '\x0073' (s :*: '\x0073' :*: '\x0000')

226−-- LATIN CAPITAL LETTER I WITH DOT ABOVE

227−foldMapping '\x0130' s = Yield '\x0069' (s :*: '\x0307' :*: '\x0000')

228−-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE

229−foldMapping '\x0149' s = Yield '\x02bc' (s :*: '\x006e' :*: '\x0000')

230−-- LATIN SMALL LETTER LONG S

231−foldMapping '\x017f' s = Yield '\x0073' (s :*: '\x0000' :*: '\x0000')

232−-- LATIN SMALL LETTER J WITH CARON

233−foldMapping '\x01f0' s = Yield '\x006a' (s :*: '\x030c' :*: '\x0000')

234−-- COMBINING GREEK YPOGEGRAMMENI

235−foldMapping '\x0345' s = Yield '\x03b9' (s :*: '\x0000' :*: '\x0000')

236−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS

237−foldMapping '\x0390' s = Yield '\x03b9' (s :*: '\x0308' :*: '\x0301')

238−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS

239−foldMapping '\x03b0' s = Yield '\x03c5' (s :*: '\x0308' :*: '\x0301')

240−-- GREEK SMALL LETTER FINAL SIGMA

241−foldMapping '\x03c2' s = Yield '\x03c3' (s :*: '\x0000' :*: '\x0000')

242−-- GREEK BETA SYMBOL

243−foldMapping '\x03d0' s = Yield '\x03b2' (s :*: '\x0000' :*: '\x0000')

244−-- GREEK THETA SYMBOL

245−foldMapping '\x03d1' s = Yield '\x03b8' (s :*: '\x0000' :*: '\x0000')

246−-- GREEK PHI SYMBOL

247−foldMapping '\x03d5' s = Yield '\x03c6' (s :*: '\x0000' :*: '\x0000')

248−-- GREEK PI SYMBOL

249−foldMapping '\x03d6' s = Yield '\x03c0' (s :*: '\x0000' :*: '\x0000')

250−-- GREEK KAPPA SYMBOL

251−foldMapping '\x03f0' s = Yield '\x03ba' (s :*: '\x0000' :*: '\x0000')

252−-- GREEK RHO SYMBOL

253−foldMapping '\x03f1' s = Yield '\x03c1' (s :*: '\x0000' :*: '\x0000')

254−-- GREEK LUNATE EPSILON SYMBOL

255−foldMapping '\x03f5' s = Yield '\x03b5' (s :*: '\x0000' :*: '\x0000')

256−-- ARMENIAN SMALL LIGATURE ECH YIWN

257−foldMapping '\x0587' s = Yield '\x0565' (s :*: '\x0582' :*: '\x0000')

258−-- LATIN SMALL LETTER H WITH LINE BELOW

259−foldMapping '\x1e96' s = Yield '\x0068' (s :*: '\x0331' :*: '\x0000')

260−-- LATIN SMALL LETTER T WITH DIAERESIS

261−foldMapping '\x1e97' s = Yield '\x0074' (s :*: '\x0308' :*: '\x0000')

262−-- LATIN SMALL LETTER W WITH RING ABOVE

263−foldMapping '\x1e98' s = Yield '\x0077' (s :*: '\x030a' :*: '\x0000')

264−-- LATIN SMALL LETTER Y WITH RING ABOVE

265−foldMapping '\x1e99' s = Yield '\x0079' (s :*: '\x030a' :*: '\x0000')

266−-- LATIN SMALL LETTER A WITH RIGHT HALF RING

267−foldMapping '\x1e9a' s = Yield '\x0061' (s :*: '\x02be' :*: '\x0000')

268−-- LATIN SMALL LETTER LONG S WITH DOT ABOVE

269−foldMapping '\x1e9b' s = Yield '\x1e61' (s :*: '\x0000' :*: '\x0000')

270−-- LATIN CAPITAL LETTER SHARP S

271−foldMapping '\x1e9e' s = Yield '\x0073' (s :*: '\x0073' :*: '\x0000')

272−-- GREEK SMALL LETTER UPSILON WITH PSILI

273−foldMapping '\x1f50' s = Yield '\x03c5' (s :*: '\x0313' :*: '\x0000')

274−-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA

275−foldMapping '\x1f52' s = Yield '\x03c5' (s :*: '\x0313' :*: '\x0300')

276−-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA

277−foldMapping '\x1f54' s = Yield '\x03c5' (s :*: '\x0313' :*: '\x0301')

278−-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI

279−foldMapping '\x1f56' s = Yield '\x03c5' (s :*: '\x0313' :*: '\x0342')

280−-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI

281−foldMapping '\x1f80' s = Yield '\x1f00' (s :*: '\x03b9' :*: '\x0000')

282−-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI

283−foldMapping '\x1f81' s = Yield '\x1f01' (s :*: '\x03b9' :*: '\x0000')

284−-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI

285−foldMapping '\x1f82' s = Yield '\x1f02' (s :*: '\x03b9' :*: '\x0000')

286−-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI

287−foldMapping '\x1f83' s = Yield '\x1f03' (s :*: '\x03b9' :*: '\x0000')

288−-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI

289−foldMapping '\x1f84' s = Yield '\x1f04' (s :*: '\x03b9' :*: '\x0000')

290−-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI

291−foldMapping '\x1f85' s = Yield '\x1f05' (s :*: '\x03b9' :*: '\x0000')

292−-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

293−foldMapping '\x1f86' s = Yield '\x1f06' (s :*: '\x03b9' :*: '\x0000')

294−-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

295−foldMapping '\x1f87' s = Yield '\x1f07' (s :*: '\x03b9' :*: '\x0000')

296−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI

297−foldMapping '\x1f88' s = Yield '\x1f00' (s :*: '\x03b9' :*: '\x0000')

298−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI

299−foldMapping '\x1f89' s = Yield '\x1f01' (s :*: '\x03b9' :*: '\x0000')

300−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI

301−foldMapping '\x1f8a' s = Yield '\x1f02' (s :*: '\x03b9' :*: '\x0000')

302−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI

303−foldMapping '\x1f8b' s = Yield '\x1f03' (s :*: '\x03b9' :*: '\x0000')

304−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI

305−foldMapping '\x1f8c' s = Yield '\x1f04' (s :*: '\x03b9' :*: '\x0000')

306−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI

307−foldMapping '\x1f8d' s = Yield '\x1f05' (s :*: '\x03b9' :*: '\x0000')

308−-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

309−foldMapping '\x1f8e' s = Yield '\x1f06' (s :*: '\x03b9' :*: '\x0000')

310−-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

311−foldMapping '\x1f8f' s = Yield '\x1f07' (s :*: '\x03b9' :*: '\x0000')

312−-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI

313−foldMapping '\x1f90' s = Yield '\x1f20' (s :*: '\x03b9' :*: '\x0000')

314−-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI

315−foldMapping '\x1f91' s = Yield '\x1f21' (s :*: '\x03b9' :*: '\x0000')

316−-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI

317−foldMapping '\x1f92' s = Yield '\x1f22' (s :*: '\x03b9' :*: '\x0000')

318−-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI

319−foldMapping '\x1f93' s = Yield '\x1f23' (s :*: '\x03b9' :*: '\x0000')

320−-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI

321−foldMapping '\x1f94' s = Yield '\x1f24' (s :*: '\x03b9' :*: '\x0000')

322−-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI

323−foldMapping '\x1f95' s = Yield '\x1f25' (s :*: '\x03b9' :*: '\x0000')

324−-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

325−foldMapping '\x1f96' s = Yield '\x1f26' (s :*: '\x03b9' :*: '\x0000')

326−-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

327−foldMapping '\x1f97' s = Yield '\x1f27' (s :*: '\x03b9' :*: '\x0000')

328−-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI

329−foldMapping '\x1f98' s = Yield '\x1f20' (s :*: '\x03b9' :*: '\x0000')

330−-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI

331−foldMapping '\x1f99' s = Yield '\x1f21' (s :*: '\x03b9' :*: '\x0000')

332−-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI

333−foldMapping '\x1f9a' s = Yield '\x1f22' (s :*: '\x03b9' :*: '\x0000')

334−-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI

335−foldMapping '\x1f9b' s = Yield '\x1f23' (s :*: '\x03b9' :*: '\x0000')

336−-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI

337−foldMapping '\x1f9c' s = Yield '\x1f24' (s :*: '\x03b9' :*: '\x0000')

338−-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI

339−foldMapping '\x1f9d' s = Yield '\x1f25' (s :*: '\x03b9' :*: '\x0000')

340−-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

341−foldMapping '\x1f9e' s = Yield '\x1f26' (s :*: '\x03b9' :*: '\x0000')

342−-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

343−foldMapping '\x1f9f' s = Yield '\x1f27' (s :*: '\x03b9' :*: '\x0000')

344−-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI

345−foldMapping '\x1fa0' s = Yield '\x1f60' (s :*: '\x03b9' :*: '\x0000')

346−-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI

347−foldMapping '\x1fa1' s = Yield '\x1f61' (s :*: '\x03b9' :*: '\x0000')

348−-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI

349−foldMapping '\x1fa2' s = Yield '\x1f62' (s :*: '\x03b9' :*: '\x0000')

350−-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI

351−foldMapping '\x1fa3' s = Yield '\x1f63' (s :*: '\x03b9' :*: '\x0000')

352−-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI

353−foldMapping '\x1fa4' s = Yield '\x1f64' (s :*: '\x03b9' :*: '\x0000')

354−-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI

355−foldMapping '\x1fa5' s = Yield '\x1f65' (s :*: '\x03b9' :*: '\x0000')

356−-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

357−foldMapping '\x1fa6' s = Yield '\x1f66' (s :*: '\x03b9' :*: '\x0000')

358−-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

359−foldMapping '\x1fa7' s = Yield '\x1f67' (s :*: '\x03b9' :*: '\x0000')

360−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI

361−foldMapping '\x1fa8' s = Yield '\x1f60' (s :*: '\x03b9' :*: '\x0000')

362−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI

363−foldMapping '\x1fa9' s = Yield '\x1f61' (s :*: '\x03b9' :*: '\x0000')

364−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI

365−foldMapping '\x1faa' s = Yield '\x1f62' (s :*: '\x03b9' :*: '\x0000')

366−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI

367−foldMapping '\x1fab' s = Yield '\x1f63' (s :*: '\x03b9' :*: '\x0000')

368−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI

369−foldMapping '\x1fac' s = Yield '\x1f64' (s :*: '\x03b9' :*: '\x0000')

370−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI

371−foldMapping '\x1fad' s = Yield '\x1f65' (s :*: '\x03b9' :*: '\x0000')

372−-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

373−foldMapping '\x1fae' s = Yield '\x1f66' (s :*: '\x03b9' :*: '\x0000')

374−-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

375−foldMapping '\x1faf' s = Yield '\x1f67' (s :*: '\x03b9' :*: '\x0000')

376−-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI

377−foldMapping '\x1fb2' s = Yield '\x1f70' (s :*: '\x03b9' :*: '\x0000')

378−-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI

379−foldMapping '\x1fb3' s = Yield '\x03b1' (s :*: '\x03b9' :*: '\x0000')

380−-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI

381−foldMapping '\x1fb4' s = Yield '\x03ac' (s :*: '\x03b9' :*: '\x0000')

382−-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI

383−foldMapping '\x1fb6' s = Yield '\x03b1' (s :*: '\x0342' :*: '\x0000')

384−-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI

385−foldMapping '\x1fb7' s = Yield '\x03b1' (s :*: '\x0342' :*: '\x03b9')

386−-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI

387−foldMapping '\x1fbc' s = Yield '\x03b1' (s :*: '\x03b9' :*: '\x0000')

388−-- GREEK PROSGEGRAMMENI

389−foldMapping '\x1fbe' s = Yield '\x03b9' (s :*: '\x0000' :*: '\x0000')

390−-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI

391−foldMapping '\x1fc2' s = Yield '\x1f74' (s :*: '\x03b9' :*: '\x0000')

392−-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI

393−foldMapping '\x1fc3' s = Yield '\x03b7' (s :*: '\x03b9' :*: '\x0000')

394−-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI

395−foldMapping '\x1fc4' s = Yield '\x03ae' (s :*: '\x03b9' :*: '\x0000')

396−-- GREEK SMALL LETTER ETA WITH PERISPOMENI

397−foldMapping '\x1fc6' s = Yield '\x03b7' (s :*: '\x0342' :*: '\x0000')

398−-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI

399−foldMapping '\x1fc7' s = Yield '\x03b7' (s :*: '\x0342' :*: '\x03b9')

400−-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI

401−foldMapping '\x1fcc' s = Yield '\x03b7' (s :*: '\x03b9' :*: '\x0000')

402−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA

403−foldMapping '\x1fd2' s = Yield '\x03b9' (s :*: '\x0308' :*: '\x0300')

404−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA

405−foldMapping '\x1fd3' s = Yield '\x03b9' (s :*: '\x0308' :*: '\x0301')

406−-- GREEK SMALL LETTER IOTA WITH PERISPOMENI

407−foldMapping '\x1fd6' s = Yield '\x03b9' (s :*: '\x0342' :*: '\x0000')

408−-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI

409−foldMapping '\x1fd7' s = Yield '\x03b9' (s :*: '\x0308' :*: '\x0342')

410−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA

411−foldMapping '\x1fe2' s = Yield '\x03c5' (s :*: '\x0308' :*: '\x0300')

412−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA

413−foldMapping '\x1fe3' s = Yield '\x03c5' (s :*: '\x0308' :*: '\x0301')

414−-- GREEK SMALL LETTER RHO WITH PSILI

415−foldMapping '\x1fe4' s = Yield '\x03c1' (s :*: '\x0313' :*: '\x0000')

416−-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI

417−foldMapping '\x1fe6' s = Yield '\x03c5' (s :*: '\x0342' :*: '\x0000')

418−-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI

419−foldMapping '\x1fe7' s = Yield '\x03c5' (s :*: '\x0308' :*: '\x0342')

420−-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI

421−foldMapping '\x1ff2' s = Yield '\x1f7c' (s :*: '\x03b9' :*: '\x0000')

422−-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI

423−foldMapping '\x1ff3' s = Yield '\x03c9' (s :*: '\x03b9' :*: '\x0000')

424−-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI

425−foldMapping '\x1ff4' s = Yield '\x03ce' (s :*: '\x03b9' :*: '\x0000')

426−-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI

427−foldMapping '\x1ff6' s = Yield '\x03c9' (s :*: '\x0342' :*: '\x0000')

428−-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI

429−foldMapping '\x1ff7' s = Yield '\x03c9' (s :*: '\x0342' :*: '\x03b9')

430−-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

431−foldMapping '\x1ffc' s = Yield '\x03c9' (s :*: '\x03b9' :*: '\x0000')

432−-- LATIN SMALL LIGATURE FF

433−foldMapping '\xfb00' s = Yield '\x0066' (s :*: '\x0066' :*: '\x0000')

434−-- LATIN SMALL LIGATURE FI

435−foldMapping '\xfb01' s = Yield '\x0066' (s :*: '\x0069' :*: '\x0000')

436−-- LATIN SMALL LIGATURE FL

437−foldMapping '\xfb02' s = Yield '\x0066' (s :*: '\x006c' :*: '\x0000')

438−-- LATIN SMALL LIGATURE FFI

439−foldMapping '\xfb03' s = Yield '\x0066' (s :*: '\x0066' :*: '\x0069')

440−-- LATIN SMALL LIGATURE FFL

441−foldMapping '\xfb04' s = Yield '\x0066' (s :*: '\x0066' :*: '\x006c')

442−-- LATIN SMALL LIGATURE LONG S T

443−foldMapping '\xfb05' s = Yield '\x0073' (s :*: '\x0074' :*: '\x0000')

444−-- LATIN SMALL LIGATURE ST

445−foldMapping '\xfb06' s = Yield '\x0073' (s :*: '\x0074' :*: '\x0000')

446−-- ARMENIAN SMALL LIGATURE MEN NOW

447−foldMapping '\xfb13' s = Yield '\x0574' (s :*: '\x0576' :*: '\x0000')

448−-- ARMENIAN SMALL LIGATURE MEN ECH

449−foldMapping '\xfb14' s = Yield '\x0574' (s :*: '\x0565' :*: '\x0000')

450−-- ARMENIAN SMALL LIGATURE MEN INI

451−foldMapping '\xfb15' s = Yield '\x0574' (s :*: '\x056b' :*: '\x0000')

452−-- ARMENIAN SMALL LIGATURE VEW NOW

453−foldMapping '\xfb16' s = Yield '\x057e' (s :*: '\x0576' :*: '\x0000')

454−-- ARMENIAN SMALL LIGATURE MEN XEH

455−foldMapping '\xfb17' s = Yield '\x0574' (s :*: '\x056d' :*: '\x0000')

456−foldMapping c s = Yield (toLower c) (s :*: '\0' :*: '\0')

Data/Text/Fusion/Size.hsdeleted−129

@@ -1,129 +0,0 @@

1−{-# OPTIONS_GHC -fno-warn-missing-methods #-}

2−-- |

3−-- Module : Data.Text.Fusion.Internal

4−-- Copyright : (c) Roman Leshchinskiy 2008,

5−-- (c) Bryan O'Sullivan 2009

6−--

7−-- License : BSD-style

8−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

9−-- duncan@haskell.org

10−-- Stability : experimental

11−-- Portability : portable

12−--

13−-- Size hints.

14−

15−module Data.Text.Fusion.Size

16− (

17− Size

18− , exactSize

19− , maxSize

20− , unknownSize

21− , smaller

22− , larger

23− , toMax

24− , upperBound

25− , lowerBound

26− , isEmpty

27− ) where

28−

29−import Control.Exception (assert)

30−

31−data Size = Exact {-# UNPACK #-} !Int -- ^ Exact size.

32− | Max {-# UNPACK #-} !Int -- ^ Upper bound on size.

33− | Unknown -- ^ Unknown size.

34− deriving (Eq, Show)

35−

36−exactSize :: Int -> Size

37−exactSize n = assert (n >= 0) Exact n

38−{-# INLINE exactSize #-}

39−

40−maxSize :: Int -> Size

41−maxSize n = assert (n >= 0) Max n

42−{-# INLINE maxSize #-}

43−

44−unknownSize :: Size

45−unknownSize = Unknown

46−{-# INLINE unknownSize #-}

47−

48−instance Num Size where

49− (+) = addSize

50− (-) = subtractSize

51− (*) = mulSize

52−

53− fromInteger = f where f = Exact . fromInteger

54− {-# INLINE f #-}

55−

56−addSize :: Size -> Size -> Size

57−addSize (Exact m) (Exact n) = Exact (m+n)

58−addSize (Exact m) (Max n) = Max (m+n)

59−addSize (Max m) (Exact n) = Max (m+n)

60−addSize (Max m) (Max n) = Max (m+n)

61−addSize _ _ = Unknown

62−{-# INLINE addSize #-}

63−

64−subtractSize :: Size -> Size -> Size

65−subtractSize (Exact m) (Exact n) = Exact (max (m-n) 0)

66−subtractSize (Exact m) (Max _) = Max m

67−subtractSize (Max m) (Exact n) = Max (max (m-n) 0)

68−subtractSize a@(Max _) (Max _) = a

69−subtractSize a@(Max _) Unknown = a

70−subtractSize _ _ = Unknown

71−{-# INLINE subtractSize #-}

72−

73−mulSize :: Size -> Size -> Size

74−mulSize (Exact m) (Exact n) = Exact (m*n)

75−mulSize (Exact m) (Max n) = Max (m*n)

76−mulSize (Max m) (Exact n) = Max (m*n)

77−mulSize (Max m) (Max n) = Max (m*n)

78−mulSize _ _ = Unknown

79−{-# INLINE mulSize #-}

80−

81−-- | Minimum of two size hints.

82−smaller :: Size -> Size -> Size

83−smaller (Exact m) (Exact n) = Exact (m `min` n)

84−smaller (Exact m) (Max n) = Max (m `min` n)

85−smaller (Exact m) Unknown = Max m

86−smaller (Max m) (Exact n) = Max (m `min` n)

87−smaller (Max m) (Max n) = Max (m `min` n)

88−smaller a@(Max _) Unknown = a

89−smaller Unknown (Exact n) = Max n

90−smaller Unknown (Max n) = Max n

91−smaller Unknown Unknown = Unknown

92−{-# INLINE smaller #-}

93−

94−-- | Maximum of two size hints.

95−larger :: Size -> Size -> Size

96−larger (Exact m) (Exact n) = Exact (m `max` n)

97−larger a@(Exact m) b@(Max n) | m >= n = a

98− | otherwise = b

99−larger a@(Max m) b@(Exact n) | n >= m = b

100− | otherwise = a

101−larger (Max m) (Max n) = Max (m `max` n)

102−larger _ _ = Unknown

103−{-# INLINE larger #-}

104−

105−-- | Convert a size hint to an upper bound.

106−toMax :: Size -> Size

107−toMax (Exact n) = Max n

108−toMax a@(Max _) = a

109−toMax Unknown = Unknown

110−{-# INLINE toMax #-}

111−

112−-- | Compute the minimum size from a size hint.

113−lowerBound :: Size -> Int

114−lowerBound (Exact n) = n

115−lowerBound _ = 0

116−{-# INLINE lowerBound #-}

117−

118−-- | Compute the maximum size from a size hint, if possible.

119−upperBound :: Int -> Size -> Int

120−upperBound _ (Exact n) = n

121−upperBound _ (Max n) = n

122−upperBound k _ = k

123−{-# INLINE upperBound #-}

124−

125−isEmpty :: Size -> Bool

126−isEmpty (Exact n) = n <= 0

127−isEmpty (Max n) = n <= 0

128−isEmpty _ = False

129−{-# INLINE isEmpty #-}

Data/Text/IO.hsnew file+338

@@ -0,0 +1,338 @@

1+{-# LANGUAGE BangPatterns, CPP, RecordWildCards, ScopedTypeVariables #-}

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

5+-- |

6+-- Module : Data.Text.IO

9+-- License : BSD-style

10+-- Maintainer : bos@serpentine.com

11+-- Stability : experimental

12+-- Portability : GHC

13+--

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

18+

19+module Data.Text.IO

20+ (

21+ -- * Performance

22+ -- $performance

23+

24+ -- * Locale support

25+ -- $locale

26+ -- * File-at-a-time operations

27+ readFile

28+ , writeFile

29+ , appendFile

30+ -- * Operations on handles

31+ , hGetContents

32+ , hGetChunk

33+ , hGetLine

34+ , hPutStr

35+ , hPutStrLn

36+ -- * Special cases for standard input and output

37+ , interact

38+ , getContents

39+ , getLine

40+ , putStr

41+ , putStrLn

42+ ) where

43+

44+import Data.Text (Text)

45+import Prelude hiding (appendFile, getContents, getLine, interact,

46+ putStr, putStrLn, readFile, writeFile)

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

48+ withFile)

49+import qualified Control.Exception as E

50+import Control.Monad (liftM2, when)

51+import Data.IORef (readIORef, writeIORef)

52+import 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)

56+import GHC.IO.Buffer (Buffer(..), BufferState(..), CharBufElem, CharBuffer,

57+ RawCharBuffer, emptyBuffer, isEmptyBuffer, newCharBuffer,

58+ writeCharBuf)

59+import GHC.IO.Exception (IOException(ioe_type), IOErrorType(InappropriateType))

60+import GHC.IO.Handle.Internals (augmentIOError, hClose_help, wantReadableHandle,

61+ wantWritableHandle)

62+import GHC.IO.Handle.Text (commitBuffer')

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

64+ HandleType(..), Newline(..))

65+import System.IO (hGetBuffering, hFileSize, hSetBuffering, hTell)

66+import 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.

83+

84+-- | The 'readFile' function reads a file and returns the contents of

85+-- the file as a string. The entire file is read strictly, as with

86+-- 'getContents'.

87+readFile :: FilePath -> IO Text

88+readFile name = openFile name ReadMode >>= hGetContents

89+

90+-- | Write a string to a file. The file is truncated to zero length

91+-- before writing begins.

92+writeFile :: FilePath -> Text -> IO ()

93+writeFile p = withFile p WriteMode . flip hPutStr

94+

95+-- | Write a string the end of a file.

96+appendFile :: FilePath -> Text -> IO ()

97+appendFile p = withFile p AppendMode . flip hPutStr

98+

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+

123+-- | Read the remaining contents of a 'Handle' as a string. The

124+-- 'Handle' is closed once the contents have been read, or if an

125+-- exception is thrown.

126+--

127+-- Internally, this function reads a chunk at a time from the

128+-- lower-level buffering abstraction, and concatenates the chunks into

129+-- a single string once the entire file has been read.

130+--

131+-- As a result, it requires approximately twice as much memory as its

132+-- result to construct its result. For files more than a half of

133+-- available RAM in size, this may result in memory exhaustion.

134+hGetContents :: Handle -> IO Text

135+hGetContents h = do

136+ chooseGoodBuffering h

137+ wantReadableHandle "hGetContents" h readAll

138+ where

139+ readAll hh@Handle__{..} = do

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

167+-- | Read a single line from a handle.

168+hGetLine :: Handle -> IO Text

169+hGetLine = hGetLineWith T.concat

170+

171+-- | Write a string to a handle.

172+hPutStr :: Handle -> Text -> IO ()

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

174+hPutStr h t = do

175+ (buffer_mode, nl) <-

176+ wantWritableHandle "hPutStr" h $ \h_ -> do

177+ bmode <- getSpareBuffer h_

178+ return (bmode, haOutputNL h_)

179+ let str = stream t

180+ case buffer_mode of

181+ (NoBuffering, _) -> hPutChars h str

182+ (LineBuffering, buf) -> writeLines h nl buf str

183+ (BlockBuffering _, buf)

184+ | nl == CRLF -> writeBlocksCRLF h buf str

185+ | otherwise -> writeBlocksRaw h buf str

186+

187+hPutChars :: Handle -> Stream Char -> IO ()

188+hPutChars h (Stream next0 s0 _len) = loop s0

189+ where

190+ loop !s = case next0 s of

191+ Done -> return ()

192+ Skip s' -> loop s'

193+ Yield x s' -> hPutChar h x >> loop s'

194+

195+-- The following functions are largely lifted from GHC.IO.Handle.Text,

196+-- but adapted to a coinductive stream of data instead of an inductive

197+-- list.

198+--

199+-- We have several variations of more or less the same code for

200+-- performance reasons. Splitting the original buffered write

201+-- function into line- and block-oriented versions gave us a 2.1x

202+-- performance improvement. Lifting out the raw/cooked newline

203+-- handling gave a few more percent on top.

204+

205+writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()

206+writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0

207+ where

208+ outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

209+ where

210+ inner !s !n =

211+ case next0 s of

212+ Done -> commit n False{-no flush-} True{-release-} >> return ()

213+ Skip s' -> inner s' n

214+ Yield x s'

215+ | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s

216+ | x == '\n' -> do

217+ n' <- if nl == CRLF

218+ then do n1 <- writeCharBuf raw n '\r'

219+ writeCharBuf raw n1 '\n'

220+ else writeCharBuf raw n x

221+ commit n' True{-needs flush-} False >>= outer s'

222+ | otherwise -> writeCharBuf raw n x >>= inner s'

223+ commit = commitBuffer h raw len

224+

225+writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()

226+writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0

227+ where

228+ outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

229+ where

230+ inner !s !n =

231+ case next0 s of

232+ Done -> commit n False{-no flush-} True{-release-} >> return ()

233+ Skip s' -> inner s' n

234+ Yield x s'

235+ | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s

236+ | x == '\n' -> do n1 <- writeCharBuf raw n '\r'

237+ writeCharBuf raw n1 '\n' >>= inner s'

238+ | otherwise -> writeCharBuf raw n x >>= inner s'

239+ commit = commitBuffer h raw len

240+

241+writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()

242+writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0

243+ where

244+ outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)

245+ where

246+ inner !s !n =

247+ case next0 s of

248+ Done -> commit n False{-no flush-} True{-release-} >> return ()

249+ Skip s' -> inner s' n

250+ Yield x s'

251+ | n + 1 >= len -> commit n True{-needs flush-} False >>= outer s

252+ | otherwise -> writeCharBuf raw n x >>= inner s'

253+ commit = commitBuffer h raw len

254+

255+-- This function is completely lifted from GHC.IO.Handle.Text.

256+getSpareBuffer :: Handle__ -> IO (BufferMode, CharBuffer)

257+getSpareBuffer Handle__{haCharBuffer=ref,

258+ haBuffers=spare_ref,

259+ haBufferMode=mode}

260+ = do

261+ case mode of

262+ NoBuffering -> return (mode, error "no buffer!")

263+ _ -> do

264+ bufs <- readIORef spare_ref

265+ buf <- readIORef ref

266+ case bufs of

267+ BufferListCons b rest -> do

268+ writeIORef spare_ref rest

269+ return ( mode, emptyBuffer b (bufSize buf) WriteBuffer)

270+ BufferListNil -> do

271+ new_buf <- newCharBuffer (bufSize buf) WriteBuffer

272+ return (mode, new_buf)

273+

274+

275+-- This function is completely lifted from GHC.IO.Handle.Text.

276+commitBuffer :: Handle -> RawCharBuffer -> Int -> Int -> Bool -> Bool

277+ -> IO CharBuffer

278+commitBuffer hdl !raw !sz !count flush release =

279+ wantWritableHandle "commitAndReleaseBuffer" hdl $

280+ commitBuffer' raw sz count flush release

281+{-# INLINE commitBuffer #-}

282+

283+-- | Write a string to a handle, followed by a newline.

284+hPutStrLn :: Handle -> Text -> IO ()

285+hPutStrLn h t = hPutStr h t >> hPutChar h '\n'

286+

287+-- | The 'interact' function takes a function of type @Text -> Text@

288+-- as its argument. The entire input from the standard input device is

289+-- passed to this function as its argument, and the resulting string

290+-- is output on the standard output device.

291+interact :: (Text -> Text) -> IO ()

292+interact f = putStr . f =<< getContents

293+

294+-- | Read all user input on 'stdin' as a single string.

295+getContents :: IO Text

296+getContents = hGetContents stdin

297+

298+-- | Read a single line of user input from 'stdin'.

299+getLine :: IO Text

300+getLine = hGetLine stdin

301+

302+-- | Write a string to 'stdout'.

303+putStr :: Text -> IO ()

304+putStr = hPutStr stdout

305+

306+-- | Write a string to 'stdout', followed by a newline.

307+putStrLn :: Text -> IO ()

308+putStrLn = hPutStrLn stdout

309+

310+-- $locale

311+--

312+-- /Note/: The behaviour of functions in this module depends on the

313+-- version of GHC you are using.

314+--

315+-- Beginning with GHC 6.12, text I\/O is performed using the system or

316+-- handle's current locale and line ending conventions.

317+--

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

320+-- versions of GHC, functions in this library all use UTF-8. What

321+-- does this mean in practice?

322+--

323+-- * All data that is read will be decoded as UTF-8.

324+--

325+-- * Before data is written, it is first encoded as UTF-8.

326+--

327+-- * On both reading and writing, the platform's native newline

328+-- conversion is performed.

329+--

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

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

332+--

333+-- > import qualified Data.ByteString as B

334+-- > import Data.Text (Text)

335+-- > import Data.Text.Encoding (encodeUtf16)

336+-- >

337+-- > putStr_Utf16LE :: Text -> IO ()

338+-- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)

Data/Text/Internal.hs+145−28

@@ -1,71 +1,188 @@

1−{-# LANGUAGE DeriveDataTypeable #-}

1+{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}

2+{-# OPTIONS_HADDOCK not-home #-}

23

34-- |

45-- Module : Data.Text.Internal

5−-- Copyright : (c) Tom Harper 2008-2009,

6−-- (c) Bryan O'Sullivan 2009,

7−-- (c) Duncan Coutts 2009

89--

910-- License : BSD-style

10−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

11−-- duncan@haskell.org

11+-- Maintainer : bos@serpentine.com

1212-- Stability : experimental

1313-- Portability : GHC

1414--

15−-- Semi-public internals. Most users should not need to use this

16−-- module.

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

1726

1827module Data.Text.Internal

1928 (

2029 -- * Types

30+ -- $internals

2131 Text(..)

2232 -- * Construction

2333 , text

2434 , textP

35+ -- * Safety

36+ , safe

2537 -- * Code that must be here for accessibility

2638 , empty

39+ , empty_

40+ -- * Utilities

41+ , firstf

42+ -- * Checked multiplication

43+ , mul

44+ , mul32

45+ , mul64

2746 -- * Debugging

2847 , showText

2948 ) where

3049

50+#if defined(ASSERTS)

3151import Control.Exception (assert)

32−import qualified Data.Text.Array as A

52+#endif

53+import Data.Bits

54+import Data.Int (Int32, Int64)

55+import Data.Text.Internal.Unsafe.Char (ord)

3356import Data.Typeable (Typeable)

34−import Data.Word (Word16)

57+import qualified Data.Text.Array as A

3558

3659-- | A space efficient, packed, unboxed Unicode text type.

3760data Text = Text

38− {-# UNPACK #-} !(A.Array Word16) -- payload

39− {-# UNPACK #-} !Int -- offset

40− {-# UNPACK #-} !Int -- length

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)

4164 deriving (Typeable)

4265

4366-- | Smart constructor.

44−text :: A.Array Word16 -> Int -> Int -> Text

45−text arr off len =

46− assert (len >= 0) .

47− assert (off >= 0) .

48− assert (alen == 0 || len == 0 || off < alen) .

49− assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $

50− Text arr off len

51− where c = A.unsafeIndex arr off

52− alen = A.length arr

53−{-# INLINE text #-}

67+text_ :: A.Array -> Int -> Int -> Text

68+text_ arr off len =

69+#if defined(ASSERTS)

70+ let c = A.unsafeIndex arr off

71+ alen = A.length arr

72+ in assert (len >= 0) .

73+ assert (off >= 0) .

74+ assert (alen == 0 || len == 0 || off < alen) .

75+ assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $

76+#endif

77+ Text arr off len

78+{-# INLINE text_ #-}

5479

5580-- | /O(1)/ The empty 'Text'.

5681empty :: Text

5782empty = Text A.empty 0 0

5883{-# INLINE [1] empty #-}

5984

85+-- | A non-inlined version of 'empty'.

86+empty_ :: Text

87+empty_ = Text A.empty 0 0

88+{-# NOINLINE empty_ #-}

89+

6090-- | Construct a 'Text' without invisibly pinning its byte array in

6191-- memory if its length has dwindled to zero.

62−textP :: A.Array Word16 -> Int -> Int -> Text

63−textP arr off len | len == 0 = empty

64− | otherwise = text arr off len

65−{-# INLINE textP #-}

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+

97+textP :: A.Array -> Int -> Int -> Text

98+{-# DEPRECATED textP "Use text instead" #-}

99+textP = text

66100

67101-- | A useful 'show'-like function for debugging purposes.

68102showText :: Text -> String

69103showText (Text arr off len) =

70− "Text " ++ (show . take (off+len) . A.toList) arr ++ ' ' :

104+ "Text " ++ show (A.toList arr off len) ++ ' ' :

71105 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.hsnew file+329

@@ -0,0 +1,329 @@

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.hsnew file+40

@@ -0,0 +1,40 @@

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.hsnew file+26

@@ -0,0 +1,26 @@

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.hsnew file+57

@@ -0,0 +1,57 @@

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/Encoding/Fusion.hs → Data/Text/Internal/Encoding/Fusion.hsrenamed+29−22

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

1−{-# LANGUAGE BangPatterns, Rank2Types #-}

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

22

33-- |

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

4+-- Module : Data.Text.Internal.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 : rtharper@aftereternity.co.uk, bos@serpentine.com,

11−-- duncan@haskell.org

10+-- Maintainer : bos@serpentine.com

1211-- Stability : experimental

1312-- Portability : portable

1413--

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

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

1619-- and several common encodings.

1720

18−module Data.Text.Encoding.Fusion

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

1922 (

2023 -- * Streaming

2124 streamASCII

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

2831 -- * Unstreaming

2932 , unstream

3033

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

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

3235 ) where

3336

37+#if defined(ASSERTS)

3438import Control.Exception (assert)

35−import Data.ByteString as B

39+#endif

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

37−import Data.Text.Fusion (Step(..), Stream(..))

38−import Data.Text.Fusion.Size

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

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

3943import Data.Text.Encoding.Error

40−import Data.Text.Encoding.Fusion.Common

41−import Data.Text.UnsafeChar (unsafeChr, unsafeChr8, unsafeChr32)

42−import Data.Text.UnsafeShift (shiftL, shiftR)

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)

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

4448import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

4549import Foreign.Storable (pokeByteOff)

46−import System.IO.Unsafe (unsafePerformIO)

4750import qualified Data.ByteString as B

4851import qualified Data.ByteString.Unsafe as B

49−import qualified Data.Text.Encoding.Utf8 as U8

50−import qualified Data.Text.Encoding.Utf16 as U16

51−import qualified Data.Text.Encoding.Utf32 as U32

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)

5256

5357streamASCII :: ByteString -> Stream Char

5458streamASCII bs = Stream next 0 (maxSize l)

@@ -60,6 +64,7 @@ streamASCII bs = Stream next 0 (maxSize l)

6064 | otherwise = Yield (unsafeChr8 x1) (i+1)

6165 where

6266 x1 = B.unsafeIndex bs i

67+{-# DEPRECATED streamASCII "Do not use this function" #-}

6368{-# INLINE [0] streamASCII #-}

6469

6570-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8

@@ -68,16 +73,14 @@ streamUtf8 :: OnDecodeError -> ByteString -> Stream Char

6873streamUtf8 onErr bs = Stream next 0 (maxSize l)

6974 where

7075 l = B.length bs

71− {-# INLINE next #-}

7276 next i

7377 | i >= l = Done

7478 | U8.validate1 x1 = Yield (unsafeChr8 x1) (i+1)

7579 | i+1 < l && U8.validate2 x1 x2 = Yield (U8.chr2 x1 x2) (i+2)

7680 | i+2 < l && U8.validate3 x1 x2 x3 = Yield (U8.chr3 x1 x2 x3) (i+3)

7781 | i+3 < l && U8.validate4 x1 x2 x3 x4 = Yield (U8.chr4 x1 x2 x3 x4) (i+4)

78− | otherwise = decodeError "streamUtf8" "UTF-8" onErr mx (i+1)

82+ | otherwise = decodeError "streamUtf8" "UTF-8" onErr (Just x1) (i+1)

7983 where

80− mx = if i >= l then Nothing else Just x1

8184 x1 = idx i

8285 x2 = idx (i + 1)

8386 x3 = idx (i + 2)

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

163166

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

165168unstream :: Stream Word8 -> ByteString

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

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

167170 let mlen = upperBound 4 len

168171 mallocByteString mlen >>= loop mlen 0 s0

169172 where

@@ -184,7 +187,11 @@ unstream (Stream next s0 len) = unsafePerformIO $ do

184187 {-# NOINLINE trimUp #-}

185188 trimUp fp _ off = return $! PS fp 0 off

186189 copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)

187− copy0 !src !srcLen !destLen = assert (srcLen <= destLen) $ do

190+ copy0 !src !srcLen !destLen =

191+#if defined(ASSERTS)

192+ assert (srcLen <= destLen) $

193+#endif

194+ do

188195 dest <- mallocByteString destLen

189196 withForeignPtr src $ \src' ->

190197 withForeignPtr dest $ \dest' ->

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

197204 case onErr desc mb of

198205 Nothing -> Skip i

199206 Just c -> Yield c i

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

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

201208 kind ++ " stream"

Data/Text/Internal/Encoding/Fusion/Common.hsnew file+123

@@ -0,0 +1,123 @@

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/Utf16.hsnew file+45

@@ -0,0 +1,45 @@

1+{-# LANGUAGE MagicHash, BangPatterns #-}

2+

3+-- |

4+-- Module : Data.Text.Internal.Encoding.Utf16

8+--

9+-- License : BSD-style

10+-- Maintainer : bos@serpentine.com

11+-- Stability : experimental

12+-- Portability : GHC

13+--

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

18+-- Basic UTF-16 validation and character manipulation.

19+module Data.Text.Internal.Encoding.Utf16

20+ (

21+ chr2

22+ , validate1

23+ , validate2

24+ ) where

25+

26+import GHC.Exts

27+import GHC.Word (Word16(..))

28+

29+chr2 :: Word16 -> Word16 -> Char

30+chr2 (W16# a#) (W16# b#) = C# (chr# (upper# +# lower# +# 0x10000#))

31+ where

32+ !x# = word2Int# a#

33+ !y# = word2Int# b#

34+ !upper# = uncheckedIShiftL# (x# -# 0xD800#) 10#

35+ !lower# = y# -# 0xDC00#

36+{-# INLINE chr2 #-}

37+

38+validate1 :: Word16 -> Bool

39+validate1 x1 = x1 < 0xD800 || x1 > 0xDFFF

40+{-# INLINE validate1 #-}

41+

42+validate2 :: Word16 -> Word16 -> Bool

43+validate2 x1 x2 = x1 >= 0xD800 && x1 <= 0xDBFF &&

44+ x2 >= 0xDC00 && x2 <= 0xDFFF

45+{-# INLINE validate2 #-}

Data/Text/Internal/Encoding/Utf32.hsnew file+26

@@ -0,0 +1,26 @@

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/Encoding/Utf8.hs → Data/Text/Internal/Encoding/Utf8.hsrenamed+65−49

@@ -1,19 +1,22 @@

1−{-# LANGUAGE MagicHash #-}

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

22

33-- |

4−-- Module : Data.Text.Encoding.Utf16

5−-- Copyright : (c) Tom Harper 2008-2009,

6−-- (c) Bryan O'Sullivan 2009,

7−-- (c) Duncan Coutts 2009

4+-- Module : Data.Text.Internal.Encoding.Utf8

88--

99-- License : BSD-style

10−-- Maintainer : rtharper@aftereternity.co.uk, bos@serpentine.com,

11−-- duncan@haskell.org

10+-- Maintainer : bos@serpentine.com

1211-- Stability : experimental

1312-- Portability : GHC

1413--

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

1518-- Basic UTF-8 validation and character manipulation.

16−module Data.Text.Encoding.Utf8

19+module Data.Text.Internal.Encoding.Utf8

1720 (

1821 -- Decomposition

1922 ord2

@@ -30,10 +33,16 @@ module Data.Text.Encoding.Utf8

3033 , validate4

3134 ) where

3235

36+#if defined(TEST_SUITE)

37+# undef ASSERTS

38+#endif

39+

40+#if defined(ASSERTS)

3341import Control.Exception (assert)

34−import Data.Char (ord)

42+#endif

3543import Data.Bits ((.&.))

36−import Data.Text.UnsafeShift (shiftR)

44+import Data.Text.Internal.Unsafe.Char (ord)

45+import Data.Text.Internal.Unsafe.Shift (shiftR)

3746import GHC.Exts

3847import GHC.Word (Word8(..))

3948

@@ -46,23 +55,35 @@ between :: Word8 -- ^ byte to check

4655between x y z = x >= y && x <= z

4756{-# INLINE between #-}

4857

49−ord2 :: Char -> (Word8,Word8)

50−ord2 c = assert (n >= 0x80 && n <= 0x07ff) (x1,x2)

58+ord2 :: Char -> (Word8,Word8)

59+ord2 c =

60+#if defined(ASSERTS)

61+ assert (n >= 0x80 && n <= 0x07ff)

62+#endif

63+ (x1,x2)

5164 where

5265 n = ord c

5366 x1 = fromIntegral $ (n `shiftR` 6) + 0xC0

5467 x2 = fromIntegral $ (n .&. 0x3F) + 0x80

5568

56−ord3 :: Char -> (Word8,Word8,Word8)

57−ord3 c = assert (n >= 0x0800 && n <= 0xffff) (x1,x2,x3)

69+ord3 :: Char -> (Word8,Word8,Word8)

70+ord3 c =

71+#if defined(ASSERTS)

72+ assert (n >= 0x0800 && n <= 0xffff)

73+#endif

74+ (x1,x2,x3)

5875 where

5976 n = ord c

6077 x1 = fromIntegral $ (n `shiftR` 12) + 0xE0

6178 x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80

6279 x3 = fromIntegral $ (n .&. 0x3F) + 0x80

6380

64−ord4 :: Char -> (Word8,Word8,Word8,Word8)

65−ord4 c = assert (n >= 0x10000) (x1,x2,x3,x4)

81+ord4 :: Char -> (Word8,Word8,Word8,Word8)

82+ord4 c =

83+#if defined(ASSERTS)

84+ assert (n >= 0x10000)

85+#endif

86+ (x1,x2,x3,x4)

6687 where

6788 n = ord c

6889 x1 = fromIntegral $ (n `shiftR` 18) + 0xF0

@@ -70,54 +91,51 @@ ord4 c = assert (n >= 0x10000) (x1,x2,x3,x4)

7091 x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80

7192 x4 = fromIntegral $ (n .&. 0x3F) + 0x80

7293

73−chr2 :: Word8 -> Word8 -> Char

94+chr2 :: Word8 -> Word8 -> Char

7495chr2 (W8# x1#) (W8# x2#) = C# (chr# (z1# +# z2#))

7596 where

76− y1# = word2Int# x1#

77− y2# = word2Int# x2#

78− z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#

79− z2# = y2# -# 0x80#

97+ !y1# = word2Int# x1#

98+ !y2# = word2Int# x2#

99+ !z1# = uncheckedIShiftL# (y1# -# 0xC0#) 6#

100+ !z2# = y2# -# 0x80#

80101{-# INLINE chr2 #-}

81102

82−chr3 :: Word8 -> Word8 -> Word8 -> Char

103+chr3 :: Word8 -> Word8 -> Word8 -> Char

83104chr3 (W8# x1#) (W8# x2#) (W8# x3#) = C# (chr# (z1# +# z2# +# z3#))

84105 where

85− y1# = word2Int# x1#

86− y2# = word2Int# x2#

87− y3# = word2Int# x3#

88− z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#

89− z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#

90− z3# = y3# -# 0x80#

106+ !y1# = word2Int# x1#

107+ !y2# = word2Int# x2#

108+ !y3# = word2Int# x3#

109+ !z1# = uncheckedIShiftL# (y1# -# 0xE0#) 12#

110+ !z2# = uncheckedIShiftL# (y2# -# 0x80#) 6#

111+ !z3# = y3# -# 0x80#

91112{-# INLINE chr3 #-}

92113

93114chr4 :: Word8 -> Word8 -> Word8 -> Word8 -> Char

94115chr4 (W8# x1#) (W8# x2#) (W8# x3#) (W8# x4#) =

95116 C# (chr# (z1# +# z2# +# z3# +# z4#))

96117 where

97− y1# = word2Int# x1#

98− y2# = word2Int# x2#

99− y3# = word2Int# x3#

100− y4# = word2Int# x4#

101− z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#

102− z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#

103− z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#

104− z4# = y4# -# 0x80#

118+ !y1# = word2Int# x1#

119+ !y2# = word2Int# x2#

120+ !y3# = word2Int# x3#

121+ !y4# = word2Int# x4#

122+ !z1# = uncheckedIShiftL# (y1# -# 0xF0#) 18#

123+ !z2# = uncheckedIShiftL# (y2# -# 0x80#) 12#

124+ !z3# = uncheckedIShiftL# (y3# -# 0x80#) 6#

125+ !z4# = y4# -# 0x80#

105126{-# INLINE chr4 #-}

106127

107−validate1 :: Word8 -> Bool

108−validate1 x1 = between x1 0x00 0x7F

128+validate1 :: Word8 -> Bool

129+validate1 x1 = x1 <= 0x7F

109130{-# INLINE validate1 #-}

110131

111−validate2 :: Word8 -> Word8 -> Bool

132+validate2 :: Word8 -> Word8 -> Bool

112133validate2 x1 x2 = between x1 0xC2 0xDF && between x2 0x80 0xBF

113134{-# INLINE validate2 #-}

114135

115−validate3 :: Word8 -> Word8 -> Word8 -> Bool

136+validate3 :: Word8 -> Word8 -> Word8 -> Bool

116137{-# INLINE validate3 #-}

117−validate3 x1 x2 x3 = validate3_1 ||

118− validate3_2 ||

119− validate3_3 ||

120− validate3_4

138+validate3 x1 x2 x3 = validate3_1 || validate3_2 || validate3_3 || validate3_4

121139 where

122140 validate3_1 = (x1 == 0xE0) &&

123141 between x2 0xA0 0xBF &&

@@ -132,12 +150,10 @@ validate3 x1 x2 x3 = validate3_1 ||

132150 between x2 0x80 0xBF &&

133151 between x3 0x80 0xBF

134152

135−validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool

153+validate4 :: Word8 -> Word8 -> Word8 -> Word8 -> Bool

136154{-# INLINE validate4 #-}

137−validate4 x1 x2 x3 x4 = validate4_1 ||

138− validate4_2 ||

139− validate4_3

140− where

155+validate4 x1 x2 x3 x4 = validate4_1 || validate4_2 || validate4_3

156+ where

141157 validate4_1 = x1 == 0xF0 &&

142158 between x2 0x90 0xBF &&

143159 between x3 0x80 0xBF &&

Data/Text/Internal/Functions.hsnew file+31

@@ -0,0 +1,31 @@

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/Fusion.hs → Data/Text/Internal/Fusion.hsrenamed+91−45

@@ -1,20 +1,23 @@

11{-# LANGUAGE BangPatterns, MagicHash #-}

22

33-- |

4−-- Module : Data.Text.Fusion

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

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

6−-- (c) Bryan O'Sullivan 2009,

6+-- (c) Bryan O'Sullivan 2009-2010,

77-- (c) Duncan Coutts 2009

88--

99-- License : BSD-style

10−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

11−-- duncan@haskell.org

10+-- Maintainer : bos@serpentine.com

1211-- Stability : experimental

1312-- Portability : GHC

1413--

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

1518-- Text manipulation functions represented as fusible operations over

1619-- streams.

17−module Data.Text.Fusion

20+module Data.Text.Internal.Fusion

1821 (

1922 -- * Types

2023 Stream(..)

@@ -34,6 +37,9 @@ module Data.Text.Fusion

3437 -- ** Scans

3538 , reverseScanr

3639

40+ -- ** Accumulating maps

41+ , mapAccumL

42+

3743 -- ** Generation and unfolding

3844 , unfoldrN

3945

@@ -47,26 +53,24 @@ import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,

4753 Num(..), Ord(..), ($), (&&),

4854 fromIntegral, otherwise)

4955import Data.Bits ((.&.))

50−import Data.Char (ord)

5156import Data.Text.Internal (Text(..))

52−import Data.Text.UnsafeChar (unsafeChr, unsafeWrite)

53−import Data.Text.UnsafeShift (shiftL, shiftR)

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)

5460import qualified Data.Text.Array as A

55−import qualified Data.Text.Fusion.Common as S

56−import Data.Text.Fusion.Internal

57−import Data.Text.Fusion.Size

61+import qualified Data.Text.Internal.Fusion.Common as S

62+import Data.Text.Internal.Fusion.Types

63+import Data.Text.Internal.Fusion.Size

5864import qualified Data.Text.Internal as I

59−import qualified Data.Text.Encoding.Utf16 as U16

60−import qualified Prelude as P

65+import qualified Data.Text.Internal.Encoding.Utf16 as U16

6166

6267default(Int)

6368

6469-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.

6570stream :: Text -> Stream Char

66−stream (Text arr off len) = Stream next off (maxSize len)

71+stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)

6772 where

68− end = off+len

69− {-# INLINE next #-}

73+ !end = off+len

7074 next !i

7175 | i >= end = Done

7276 | n >= 0xD800 && n <= 0xDBFF = Yield (U16.chr2 n n2) (i + 2)

@@ -79,7 +83,7 @@ stream (Text arr off len) = Stream next off (maxSize len)

7983-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate

8084-- backwards.

8185reverseStream :: Text -> Stream Char

82−reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)

86+reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)

8387 where

8488 {-# INLINE next #-}

8589 next !i

@@ -93,21 +97,36 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (maxSize len)

9397

9498-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.

9599unstream :: Stream Char -> Text

96−unstream (Stream next0 s0 len) = I.textP (P.fst a) 0 (P.snd a)

97− where

98− mlen = upperBound 4 len

99− a = A.run2 (A.unsafeNew mlen >>= (\arr -> loop arr mlen s0 0))

100− loop arr !top !s !i

101− | i + 1 >= top = case next0 s of

102− Done -> return (arr, i)

103− _ -> do

104− let top' = (top `shiftL` 1) + 1

105− arr' <- A.unsafeNew top'

106− A.copy arr arr' >> loop arr' top' s i

107− | otherwise = case next0 s of

108− Done -> return (arr, i)

109− Skip s' -> loop arr top s' i

110− Yield x s' -> unsafeWrite arr i x >>= loop arr top s'

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

111130{-# INLINE [0] unstream #-}

112131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}

113132

@@ -123,19 +142,19 @@ length = S.lengthI

123142reverse :: Stream Char -> Text

124143reverse (Stream next s len0)

125144 | isEmpty len0 = I.empty

126− | otherwise = I.textP arr off' len'

145+ | otherwise = I.text arr off' len'

127146 where

128147 len0' = upperBound 4 (larger len0 4)

129− (arr, (off', len')) = A.run2 (A.unsafeNew len0' >>= loop s (len0'-1) len0')

148+ (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')

130149 loop !s0 !i !len marr =

131150 case next s0 of

132151 Done -> return (marr, (j, len-j))

133152 where j = i + 1

134153 Skip s1 -> loop s1 i len marr

135− Yield x s1 | i < least -> do

136− let newLen = len * 2

137− marr' <- A.unsafeNew newLen

138− A.unsafeCopy marr 0 marr' (newLen-len) len

154+ Yield x s1 | i < least -> {-# SCC "reverse/resize" #-} do

155+ let newLen = len `shiftL` 1

156+ marr' <- A.new newLen

157+ A.copyM marr' (newLen-len) marr 0 len

139158 write s1 (len+i) newLen marr'

140159 | otherwise -> write s1 i len marr

141160 where n = ord x

@@ -157,15 +176,15 @@ reverse (Stream next s len0)

157176-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with

158177-- the input and result reversed.

159178reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

160−reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low

179+reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low

161180 where

162181 {-# INLINE next #-}

163− next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)

164− next (S2 :*: z :*: s) = case next0 s of

165− Yield x s' -> let !x' = f x z

166− in Yield x' (S2 :*: x' :*: s')

167− Skip s' -> Skip (S2 :*: z :*: s')

168− Done -> Done

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

169188{-# INLINE reverseScanr #-}

170189

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

@@ -196,3 +215,30 @@ findIndex = S.findIndexI

196215countChar :: Char -> Stream Char -> Int

197216countChar = S.countCharI

198217{-# 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.hsnew file+842

@@ -0,0 +1,842 @@

1+{-# LANGUAGE Rank2Types #-}

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

10+import Data.Char

11+import Data.Text.Internal.Fusion.Types

12+

13+upperMapping :: forall s. Char -> s -> Step (CC s) Char

14+{-# NOINLINE upperMapping #-}

15+-- LATIN SMALL LETTER SHARP S

16+upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')

17+-- LATIN SMALL LIGATURE FF

18+upperMapping '\xfb00' s = Yield '\x0046' (CC s '\x0046' '\x0000')

19+-- LATIN SMALL LIGATURE FI

20+upperMapping '\xfb01' s = Yield '\x0046' (CC s '\x0049' '\x0000')

21+-- LATIN SMALL LIGATURE FL

22+upperMapping '\xfb02' s = Yield '\x0046' (CC s '\x004c' '\x0000')

23+-- LATIN SMALL LIGATURE FFI

24+upperMapping '\xfb03' s = Yield '\x0046' (CC s '\x0046' '\x0049')

25+-- LATIN SMALL LIGATURE FFL

26+upperMapping '\xfb04' s = Yield '\x0046' (CC s '\x0046' '\x004c')

27+-- LATIN SMALL LIGATURE LONG S T

28+upperMapping '\xfb05' s = Yield '\x0053' (CC s '\x0054' '\x0000')

29+-- LATIN SMALL LIGATURE ST

30+upperMapping '\xfb06' s = Yield '\x0053' (CC s '\x0054' '\x0000')

31+-- ARMENIAN SMALL LIGATURE ECH YIWN

32+upperMapping '\x0587' s = Yield '\x0535' (CC s '\x0552' '\x0000')

33+-- ARMENIAN SMALL LIGATURE MEN NOW

34+upperMapping '\xfb13' s = Yield '\x0544' (CC s '\x0546' '\x0000')

35+-- ARMENIAN SMALL LIGATURE MEN ECH

36+upperMapping '\xfb14' s = Yield '\x0544' (CC s '\x0535' '\x0000')

37+-- ARMENIAN SMALL LIGATURE MEN INI

38+upperMapping '\xfb15' s = Yield '\x0544' (CC s '\x053b' '\x0000')

39+-- ARMENIAN SMALL LIGATURE VEW NOW

40+upperMapping '\xfb16' s = Yield '\x054e' (CC s '\x0546' '\x0000')

41+-- ARMENIAN SMALL LIGATURE MEN XEH

42+upperMapping '\xfb17' s = Yield '\x0544' (CC s '\x053d' '\x0000')

43+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE

44+upperMapping '\x0149' s = Yield '\x02bc' (CC s '\x004e' '\x0000')

45+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS

46+upperMapping '\x0390' s = Yield '\x0399' (CC s '\x0308' '\x0301')

47+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS

48+upperMapping '\x03b0' s = Yield '\x03a5' (CC s '\x0308' '\x0301')

49+-- LATIN SMALL LETTER J WITH CARON

50+upperMapping '\x01f0' s = Yield '\x004a' (CC s '\x030c' '\x0000')

51+-- LATIN SMALL LETTER H WITH LINE BELOW

52+upperMapping '\x1e96' s = Yield '\x0048' (CC s '\x0331' '\x0000')

53+-- LATIN SMALL LETTER T WITH DIAERESIS

54+upperMapping '\x1e97' s = Yield '\x0054' (CC s '\x0308' '\x0000')

55+-- LATIN SMALL LETTER W WITH RING ABOVE

56+upperMapping '\x1e98' s = Yield '\x0057' (CC s '\x030a' '\x0000')

57+-- LATIN SMALL LETTER Y WITH RING ABOVE

58+upperMapping '\x1e99' s = Yield '\x0059' (CC s '\x030a' '\x0000')

59+-- LATIN SMALL LETTER A WITH RIGHT HALF RING

60+upperMapping '\x1e9a' s = Yield '\x0041' (CC s '\x02be' '\x0000')

61+-- GREEK SMALL LETTER UPSILON WITH PSILI

62+upperMapping '\x1f50' s = Yield '\x03a5' (CC s '\x0313' '\x0000')

63+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA

64+upperMapping '\x1f52' s = Yield '\x03a5' (CC s '\x0313' '\x0300')

65+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA

66+upperMapping '\x1f54' s = Yield '\x03a5' (CC s '\x0313' '\x0301')

67+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI

68+upperMapping '\x1f56' s = Yield '\x03a5' (CC s '\x0313' '\x0342')

69+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI

70+upperMapping '\x1fb6' s = Yield '\x0391' (CC s '\x0342' '\x0000')

71+-- GREEK SMALL LETTER ETA WITH PERISPOMENI

72+upperMapping '\x1fc6' s = Yield '\x0397' (CC s '\x0342' '\x0000')

73+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA

74+upperMapping '\x1fd2' s = Yield '\x0399' (CC s '\x0308' '\x0300')

75+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA

76+upperMapping '\x1fd3' s = Yield '\x0399' (CC s '\x0308' '\x0301')

77+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI

78+upperMapping '\x1fd6' s = Yield '\x0399' (CC s '\x0342' '\x0000')

79+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI

80+upperMapping '\x1fd7' s = Yield '\x0399' (CC s '\x0308' '\x0342')

81+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA

82+upperMapping '\x1fe2' s = Yield '\x03a5' (CC s '\x0308' '\x0300')

83+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA

84+upperMapping '\x1fe3' s = Yield '\x03a5' (CC s '\x0308' '\x0301')

85+-- GREEK SMALL LETTER RHO WITH PSILI

86+upperMapping '\x1fe4' s = Yield '\x03a1' (CC s '\x0313' '\x0000')

87+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI

88+upperMapping '\x1fe6' s = Yield '\x03a5' (CC s '\x0342' '\x0000')

89+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI

90+upperMapping '\x1fe7' s = Yield '\x03a5' (CC s '\x0308' '\x0342')

91+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI

92+upperMapping '\x1ff6' s = Yield '\x03a9' (CC s '\x0342' '\x0000')

93+-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI

94+upperMapping '\x1f80' s = Yield '\x1f08' (CC s '\x0399' '\x0000')

95+-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI

96+upperMapping '\x1f81' s = Yield '\x1f09' (CC s '\x0399' '\x0000')

97+-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI

98+upperMapping '\x1f82' s = Yield '\x1f0a' (CC s '\x0399' '\x0000')

99+-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI

100+upperMapping '\x1f83' s = Yield '\x1f0b' (CC s '\x0399' '\x0000')

101+-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI

102+upperMapping '\x1f84' s = Yield '\x1f0c' (CC s '\x0399' '\x0000')

103+-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI

104+upperMapping '\x1f85' s = Yield '\x1f0d' (CC s '\x0399' '\x0000')

105+-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

106+upperMapping '\x1f86' s = Yield '\x1f0e' (CC s '\x0399' '\x0000')

107+-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

108+upperMapping '\x1f87' s = Yield '\x1f0f' (CC s '\x0399' '\x0000')

109+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI

110+upperMapping '\x1f88' s = Yield '\x1f08' (CC s '\x0399' '\x0000')

111+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI

112+upperMapping '\x1f89' s = Yield '\x1f09' (CC s '\x0399' '\x0000')

113+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI

114+upperMapping '\x1f8a' s = Yield '\x1f0a' (CC s '\x0399' '\x0000')

115+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI

116+upperMapping '\x1f8b' s = Yield '\x1f0b' (CC s '\x0399' '\x0000')

117+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI

118+upperMapping '\x1f8c' s = Yield '\x1f0c' (CC s '\x0399' '\x0000')

119+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI

120+upperMapping '\x1f8d' s = Yield '\x1f0d' (CC s '\x0399' '\x0000')

121+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

122+upperMapping '\x1f8e' s = Yield '\x1f0e' (CC s '\x0399' '\x0000')

123+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

124+upperMapping '\x1f8f' s = Yield '\x1f0f' (CC s '\x0399' '\x0000')

125+-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI

126+upperMapping '\x1f90' s = Yield '\x1f28' (CC s '\x0399' '\x0000')

127+-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI

128+upperMapping '\x1f91' s = Yield '\x1f29' (CC s '\x0399' '\x0000')

129+-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI

130+upperMapping '\x1f92' s = Yield '\x1f2a' (CC s '\x0399' '\x0000')

131+-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI

132+upperMapping '\x1f93' s = Yield '\x1f2b' (CC s '\x0399' '\x0000')

133+-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI

134+upperMapping '\x1f94' s = Yield '\x1f2c' (CC s '\x0399' '\x0000')

135+-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI

136+upperMapping '\x1f95' s = Yield '\x1f2d' (CC s '\x0399' '\x0000')

137+-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

138+upperMapping '\x1f96' s = Yield '\x1f2e' (CC s '\x0399' '\x0000')

139+-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

140+upperMapping '\x1f97' s = Yield '\x1f2f' (CC s '\x0399' '\x0000')

141+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI

142+upperMapping '\x1f98' s = Yield '\x1f28' (CC s '\x0399' '\x0000')

143+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI

144+upperMapping '\x1f99' s = Yield '\x1f29' (CC s '\x0399' '\x0000')

145+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI

146+upperMapping '\x1f9a' s = Yield '\x1f2a' (CC s '\x0399' '\x0000')

147+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI

148+upperMapping '\x1f9b' s = Yield '\x1f2b' (CC s '\x0399' '\x0000')

149+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI

150+upperMapping '\x1f9c' s = Yield '\x1f2c' (CC s '\x0399' '\x0000')

151+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI

152+upperMapping '\x1f9d' s = Yield '\x1f2d' (CC s '\x0399' '\x0000')

153+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

154+upperMapping '\x1f9e' s = Yield '\x1f2e' (CC s '\x0399' '\x0000')

155+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

156+upperMapping '\x1f9f' s = Yield '\x1f2f' (CC s '\x0399' '\x0000')

157+-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI

158+upperMapping '\x1fa0' s = Yield '\x1f68' (CC s '\x0399' '\x0000')

159+-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI

160+upperMapping '\x1fa1' s = Yield '\x1f69' (CC s '\x0399' '\x0000')

161+-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI

162+upperMapping '\x1fa2' s = Yield '\x1f6a' (CC s '\x0399' '\x0000')

163+-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI

164+upperMapping '\x1fa3' s = Yield '\x1f6b' (CC s '\x0399' '\x0000')

165+-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI

166+upperMapping '\x1fa4' s = Yield '\x1f6c' (CC s '\x0399' '\x0000')

167+-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI

168+upperMapping '\x1fa5' s = Yield '\x1f6d' (CC s '\x0399' '\x0000')

169+-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

170+upperMapping '\x1fa6' s = Yield '\x1f6e' (CC s '\x0399' '\x0000')

171+-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

172+upperMapping '\x1fa7' s = Yield '\x1f6f' (CC s '\x0399' '\x0000')

173+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI

174+upperMapping '\x1fa8' s = Yield '\x1f68' (CC s '\x0399' '\x0000')

175+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI

176+upperMapping '\x1fa9' s = Yield '\x1f69' (CC s '\x0399' '\x0000')

177+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI

178+upperMapping '\x1faa' s = Yield '\x1f6a' (CC s '\x0399' '\x0000')

179+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI

180+upperMapping '\x1fab' s = Yield '\x1f6b' (CC s '\x0399' '\x0000')

181+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI

182+upperMapping '\x1fac' s = Yield '\x1f6c' (CC s '\x0399' '\x0000')

183+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI

184+upperMapping '\x1fad' s = Yield '\x1f6d' (CC s '\x0399' '\x0000')

185+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

186+upperMapping '\x1fae' s = Yield '\x1f6e' (CC s '\x0399' '\x0000')

187+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

188+upperMapping '\x1faf' s = Yield '\x1f6f' (CC s '\x0399' '\x0000')

189+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI

190+upperMapping '\x1fb3' s = Yield '\x0391' (CC s '\x0399' '\x0000')

191+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI

192+upperMapping '\x1fbc' s = Yield '\x0391' (CC s '\x0399' '\x0000')

193+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI

194+upperMapping '\x1fc3' s = Yield '\x0397' (CC s '\x0399' '\x0000')

195+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI

196+upperMapping '\x1fcc' s = Yield '\x0397' (CC s '\x0399' '\x0000')

197+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI

198+upperMapping '\x1ff3' s = Yield '\x03a9' (CC s '\x0399' '\x0000')

199+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

200+upperMapping '\x1ffc' s = Yield '\x03a9' (CC s '\x0399' '\x0000')

201+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI

202+upperMapping '\x1fb2' s = Yield '\x1fba' (CC s '\x0399' '\x0000')

203+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI

204+upperMapping '\x1fb4' s = Yield '\x0386' (CC s '\x0399' '\x0000')

205+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI

206+upperMapping '\x1fc2' s = Yield '\x1fca' (CC s '\x0399' '\x0000')

207+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI

208+upperMapping '\x1fc4' s = Yield '\x0389' (CC s '\x0399' '\x0000')

209+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI

210+upperMapping '\x1ff2' s = Yield '\x1ffa' (CC s '\x0399' '\x0000')

211+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI

212+upperMapping '\x1ff4' s = Yield '\x038f' (CC s '\x0399' '\x0000')

213+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI

214+upperMapping '\x1fb7' s = Yield '\x0391' (CC s '\x0342' '\x0399')

215+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI

216+upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')

217+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI

218+upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')

219+upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')

220+lowerMapping :: forall s. Char -> s -> Step (CC s) Char

221+{-# NOINLINE lowerMapping #-}

222+-- LATIN CAPITAL LETTER I WITH DOT ABOVE

223+lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')

224+lowerMapping 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')

324+foldMapping :: forall s. Char -> s -> Step (CC s) Char

325+{-# NOINLINE foldMapping #-}

326+-- MICRO SIGN

327+foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')

328+-- LATIN SMALL LETTER SHARP S

329+foldMapping '\x00df' s = Yield '\x0073' (CC s '\x0073' '\x0000')

330+-- LATIN CAPITAL LETTER I WITH DOT ABOVE

331+foldMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')

332+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE

333+foldMapping '\x0149' s = Yield '\x02bc' (CC s '\x006e' '\x0000')

334+-- LATIN SMALL LETTER LONG S

335+foldMapping '\x017f' s = Yield '\x0073' (CC s '\x0000' '\x0000')

336+-- LATIN SMALL LETTER J WITH CARON

337+foldMapping '\x01f0' s = Yield '\x006a' (CC s '\x030c' '\x0000')

338+-- COMBINING GREEK YPOGEGRAMMENI

339+foldMapping '\x0345' s = Yield '\x03b9' (CC s '\x0000' '\x0000')

340+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS

341+foldMapping '\x0390' s = Yield '\x03b9' (CC s '\x0308' '\x0301')

342+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS

343+foldMapping '\x03b0' s = Yield '\x03c5' (CC s '\x0308' '\x0301')

344+-- GREEK SMALL LETTER FINAL SIGMA

345+foldMapping '\x03c2' s = Yield '\x03c3' (CC s '\x0000' '\x0000')

346+-- GREEK BETA SYMBOL

347+foldMapping '\x03d0' s = Yield '\x03b2' (CC s '\x0000' '\x0000')

348+-- GREEK THETA SYMBOL

349+foldMapping '\x03d1' s = Yield '\x03b8' (CC s '\x0000' '\x0000')

350+-- GREEK PHI SYMBOL

351+foldMapping '\x03d5' s = Yield '\x03c6' (CC s '\x0000' '\x0000')

352+-- GREEK PI SYMBOL

353+foldMapping '\x03d6' s = Yield '\x03c0' (CC s '\x0000' '\x0000')

354+-- GREEK KAPPA SYMBOL

355+foldMapping '\x03f0' s = Yield '\x03ba' (CC s '\x0000' '\x0000')

356+-- GREEK RHO SYMBOL

357+foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')

358+-- GREEK LUNATE EPSILON SYMBOL

359+foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')

360+-- ARMENIAN SMALL LIGATURE ECH YIWN

361+foldMapping '\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')

374+-- LATIN SMALL LETTER H WITH LINE BELOW

375+foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')

376+-- LATIN SMALL LETTER T WITH DIAERESIS

377+foldMapping '\x1e97' s = Yield '\x0074' (CC s '\x0308' '\x0000')

378+-- LATIN SMALL LETTER W WITH RING ABOVE

379+foldMapping '\x1e98' s = Yield '\x0077' (CC s '\x030a' '\x0000')

380+-- LATIN SMALL LETTER Y WITH RING ABOVE

381+foldMapping '\x1e99' s = Yield '\x0079' (CC s '\x030a' '\x0000')

382+-- LATIN SMALL LETTER A WITH RIGHT HALF RING

383+foldMapping '\x1e9a' s = Yield '\x0061' (CC s '\x02be' '\x0000')

384+-- LATIN SMALL LETTER LONG S WITH DOT ABOVE

385+foldMapping '\x1e9b' s = Yield '\x1e61' (CC s '\x0000' '\x0000')

386+-- LATIN CAPITAL LETTER SHARP S

387+foldMapping '\x1e9e' s = Yield '\x0073' (CC s '\x0073' '\x0000')

388+-- GREEK SMALL LETTER UPSILON WITH PSILI

389+foldMapping '\x1f50' s = Yield '\x03c5' (CC s '\x0313' '\x0000')

390+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA

391+foldMapping '\x1f52' s = Yield '\x03c5' (CC s '\x0313' '\x0300')

392+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA

393+foldMapping '\x1f54' s = Yield '\x03c5' (CC s '\x0313' '\x0301')

394+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI

395+foldMapping '\x1f56' s = Yield '\x03c5' (CC s '\x0313' '\x0342')

396+-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI

397+foldMapping '\x1f80' s = Yield '\x1f00' (CC s '\x03b9' '\x0000')

398+-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI

399+foldMapping '\x1f81' s = Yield '\x1f01' (CC s '\x03b9' '\x0000')

400+-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI

401+foldMapping '\x1f82' s = Yield '\x1f02' (CC s '\x03b9' '\x0000')

402+-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI

403+foldMapping '\x1f83' s = Yield '\x1f03' (CC s '\x03b9' '\x0000')

404+-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI

405+foldMapping '\x1f84' s = Yield '\x1f04' (CC s '\x03b9' '\x0000')

406+-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI

407+foldMapping '\x1f85' s = Yield '\x1f05' (CC s '\x03b9' '\x0000')

408+-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

409+foldMapping '\x1f86' s = Yield '\x1f06' (CC s '\x03b9' '\x0000')

410+-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

411+foldMapping '\x1f87' s = Yield '\x1f07' (CC s '\x03b9' '\x0000')

412+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI

413+foldMapping '\x1f88' s = Yield '\x1f00' (CC s '\x03b9' '\x0000')

414+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI

415+foldMapping '\x1f89' s = Yield '\x1f01' (CC s '\x03b9' '\x0000')

416+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI

417+foldMapping '\x1f8a' s = Yield '\x1f02' (CC s '\x03b9' '\x0000')

418+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI

419+foldMapping '\x1f8b' s = Yield '\x1f03' (CC s '\x03b9' '\x0000')

420+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI

421+foldMapping '\x1f8c' s = Yield '\x1f04' (CC s '\x03b9' '\x0000')

422+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI

423+foldMapping '\x1f8d' s = Yield '\x1f05' (CC s '\x03b9' '\x0000')

424+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

425+foldMapping '\x1f8e' s = Yield '\x1f06' (CC s '\x03b9' '\x0000')

426+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

427+foldMapping '\x1f8f' s = Yield '\x1f07' (CC s '\x03b9' '\x0000')

428+-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI

429+foldMapping '\x1f90' s = Yield '\x1f20' (CC s '\x03b9' '\x0000')

430+-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI

431+foldMapping '\x1f91' s = Yield '\x1f21' (CC s '\x03b9' '\x0000')

432+-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI

433+foldMapping '\x1f92' s = Yield '\x1f22' (CC s '\x03b9' '\x0000')

434+-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI

435+foldMapping '\x1f93' s = Yield '\x1f23' (CC s '\x03b9' '\x0000')

436+-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI

437+foldMapping '\x1f94' s = Yield '\x1f24' (CC s '\x03b9' '\x0000')

438+-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI

439+foldMapping '\x1f95' s = Yield '\x1f25' (CC s '\x03b9' '\x0000')

440+-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

441+foldMapping '\x1f96' s = Yield '\x1f26' (CC s '\x03b9' '\x0000')

442+-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

443+foldMapping '\x1f97' s = Yield '\x1f27' (CC s '\x03b9' '\x0000')

444+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI

445+foldMapping '\x1f98' s = Yield '\x1f20' (CC s '\x03b9' '\x0000')

446+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI

447+foldMapping '\x1f99' s = Yield '\x1f21' (CC s '\x03b9' '\x0000')

448+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI

449+foldMapping '\x1f9a' s = Yield '\x1f22' (CC s '\x03b9' '\x0000')

450+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI

451+foldMapping '\x1f9b' s = Yield '\x1f23' (CC s '\x03b9' '\x0000')

452+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI

453+foldMapping '\x1f9c' s = Yield '\x1f24' (CC s '\x03b9' '\x0000')

454+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI

455+foldMapping '\x1f9d' s = Yield '\x1f25' (CC s '\x03b9' '\x0000')

456+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

457+foldMapping '\x1f9e' s = Yield '\x1f26' (CC s '\x03b9' '\x0000')

458+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

459+foldMapping '\x1f9f' s = Yield '\x1f27' (CC s '\x03b9' '\x0000')

460+-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI

461+foldMapping '\x1fa0' s = Yield '\x1f60' (CC s '\x03b9' '\x0000')

462+-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI

463+foldMapping '\x1fa1' s = Yield '\x1f61' (CC s '\x03b9' '\x0000')

464+-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI

465+foldMapping '\x1fa2' s = Yield '\x1f62' (CC s '\x03b9' '\x0000')

466+-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI

467+foldMapping '\x1fa3' s = Yield '\x1f63' (CC s '\x03b9' '\x0000')

468+-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI

469+foldMapping '\x1fa4' s = Yield '\x1f64' (CC s '\x03b9' '\x0000')

470+-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI

471+foldMapping '\x1fa5' s = Yield '\x1f65' (CC s '\x03b9' '\x0000')

472+-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

473+foldMapping '\x1fa6' s = Yield '\x1f66' (CC s '\x03b9' '\x0000')

474+-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

475+foldMapping '\x1fa7' s = Yield '\x1f67' (CC s '\x03b9' '\x0000')

476+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI

477+foldMapping '\x1fa8' s = Yield '\x1f60' (CC s '\x03b9' '\x0000')

478+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI

479+foldMapping '\x1fa9' s = Yield '\x1f61' (CC s '\x03b9' '\x0000')

480+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI

481+foldMapping '\x1faa' s = Yield '\x1f62' (CC s '\x03b9' '\x0000')

482+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI

483+foldMapping '\x1fab' s = Yield '\x1f63' (CC s '\x03b9' '\x0000')

484+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI

485+foldMapping '\x1fac' s = Yield '\x1f64' (CC s '\x03b9' '\x0000')

486+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI

487+foldMapping '\x1fad' s = Yield '\x1f65' (CC s '\x03b9' '\x0000')

488+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

489+foldMapping '\x1fae' s = Yield '\x1f66' (CC s '\x03b9' '\x0000')

490+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

491+foldMapping '\x1faf' s = Yield '\x1f67' (CC s '\x03b9' '\x0000')

492+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI

493+foldMapping '\x1fb2' s = Yield '\x1f70' (CC s '\x03b9' '\x0000')

494+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI

495+foldMapping '\x1fb3' s = Yield '\x03b1' (CC s '\x03b9' '\x0000')

496+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI

497+foldMapping '\x1fb4' s = Yield '\x03ac' (CC s '\x03b9' '\x0000')

498+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI

499+foldMapping '\x1fb6' s = Yield '\x03b1' (CC s '\x0342' '\x0000')

500+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI

501+foldMapping '\x1fb7' s = Yield '\x03b1' (CC s '\x0342' '\x03b9')

502+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI

503+foldMapping '\x1fbc' s = Yield '\x03b1' (CC s '\x03b9' '\x0000')

504+-- GREEK PROSGEGRAMMENI

505+foldMapping '\x1fbe' s = Yield '\x03b9' (CC s '\x0000' '\x0000')

506+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI

507+foldMapping '\x1fc2' s = Yield '\x1f74' (CC s '\x03b9' '\x0000')

508+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI

509+foldMapping '\x1fc3' s = Yield '\x03b7' (CC s '\x03b9' '\x0000')

510+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI

511+foldMapping '\x1fc4' s = Yield '\x03ae' (CC s '\x03b9' '\x0000')

512+-- GREEK SMALL LETTER ETA WITH PERISPOMENI

513+foldMapping '\x1fc6' s = Yield '\x03b7' (CC s '\x0342' '\x0000')

514+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI

515+foldMapping '\x1fc7' s = Yield '\x03b7' (CC s '\x0342' '\x03b9')

516+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI

517+foldMapping '\x1fcc' s = Yield '\x03b7' (CC s '\x03b9' '\x0000')

518+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA

519+foldMapping '\x1fd2' s = Yield '\x03b9' (CC s '\x0308' '\x0300')

520+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA

521+foldMapping '\x1fd3' s = Yield '\x03b9' (CC s '\x0308' '\x0301')

522+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI

523+foldMapping '\x1fd6' s = Yield '\x03b9' (CC s '\x0342' '\x0000')

524+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI

525+foldMapping '\x1fd7' s = Yield '\x03b9' (CC s '\x0308' '\x0342')

526+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA

527+foldMapping '\x1fe2' s = Yield '\x03c5' (CC s '\x0308' '\x0300')

528+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA

529+foldMapping '\x1fe3' s = Yield '\x03c5' (CC s '\x0308' '\x0301')

530+-- GREEK SMALL LETTER RHO WITH PSILI

531+foldMapping '\x1fe4' s = Yield '\x03c1' (CC s '\x0313' '\x0000')

532+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI

533+foldMapping '\x1fe6' s = Yield '\x03c5' (CC s '\x0342' '\x0000')

534+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI

535+foldMapping '\x1fe7' s = Yield '\x03c5' (CC s '\x0308' '\x0342')

536+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI

537+foldMapping '\x1ff2' s = Yield '\x1f7c' (CC s '\x03b9' '\x0000')

538+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI

539+foldMapping '\x1ff3' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')

540+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI

541+foldMapping '\x1ff4' s = Yield '\x03ce' (CC s '\x03b9' '\x0000')

542+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI

543+foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')

544+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI

545+foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')

546+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

547+foldMapping '\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')

716+-- LATIN SMALL LIGATURE FF

717+foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')

718+-- LATIN SMALL LIGATURE FI

719+foldMapping '\xfb01' s = Yield '\x0066' (CC s '\x0069' '\x0000')

720+-- LATIN SMALL LIGATURE FL

721+foldMapping '\xfb02' s = Yield '\x0066' (CC s '\x006c' '\x0000')

722+-- LATIN SMALL LIGATURE FFI

723+foldMapping '\xfb03' s = Yield '\x0066' (CC s '\x0066' '\x0069')

724+-- LATIN SMALL LIGATURE FFL

725+foldMapping '\xfb04' s = Yield '\x0066' (CC s '\x0066' '\x006c')

726+-- LATIN SMALL LIGATURE LONG S T

727+foldMapping '\xfb05' s = Yield '\x0073' (CC s '\x0074' '\x0000')

728+-- LATIN SMALL LIGATURE ST

729+foldMapping '\xfb06' s = Yield '\x0073' (CC s '\x0074' '\x0000')

730+-- ARMENIAN SMALL LIGATURE MEN NOW

731+foldMapping '\xfb13' s = Yield '\x0574' (CC s '\x0576' '\x0000')

732+-- ARMENIAN SMALL LIGATURE MEN ECH

733+foldMapping '\xfb14' s = Yield '\x0574' (CC s '\x0565' '\x0000')

734+-- ARMENIAN SMALL LIGATURE MEN INI

735+foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')

736+-- ARMENIAN SMALL LIGATURE VEW NOW

737+foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')

738+-- ARMENIAN SMALL LIGATURE MEN XEH

739+foldMapping '\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')

842+foldMapping c s = Yield (toLower c) (CC s '\0' '\0')

Data/Text/Fusion/Common.hs → Data/Text/Internal/Fusion/Common.hsrenamed+239−151

@@ -1,22 +1,26 @@

1−{-# LANGUAGE BangPatterns, Rank2Types #-}

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

22-- |

3−-- Module : Data.Text.Fusion.Common

4−-- Copyright : (c) Bryan O'Sullivan 2009

3+-- Module : Data.Text.Internal.Fusion.Common

4+-- Copyright : (c) Bryan O'Sullivan 2009, 2012

55--

66-- License : BSD-style

7−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

8−-- duncan@haskell.org

7+-- Maintainer : bos@serpentine.com

98-- Stability : experimental

109-- Portability : GHC

1110--

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

1215-- Common stream fusion functionality for text.

1316

14−module Data.Text.Fusion.Common

17+module Data.Text.Internal.Fusion.Common

1518 (

1619 -- * Creation and elimination

1720 singleton

1821 , streamList

1922 , unstreamList

23+ , streamCString#

2024

2125 -- * Basic interface

2226 , cons

@@ -29,6 +33,7 @@ module Data.Text.Fusion.Common

2933 , init

3034 , null

3135 , lengthI

36+ , compareLengthI

3237 , isSingleton

3338

3439 -- * Transformations

@@ -40,6 +45,7 @@ module Data.Text.Fusion.Common

4045 -- $case

4146 , toCaseFold

4247 , toLower

48+ , toTitle

4349 , toUpper

4450

4551 -- ** Justification

@@ -65,9 +71,6 @@ module Data.Text.Fusion.Common

6571 -- ** Scans

6672 , scanl

6773

68− -- ** Accumulating maps

69− -- , mapAccumL

70−

7174 -- ** Generation and unfolding

7275 , replicateCharI

7376 , replicateI

@@ -98,21 +101,26 @@ module Data.Text.Fusion.Common

98101 , zipWith

99102 ) where

100103

101−import Prelude (Bool(..), Char, Either(..), Eq(..), Int, Integral, Maybe(..),

102− Ord(..), String, (.), ($), (+), (-), (*), (++), (&&),

103− fromIntegral, otherwise)

104+import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),

105+ Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),

106+ (&&), fromIntegral, otherwise)

104107import qualified Data.List as L

105108import qualified Prelude as P

109+import Data.Bits (shiftL)

110+import Data.Char (isLetter)

106111import Data.Int (Int64)

107−import Data.Text.Fusion.Internal

108−import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, upperMapping)

109−import Data.Text.Fusion.Size

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(..))

110118

111119singleton :: Char -> Stream Char

112120singleton c = Stream next False 1

113121 where next False = Yield c True

114122 next True = Done

115−{-# INLINE singleton #-}

123+{-# INLINE [0] singleton #-}

116124

117125streamList :: [a] -> Stream a

118126{-# INLINE [0] streamList #-}

@@ -121,35 +129,68 @@ streamList s = Stream next s unknownSize

121129 next (x:xs) = Yield x xs

122130

123131unstreamList :: Stream a -> [a]

124−{-# INLINE [0] unstreamList #-}

125132unstreamList (Stream next s0 _len) = unfold s0

126133 where unfold !s = case next s of

127134 Done -> []

128135 Skip s' -> unfold s'

129136 Yield x s' -> x : unfold s'

137+{-# INLINE [0] unstreamList #-}

130138

131139{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}

132140

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+

133170-- ----------------------------------------------------------------------------

134171-- * Basic stream functions

135172

173+data C s = C0 !s

174+ | C1 !s

175+

136176-- | /O(n)/ Adds a character to the front of a Stream Char.

137177cons :: Char -> Stream Char -> Stream Char

138−cons w (Stream next0 s0 len) = Stream next (S2 :*: s0) (len+1)

178+cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

139179 where

140− {-# INLINE next #-}

141− next (S2 :*: s) = Yield w (S1 :*: s)

142− next (S1 :*: s) = case next0 s of

180+ next (C1 s) = Yield w (C0 s)

181+ next (C0 s) = case next0 s of

143182 Done -> Done

144− Skip s' -> Skip (S1 :*: s')

145− Yield x s' -> Yield x (S1 :*: s')

183+ Skip s' -> Skip (C0 s')

184+ Yield x s' -> Yield x (C0 s')

146185{-# INLINE [0] cons #-}

147186

187+data Snoc a = N

188+ | J !a

189+

148190-- | /O(n)/ Adds a character to the end of a stream.

149191snoc :: Stream Char -> Char -> Stream Char

150192snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)

151193 where

152− {-# INLINE next #-}

153194 next (J xs) = case next0 xs of

154195 Done -> Yield w N

155196 Skip xs' -> Skip (J xs')

@@ -157,20 +198,22 @@ snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)

157198 next N = Done

158199{-# INLINE [0] snoc #-}

159200

201+data E l r = L !l

202+ | R !r

203+

160204-- | /O(n)/ Appends one Stream to the other.

161205append :: Stream Char -> Stream Char -> Stream Char

162206append (Stream next0 s01 len1) (Stream next1 s02 len2) =

163− Stream next (Left s01) (len1 + len2)

207+ Stream next (L s01) (len1 + len2)

164208 where

165− {-# INLINE next #-}

166− next (Left s1) = case next0 s1 of

167− Done -> Skip (Right s02)

168− Skip s1' -> Skip (Left s1')

169− Yield x s1' -> Yield x (Left s1')

170− next (Right s2) = case next1 s2 of

209+ next (L s1) = case next0 s1 of

210+ Done -> Skip (R s02)

211+ Skip s1' -> Skip (L s1')

212+ Yield x s1' -> Yield x (L s1')

213+ next (R s2) = case next1 s2 of

171214 Done -> Done

172− Skip s2' -> Skip (Right s2')

173− Yield x s2' -> Yield x (Right s2')

215+ Skip s2' -> Skip (R s2')

216+ Yield x s2' -> Yield x (R s2')

174217{-# INLINE [0] append #-}

175218

176219-- | /O(1)/ Returns the first character of a Text, which must be non-empty.

@@ -180,10 +223,14 @@ head (Stream next s0 _len) = loop_head s0

180223 where

181224 loop_head !s = case next s of

182225 Yield x _ -> x

183− Skip s' -> loop_head s'

184− Done -> streamError "head" "Empty stream"

226+ Skip s' -> loop_head s'

227+ Done -> head_empty

185228{-# INLINE [0] head #-}

186229

230+head_empty :: a

231+head_empty = streamError "head" "Empty stream"

232+{-# NOINLINE head_empty #-}

233+

187234-- | /O(1)/ Returns the first character and remainder of a 'Stream

188235-- Char', or 'Nothing' if empty. Subject to array fusion.

189236uncons :: Stream Char -> Maybe (Char, Stream Char)

@@ -213,34 +260,34 @@ last (Stream next s0 _len) = loop0_last s0

213260-- | /O(1)/ Returns all characters after the head of a Stream Char, which must

214261-- be non-empty.

215262tail :: Stream Char -> Stream Char

216−tail (Stream next0 s0 len) = Stream next (False :*: s0) (len-1)

263+tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)

217264 where

218− {-# INLINE next #-}

219− next (False :*: s) = case next0 s of

220− Done -> emptyError "tail"

221− Skip s' -> Skip (False :*: s')

222− Yield _ s' -> Skip (True :*: s')

223− next (True :*: s) = case next0 s of

224− Done -> Done

225− Skip s' -> Skip (True :*: s')

226− Yield x s' -> Yield x (True :*: s')

265+ next (C0 s) = case next0 s of

266+ Done -> emptyError "tail"

267+ Skip s' -> Skip (C0 s')

268+ Yield _ s' -> Skip (C1 s')

269+ next (C1 s) = case next0 s of

270+ Done -> Done

271+ Skip s' -> Skip (C1 s')

272+ Yield x s' -> Yield x (C1 s')

227273{-# INLINE [0] tail #-}

228274

275+data Init s = Init0 !s

276+ | Init1 {-# UNPACK #-} !Char !s

229277

230278-- | /O(1)/ Returns all but the last character of a Stream Char, which

231279-- must be non-empty.

232280init :: Stream Char -> Stream Char

233−init (Stream next0 s0 len) = Stream next (N :*: s0) (len-1)

281+init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)

234282 where

235− {-# INLINE next #-}

236− next (N :*: s) = case next0 s of

283+ next (Init0 s) = case next0 s of

237284 Done -> emptyError "init"

238− Skip s' -> Skip (N :*: s')

239− Yield x s' -> Skip (J x :*: s')

240− next (J x :*: s) = case next0 s of

285+ Skip s' -> Skip (Init0 s')

286+ Yield x s' -> Skip (Init1 x s')

287+ next (Init1 x s) = case next0 s of

241288 Done -> Done

242− Skip s' -> Skip (J x :*: s')

243− Yield x' s' -> Yield x (J x' :*: s')

289+ Skip s' -> Skip (Init1 x s')

290+ Yield x' s' -> Yield x (Init1 x' s')

244291{-# INLINE [0] init #-}

245292

246293-- | /O(1)/ Tests whether a Stream Char is empty or not.

@@ -263,6 +310,26 @@ lengthI (Stream next s0 _len) = loop_length 0 s0

263310 Yield _ s' -> loop_length (z + 1) s'

264311{-# INLINE[0] lengthI #-}

265312

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+

266333-- | /O(n)/ Indicate whether a string contains exactly one element.

267334isSingleton :: Stream Char -> Bool

268335isSingleton (Stream next s0 _len) = loop 0 s0

@@ -283,7 +350,6 @@ isSingleton (Stream next s0 _len) = loop 0 s0

283350map :: (Char -> Char) -> Stream Char -> Stream Char

284351map f (Stream next0 s0 len) = Stream next s0 len

285352 where

286− {-# INLINE next #-}

287353 next !s = case next0 s of

288354 Done -> Done

289355 Skip s' -> Skip s'

@@ -295,22 +361,24 @@ map f (Stream next0 s0 len) = Stream next s0 len

295361 map f (map g s) = map (\x -> f (g x)) s

296362 #-}

297363

364+data I s = I1 !s

365+ | I2 !s {-# UNPACK #-} !Char

366+ | I3 !s

367+

298368-- | /O(n)/ Take a character and place it between each of the

299369-- characters of a 'Stream Char'.

300370intersperse :: Char -> Stream Char -> Stream Char

301−intersperse c (Stream next0 s0 len) = Stream next (s0 :*: N :*: S1) len

371+intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len

302372 where

303− {-# INLINE next #-}

304− next (s :*: N :*: S1) = case next0 s of

373+ next (I1 s) = case next0 s of

305374 Done -> Done

306− Skip s' -> Skip (s' :*: N :*: S1)

307− Yield x s' -> Skip (s' :*: J x :*: S1)

308− next (s :*: J x :*: S1) = Yield x (s :*: N :*: S2)

309− next (s :*: N :*: S2) = case next0 s of

375+ Skip s' -> Skip (I1 s')

376+ Yield x s' -> Skip (I2 s' x)

377+ next (I2 s x) = Yield x (I3 s)

378+ next (I3 s) = case next0 s of

310379 Done -> Done

311− Skip s' -> Skip (s' :*: N :*: S2)

312− Yield x s' -> Yield c (s' :*: J x :*: S1)

313− next _ = internalError "intersperse"

380+ Skip s' -> Skip (I3 s')

381+ Yield x s' -> Yield c (I2 s' x)

314382{-# INLINE [0] intersperse #-}

315383

316384-- ----------------------------------------------------------------------------

@@ -325,17 +393,16 @@ intersperse c (Stream next0 s0 len) = Stream next (s0 :*: N :*: S1) len

325393-- functions may map one input character to two or three output

326394-- characters.

327395

328−caseConvert :: (forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char)

396+caseConvert :: (forall s. Char -> s -> Step (CC s) Char)

329397 -> Stream Char -> Stream Char

330−caseConvert remap (Stream next0 s0 len) = Stream next (s0 :*: '\0' :*: '\0') len

398+caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len

331399 where

332− {-# INLINE next #-}

333− next (s :*: '\0' :*: _) =

400+ next (CC s '\0' _) =

334401 case next0 s of

335402 Done -> Done

336− Skip s' -> Skip (s' :*: '\0' :*: '\0')

403+ Skip s' -> Skip (CC s' '\0' '\0')

337404 Yield c s' -> remap c s'

338− next (s :*: a :*: b) = Yield a (s :*: b :*: '\0')

405+ next (CC s a b) = Yield a (CC s b '\0')

339406

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

341408-- useful for performing caseless (or case insensitive) string

@@ -372,17 +439,54 @@ toLower :: Stream Char -> Stream Char

372439toLower = caseConvert lowerMapping

373440{-# INLINE [0] toLower #-}

374441

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+

375479justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

376480justifyLeftI k c (Stream next0 s0 len) =

377− Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)

481+ Stream next (Just1 0 s0) (larger (fromIntegral k) len)

378482 where

379− next (s :*: S1 :*: n) =

483+ next (Just1 n s) =

380484 case next0 s of

381− Done -> next (s :*: S2 :*: n)

382− Skip s' -> Skip (s' :*: S1 :*: n)

383− Yield x s' -> Yield x (s' :*: S1 :*: n+1)

384− next (s :*: S2 :*: n)

385− | n < k = Yield c (s :*: S2 :*: n+1)

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)

386490 | otherwise = Done

387491 {-# INLINE next #-}

388492{-# INLINE [0] justifyLeftI #-}

@@ -480,14 +584,16 @@ intercalate s = concat . (L.intersperse s)

480584-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.

481585concat :: [Stream Char] -> Stream Char

482586concat = L.foldr append empty

587+{-# INLINE [0] concat #-}

483588

484589-- | Map a function over a stream that results in a stream and concatenate the

485590-- results.

486591concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char

487592concatMap f = foldr (append . f) empty

593+{-# INLINE [0] concatMap #-}

488594

489595-- | /O(n)/ any @p @xs determines if any character in the stream

490−-- @xs@ satisifes the predicate @p@.

596+-- @xs@ satisfies the predicate @p@.

491597any :: (Char -> Bool) -> Stream Char -> Bool

492598any p (Stream next0 s0 _len) = loop_any s0

493599 where

@@ -499,7 +605,7 @@ any p (Stream next0 s0 _len) = loop_any s0

499605{-# INLINE [0] any #-}

500606

501607-- | /O(n)/ all @p @xs determines if all characters in the 'Text'

502−-- @xs@ satisify the predicate @p@.

608+-- @xs@ satisfy the predicate @p@.

503609all :: (Char -> Bool) -> Stream Char -> Bool

504610all p (Stream next0 s0 _len) = loop_all s0

505611 where

@@ -548,63 +654,41 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0

548654-- * Building streams

549655

550656scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

551−scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low

657+scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low

552658 where

553659 {-# INLINE next #-}

554− next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)

555− next (S2 :*: z :*: s) = case next0 s of

556− Yield x s' -> let !x' = f z x

557− in Yield x' (S2 :*: x' :*: s')

558− Skip s' -> Skip (S2 :*: z :*: s')

559− Done -> Done

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

560666{-# INLINE [0] scanl #-}

561667

562−-- -----------------------------------------------------------------------------

563−-- ** Accumulating maps

564−

565−{-

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

567−-- function to each element of a stream, passing an accumulating

568−-- parameter from left to right, and returns a final stream.

569−--

570−-- /Note/: Unlike the version over lists, this function does not

571−-- return a final value for the accumulator, because the nature of

572−-- streams precludes it.

573−mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b

574−mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f

575− where

576− {-# INLINE next #-}

577− next (s :*: z) = case next0 s of

578− Yield x s' -> let (z',y) = f z x

579− in Yield y (s' :*: z')

580− Skip s' -> Skip (s' :*: z)

581− Done -> Done

582−{-# INLINE [0] mapAccumL #-}

583−-}

584−

585668-- -----------------------------------------------------------------------------

586669-- ** Generating and unfolding streams

587670

588671replicateCharI :: Integral a => a -> Char -> Stream Char

589−replicateCharI n c

672+replicateCharI !n !c

590673 | n < 0 = empty

591674 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low

592675 where

593− {-# INLINE next #-}

594− next i | i >= n = Done

595− | otherwise = Yield c (i + 1)

676+ next !i | i >= n = Done

677+ | otherwise = Yield c (i + 1)

596678{-# INLINE [0] replicateCharI #-}

597679

680+data RI s = RI !s {-# UNPACK #-} !Int64

681+

598682replicateI :: Int64 -> Stream Char -> Stream Char

599683replicateI n (Stream next0 s0 len) =

600− Stream next (0 :*: s0) (fromIntegral (max 0 n) * len)

684+ Stream next (RI s0 0) (fromIntegral (max 0 n) * len)

601685 where

602− next (k :*: s)

686+ next (RI s k)

603687 | k >= n = Done

604688 | otherwise = case next0 s of

605− Done -> Skip (k+1 :*: s0)

606− Skip s' -> Skip (k :*: s')

607− Yield x s' -> Yield x (k :*: s')

689+ Done -> Skip (RI s0 (k+1))

690+ Skip s' -> Skip (RI s' k)

691+ Yield x s' -> Yield x (RI s' k)

608692{-# INLINE [0] replicateI #-}

609693

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

@@ -655,24 +739,27 @@ take n0 (Stream next0 s0 len) =

655739 Yield x s' -> Yield x ((n-1) :*: s')

656740{-# INLINE [0] take #-}

657741

742+data Drop a s = NS !s

743+ | JS !a !s

744+

658745-- | /O(n)/ drop n, applied to a stream, returns the suffix of the

659−-- stream of length @n@, or the empty stream if @n@ is greater than the

660−-- length of the stream.

746+-- stream after the first @n@ characters, or the empty stream if @n@

747+-- is greater than the length of the stream.

661748drop :: Integral a => a -> Stream Char -> Stream Char

662749drop n0 (Stream next0 s0 len) =

663− Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))

750+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))

664751 where

665752 {-# INLINE next #-}

666− next (J n :*: s)

667− | n <= 0 = Skip (N :*: s)

753+ next (JS n s)

754+ | n <= 0 = Skip (NS s)

668755 | otherwise = case next0 s of

669756 Done -> Done

670− Skip s' -> Skip (J n :*: s')

671− Yield _ s' -> Skip (J (n-1) :*: s')

672− next (N :*: s) = case next0 s of

757+ Skip s' -> Skip (JS n s')

758+ Yield _ s' -> Skip (JS (n-1) s')

759+ next (NS s) = case next0 s of

673760 Done -> Done

674− Skip s' -> Skip (N :*: s')

675− Yield x s' -> Yield x (N :*: s')

761+ Skip s' -> Skip (NS s')

762+ Yield x s' -> Yield x (NS s')

676763{-# INLINE [0] drop #-}

677764

678765-- | takeWhile, applied to a predicate @p@ and a stream, returns the

@@ -690,18 +777,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

690777

691778-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

692779dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

693−dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high

780+dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high

694781 where

695782 {-# INLINE next #-}

696− next (S1 :*: s) = case next0 s of

783+ next (L s) = case next0 s of

697784 Done -> Done

698− Skip s' -> Skip (S1 :*: s')

699− Yield x s' | p x -> Skip (S1 :*: s')

700− | otherwise -> Yield x (S2 :*: s')

701− next (S2 :*: s) = case next0 s of

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

702789 Done -> Done

703− Skip s' -> Skip (S2 :*: s')

704− Yield x s' -> Yield x (S2 :*: s')

790+ Skip s' -> Skip (R s')

791+ Yield x s' -> Yield x (R s')

705792{-# INLINE [0] dropWhile #-}

706793

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

@@ -717,7 +804,6 @@ isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

717804 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

718805 loop (next1 s1') (next2 s2')

719806{-# INLINE [0] isPrefixOf #-}

720−{-# SPECIALISE isPrefixOf :: Stream Char -> Stream Char -> Bool #-}

721807

722808-- ----------------------------------------------------------------------------

723809-- * Searching

@@ -772,7 +858,6 @@ indexI (Stream next s0 _len) n0

772858filter :: (Char -> Bool) -> Stream Char -> Stream Char

773859filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

774860 where

775− {-# INLINE next #-}

776861 next !s = case next0 s of

777862 Done -> Done

778863 Skip s' -> Skip s'

@@ -781,7 +866,7 @@ filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

781866{-# INLINE [0] filter #-}

782867

783868{-# RULES

784− "Stream filter/filter fusion" forall p q s.

869+ "STREAM filter/filter fusion" forall p q s.

785870 filter p (filter q s) = filter (\x -> q x && p x) s

786871 #-}

787872

@@ -810,22 +895,25 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0

810895-------------------------------------------------------------------------------

811896-- * Zipping

812897

898+-- | Strict triple.

899+data Zip a b m = Z1 !a !b

900+ | Z2 !a !b !m

901+

813902-- | zipWith generalises 'zip' by zipping with the function given as

814903-- the first argument, instead of a tupling function.

815904zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b

816905zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =

817− Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)

906+ Stream next (Z1 sa0 sb0) (smaller len1 len2)

818907 where

819− {-# INLINE next #-}

820− next (sa :*: sb :*: N) = case next0 sa of

821− Done -> Done

822− Skip sa' -> Skip (sa' :*: sb :*: N)

823− Yield a sa' -> Skip (sa' :*: sb :*: J a)

824−

825− next (sa' :*: sb :*: J a) = case next1 sb of

826− Done -> Done

827− Skip sb' -> Skip (sa' :*: sb' :*: J a)

828− Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)

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

829917{-# INLINE [0] zipWith #-}

830918

831919-- | /O(n)/ The 'countCharI' function returns the number of times the

@@ -841,7 +929,7 @@ countCharI a (Stream next s0 _len) = loop 0 s0

841929{-# INLINE [0] countCharI #-}

842930

843931streamError :: String -> String -> a

844−streamError func msg = P.error $ "Data.Text.Fusion.Common." ++ func ++ ": " ++ msg

932+streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg

845933

846934emptyError :: String -> a

847935emptyError func = internalError func "Empty input"

Data/Text/Internal/Fusion/Size.hsnew file+157

@@ -0,0 +1,157 @@

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/Fusion/Internal.hs → Data/Text/Internal/Fusion/Types.hsrenamed+31−25

@@ -1,58 +1,66 @@

11{-# LANGUAGE BangPatterns, ExistentialQuantification #-}

22-- |

3−-- Module : Data.Text.Fusion.Internal

3+-- Module : Data.Text.Internal.Fusion.Types

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

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

6−-- (c) Duncan Coutts 2009

6+-- (c) Duncan Coutts 2009,

7+-- (c) Jasper Van der Jeugt 2011

78--

89-- License : BSD-style

9−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

10−-- duncan@haskell.org

10+-- Maintainer : bos@serpentine.com

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

1418-- Core stream fusion functionality for text.

1519

16−module Data.Text.Fusion.Internal

20+module Data.Text.Internal.Fusion.Types

1721 (

18− M(..)

19− , M8

22+ CC(..)

2023 , PairS(..)

21− , S(..)

24+ , Scan(..)

25+ , RS(..)

2226 , Step(..)

2327 , Stream(..)

24− , Switch(..)

2528 , empty

2629 ) where

2730

28−import Data.Text.Fusion.Size

31+import Data.Text.Internal.Fusion.Size

2932import Data.Word (Word8)

3033

31−-- | Specialised, strict Maybe-like type.

32−data M a = N

33− | J {-# UNPACK #-} !a

34−

35−type M8 = M Word8

34+-- | Specialised tuple for case conversion.

35+data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

3636

37−-- Restreaming state.

38−data S s = S {-# UNPACK #-} !s

39− {-# UNPACK #-} !M8 {-# UNPACK #-} !M8 {-# UNPACK #-} !M8

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

4043

44+-- | Strict pair.

45+data PairS a b = !a :*: !b

46+ -- deriving (Eq, Ord, Show)

4147infixl 2 :*:

42−data PairS a b = {-# UNPACK #-} !a :*: {-# UNPACK #-} !b

43− deriving (Eq, Ord, Show)

4448

45−-- | Allow a function over a stream to switch between two states.

46−data Switch = S1 | S2

49+-- | An intermediate result in a scan.

50+data Scan s = Scan1 {-# UNPACK #-} !Char !s

51+ | Scan2 {-# UNPACK #-} !Char !s

4752

53+-- | Intermediate result in a processing pipeline.

4854data Step s a = Done

4955 | Skip !s

5056 | Yield !a !s

5157

58+{-

5259instance (Show a) => Show (Step s a)

5360 where show Done = "Done"

5461 show (Skip _) = "Skip"

5562 show (Yield x _) = "Yield " ++ show x

63+-}

5664

5765instance (Eq a) => Eq (Stream a) where

5866 (==) = eq

@@ -76,7 +84,7 @@ data Stream a =

7684 forall s. Stream

7785 (s -> Step s a) -- stepper function

7886 !s -- current state

79− {-# UNPACK #-} !Size -- size hint

87+ !Size -- size hint

8088

8189-- | /O(n)/ Determines if two streams are equal.

8290eq :: (Eq a) => Stream a -> Stream a -> Bool

@@ -91,7 +99,6 @@ eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

9199 loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&

92100 loop (next1 s1') (next2 s2')

93101{-# INLINE [0] eq #-}

94−{-# SPECIALISE eq :: Stream Char -> Stream Char -> Bool #-}

95102

96103cmp :: (Ord a) => Stream a -> Stream a -> Ordering

97104cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

@@ -107,7 +114,6 @@ cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)

107114 EQ -> loop (next1 s1') (next2 s2')

108115 other -> other

109116{-# INLINE [0] cmp #-}

110−{-# SPECIALISE cmp :: Stream Char -> Stream Char -> Ordering #-}

111117

112118-- | The empty stream.

113119empty :: Stream a

Data/Text/Internal/IO.hsnew file+166

@@ -0,0 +1,166 @@

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

2+-- |

3+-- Module : Data.Text.Internal.IO

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+-- Low-level support for text I\/O.

16+

17+module Data.Text.Internal.IO

18+ (

19+ hGetLineWith

20+ , readChunk

21+ ) where

22+

23+import qualified Control.Exception as E

24+import Data.IORef (readIORef, writeIORef)

25+import 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)

29+import Data.Text.Unsafe (inlinePerformIO)

30+import Foreign.Storable (peekElemOff)

31+import GHC.IO.Buffer (Buffer(..), CharBuffer, RawCharBuffer, bufferAdjustL,

32+ bufferElems, charSize, isEmptyBuffer, readCharBuf,

33+ withRawBuffer, writeCharBuf)

34+import GHC.IO.Handle.Internals (ioe_EOF, readTextDevice, wantReadableHandle_)

35+import GHC.IO.Handle.Types (Handle__(..), Newline(..))

36+import System.IO (Handle)

37+import System.IO.Error (isEOFError)

38+import qualified Data.Text as T

39+

40+-- | Read a single line of input from a handle, constructing a list of

41+-- decoded chunks as we go. When we're done, transform them into the

42+-- destination type.

43+hGetLineWith :: ([Text] -> t) -> Handle -> IO t

44+hGetLineWith f h = wantReadableHandle_ "hGetLine" h go

45+ where

46+ go hh@Handle__{..} = readIORef haCharBuffer >>= fmap f . hGetLineLoop hh []

47+

48+hGetLineLoop :: Handle__ -> [Text] -> CharBuffer -> IO [Text]

49+hGetLineLoop hh@Handle__{..} = go where

50+ go ts buf@Buffer{ bufL=r0, bufR=w, bufRaw=raw0 } = do

51+ let findEOL raw r | r == w = return (False, w)

52+ | otherwise = do

53+ (c,r') <- readCharBuf raw r

54+ if c == '\n'

55+ then return (True, r)

56+ else findEOL raw r'

57+ (eol, off) <- findEOL raw0 r0

58+ (t,r') <- if haInputNL == CRLF

59+ then unpack_nl raw0 r0 off

60+ else do t <- unpack raw0 r0 off

61+ return (t,off)

62+ if eol

63+ then do writeIORef haCharBuffer (bufferAdjustL (off+1) buf)

64+ return $ reverse (t:ts)

65+ else do

66+ let buf1 = bufferAdjustL r' buf

67+ maybe_buf <- maybeFillReadBuffer hh buf1

68+ case maybe_buf of

69+ -- Nothing indicates we caught an EOF, and we may have a

70+ -- partial line to return.

71+ Nothing -> do

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

73+ -- in the buffer, so check for that and

74+ -- append it to the line if necessary.

75+ let pre | isEmptyBuffer buf1 = T.empty

76+ | otherwise = T.singleton '\r'

77+ writeIORef haCharBuffer buf1{ bufL=0, bufR=0 }

78+ let str = reverse . filter (not . T.null) $ pre:t:ts

79+ if null str

80+ then ioe_EOF

81+ else return str

82+ Just new_buf -> go (t:ts) new_buf

83+

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

85+maybeFillReadBuffer :: Handle__ -> CharBuffer -> IO (Maybe CharBuffer)

86+maybeFillReadBuffer handle_ buf

87+ = E.catch (Just `fmap` getSomeCharacters handle_ buf) $ \e ->

88+ if isEOFError e

89+ then return Nothing

90+ else ioError e

91+

92+unpack :: RawCharBuffer -> Int -> Int -> IO Text

93+unpack !buf !r !w

94+ | charSize /= 4 = sizeError "unpack"

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

96+ | otherwise = withRawBuffer buf go

97+ where

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

99+ where

100+ next !i | i >= w = Done

101+ | otherwise = Yield (ix i) (i+1)

102+ ix i = inlinePerformIO $ peekElemOff pbuf i

103+

104+unpack_nl :: RawCharBuffer -> Int -> Int -> IO (Text, Int)

105+unpack_nl !buf !r !w

106+ | charSize /= 4 = sizeError "unpack_nl"

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

108+ | otherwise = withRawBuffer buf $ go

109+ where

110+ go pbuf = do

111+ let !t = unstream (Stream next r (maxSize (w-r)))

112+ w' = w - 1

113+ return $ if ix w' == '\r'

114+ then (t,w')

115+ else (t,w)

116+ where

117+ next !i | i >= w = Done

118+ | c == '\r' = let i' = i + 1

119+ in if i' < w

120+ then if ix i' == '\n'

121+ then Yield '\n' (i+2)

122+ else Yield '\n' i'

123+ else Done

124+ | otherwise = Yield c (i+1)

125+ where c = ix i

126+ ix i = inlinePerformIO $ peekElemOff pbuf i

127+

128+-- This function is completely lifted from GHC.IO.Handle.Text.

129+getSomeCharacters :: Handle__ -> CharBuffer -> IO CharBuffer

130+getSomeCharacters handle_@Handle__{..} buf@Buffer{..} =

131+ case bufferElems buf of

132+ -- buffer empty: read some more

133+ 0 -> {-# SCC "readTextDevice" #-} readTextDevice handle_ buf

134+

135+ -- if the buffer has a single '\r' in it and we're doing newline

136+ -- translation: read some more

137+ 1 | haInputNL == CRLF -> do

138+ (c,_) <- readCharBuf bufRaw bufL

139+ if c == '\r'

140+ then do -- shuffle the '\r' to the beginning. This is only safe

141+ -- if we're about to call readTextDevice, otherwise it

142+ -- would mess up flushCharBuffer.

143+ -- See [note Buffer Flushing], GHC.IO.Handle.Types

144+ _ <- writeCharBuf bufRaw 0 '\r'

145+ let buf' = buf{ bufL=0, bufR=1 }

146+ readTextDevice handle_ buf'

147+ else do

148+ return buf

149+

150+ -- buffer has some chars in it already: just return it

151+ _otherwise -> {-# SCC "otherwise" #-} return buf

152+

153+-- | Read a single chunk of strict text from a buffer. Used by both

154+-- the strict and lazy implementations of hGetContents.

155+readChunk :: Handle__ -> CharBuffer -> IO Text

156+readChunk hh@Handle__{..} buf = do

157+ buf'@Buffer{..} <- getSomeCharacters hh buf

158+ (t,r) <- if haInputNL == CRLF

159+ then unpack_nl bufRaw bufL bufR

160+ else do t <- unpack bufRaw bufL bufR

161+ return (t,bufR)

162+ writeIORef haCharBuffer (bufferAdjustL r buf')

163+ return t

164+

165+sizeError :: String -> a

166+sizeError loc = error $ "Data.Text.IO." ++ loc ++ ": bad internal buffer size"

Data/Text/Internal/Lazy.hsnew file+119

@@ -0,0 +1,119 @@

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.hsnew file+324

@@ -0,0 +1,324 @@

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.hsnew file+120

@@ -0,0 +1,120 @@

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/Lazy/Search.hs → Data/Text/Internal/Lazy/Search.hsrenamed+36−26

@@ -2,19 +2,22 @@

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, rtharper@aftereternity.co.uk,

9−-- duncan@haskell.org

8+-- Maintainer : bos@serpentine.com

109-- Stability : experimental

1110-- Portability : GHC

1211--

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

1316-- Fast substring search for lazy 'Text', based on work by Boyer,

1417-- Moore, Horspool, Sunday, and Lundh. Adapted from the strict

1518-- implementation.

1619

17−module Data.Text.Lazy.Search

20+module Data.Text.Internal.Lazy.Search

1821 (

1922 indices

2023 ) where

@@ -23,11 +26,10 @@ import qualified Data.Text.Array as A

2326import Data.Int (Int64)

2427import Data.Word (Word16, Word64)

2528import qualified Data.Text.Internal as T

26−import qualified Data.Text as T

27−import Data.Text.Fusion.Internal (PairS(..))

28−import Data.Text.Lazy.Internal (Text(..), foldlChunks)

29+import Data.Text.Internal.Fusion.Types (PairS(..))

30+import Data.Text.Internal.Lazy (Text(..), foldlChunks)

2931import Data.Bits ((.|.), (.&.))

30−import Data.Text.UnsafeShift (shiftL)

32+import Data.Text.Internal.Unsafe.Shift (shiftL)

3133

3234-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

3335-- @needle@ within @haystack@.

@@ -42,16 +44,18 @@ indices :: Text -- ^ Substring to search for (@needle@)

4244 -> [Int64]

4345indices needle@(Chunk n ns) _haystack@(Chunk k ks)

4446 | nlen <= 0 = []

45− | nlen == 1 = scanOne (nindex 0) 0 k ks

46− | otherwise = scan 0 0 k ks

47+ | nlen == 1 = indicesOne (nindex 0) 0 k ks

48+ | otherwise = advance k ks 0 0

4749 where

48− scan !g !i x@(T.Text _ _ l) xs

50+ advance x@(T.Text _ _ l) xs = scan

51+ where

52+ scan !g !i

4953 | i >= m = case xs of

5054 Empty -> []

51− Chunk y ys -> scan g (i-m) y ys

55+ Chunk y ys -> advance y ys g (i-m)

5256 | lackingHay (i + nlen) x xs = []

53− | c == z && candidateMatch 0 = g : scan (g+nlen) (i+nlen) x xs

54− | otherwise = scan (g+delta) (i+delta) x xs

57+ | c == z && candidateMatch 0 = g : scan (g+nlen) (i+nlen)

58+ | otherwise = scan (g+delta) (i+delta)

5559 where

5660 m = fromIntegral l

5761 c = hindex (i + nlast)

@@ -76,20 +80,13 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)

7680 go !(g::Int64) !i !msk !skp

7781 | i >= xlast = case xs of

7882 Empty -> (msk .|. swizzle z) :*: skp

79− Chunk y ys -> buildTable y ys g 0 msk skp

80− | otherwise = go (g+1) (i+1) (msk .|. swizzle c) skp'

83+ Chunk y ys -> buildTable y ys g 0 msk' skp'

84+ | otherwise = go (g+1) (i+1) msk' skp'

8185 where c = A.unsafeIndex xarr (xoff+i)

82− skp' | c == z = nlen - fromIntegral g - 2

86+ msk' = msk .|. swizzle c

87+ skp' | c == z = nlen - g - 2

8388 | otherwise = skp

8489 xlast = xlen - 1

85− scanOne c i (T.Text oarr ooff olen) os = go 0

86− where

87− go h | h >= olen = case os of

88− Empty -> []

89− Chunk y ys -> scanOne c (i+fromIntegral olen) y ys

90− | on == c = i + fromIntegral h : go (h+1)

91− | otherwise = go (h+1)

92− where on = A.unsafeIndex oarr (ooff+h)

9390 -- | Check whether an attempt to index into the haystack at the

9491 -- given offset would fail.

9592 lackingHay q = go 0

@@ -104,7 +101,7 @@ indices _ _ = []

104101-- the possibility that the caller might try to access one element

105102-- past the end.

106103index :: T.Text -> Text -> Int64 -> Word16

107−index (T.Text arr off len) xs i

104+index (T.Text arr off len) xs !i

108105 | j < len = A.unsafeIndex arr (off+j)

109106 | otherwise = case xs of

110107 Empty

@@ -115,6 +112,19 @@ index (T.Text arr off len) xs i

115112 Chunk c cs -> index c cs (i-fromIntegral len)

116113 where j = fromIntegral i

117114

115+-- | A variant of 'indices' that scans linearly for a single 'Word16'.

116+indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]

117+indicesOne c = chunk

118+ where

119+ chunk !i (T.Text oarr ooff olen) os = go 0

120+ where

121+ go h | h >= olen = case os of

122+ Empty -> []

123+ Chunk y ys -> chunk (i+fromIntegral olen) y ys

124+ | on == c = i + fromIntegral h : go (h+1)

125+ | otherwise = go (h+1)

126+ where on = A.unsafeIndex oarr (ooff+h)

127+

118128-- | The number of 'Word16' values in a 'Text'.

119129wordLength :: Text -> Int64

120130wordLength = foldlChunks sumLength 0

Data/Text/Internal/Private.hsnew file+37

@@ -0,0 +1,37 @@

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.hsnew file+62

@@ -0,0 +1,62 @@

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/Search.hs → Data/Text/Internal/Search.hsrenamed+15−11

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

11{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}

22

33-- |

4−-- Module : Data.Text.Search

4+-- Module : Data.Text.Internal.Search

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

66--

77-- License : BSD-style

8−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

9−-- duncan@haskell.org

8+-- Maintainer : bos@serpentine.com

109-- Stability : experimental

1110-- Portability : GHC

1211--

@@ -14,7 +13,7 @@

1413-- Horspool, Sunday, and Lundh.

1514--

1615-- References:

17−--

16+--

1817-- * R. S. Boyer, J. S. Moore: A Fast String Searching Algorithm.

1918-- Communications of the ACM, 20, 10, 762-772 (1977)

2019--

@@ -27,7 +26,7 @@

2726-- * F. Lundh: The Fast Search Algorithm.

2827-- <http://effbot.org/zone/stringlib.htm> (2006)

2928

30−module Data.Text.Search

29+module Data.Text.Internal.Search

3130 (

3231 indices

3332 ) where

@@ -35,12 +34,15 @@ module Data.Text.Search

3534import qualified Data.Text.Array as A

3635import Data.Word (Word64)

3736import Data.Text.Internal (Text(..))

38−import Data.Text.Fusion.Internal (PairS(..))

3937import Data.Bits ((.|.), (.&.))

40−import Data.Text.UnsafeShift (shiftL)

38+import Data.Text.Internal.Unsafe.Shift (shiftL)

39+

40+data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int

4141

4242-- | /O(n+m)/ Find the offsets of all non-overlapping indices of

43−-- @needle@ within @haystack@.

43+-- @needle@ within @haystack@. The offsets returned represent

44+-- uncorrected indices in the low-level \"needle\" array, to which its

45+-- offset must be added.

4446--

4547-- In (unlikely) bad cases, this algorithm's complexity degrades

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

@@ -57,9 +59,10 @@ indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)

5759 z = nindex nlast

5860 nindex k = A.unsafeIndex narr (noff+k)

5961 hindex k = A.unsafeIndex harr (hoff+k)

60− (mask :: Word64) :*: skip = buildTable 0 0 (nlen-2)

62+ hindex' k | k == hlen = 0

63+ | otherwise = A.unsafeIndex harr (hoff+k)

6164 buildTable !i !msk !skp

62− | i >= nlast = (msk .|. swizzle z) :*: skp

65+ | i >= nlast = (msk .|. swizzle z) :* skp

6366 | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'

6467 where c = nindex i

6568 skp' | c == z = nlen - i - 2

@@ -77,7 +80,8 @@ indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)

7780 delta | nextInPattern = nlen + 1

7881 | c == z = skip + 1

7982 | otherwise = 1

80− nextInPattern = mask .&. swizzle (hindex (i+nlen)) == 0

83+ where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0

84+ !(mask :* skip) = buildTable 0 0 (nlen-2)

8185 scanOne c = loop 0

8286 where loop !i | i >= hlen = []

8387 | hindex i == c = i : loop (i+1)

Data/Text/Internal/Unsafe.hsnew file+56

@@ -0,0 +1,56 @@

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/UnsafeChar.hs → Data/Text/Internal/Unsafe/Char.hsrenamed+34−19

@@ -1,36 +1,45 @@

1−{-# LANGUAGE MagicHash #-}

1+{-# LANGUAGE CPP, MagicHash #-}

22

33-- |

4−-- Module : Data.Text.UnsafeChar

5−-- Copyright : (c) Tom Harper 2008-2009,

6−-- (c) Bryan O'Sullivan 2009,

7−-- (c) Duncan Coutts 2009

4+-- Module : Data.Text.Internal.Unsafe.Char

88--

99-- License : BSD-style

10−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

11−-- duncan@haskell.org

10+-- Maintainer : bos@serpentine.com

1211-- Stability : experimental

1312-- Portability : GHC

1413--

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

1518-- Fast character manipulation functions.

16−module Data.Text.UnsafeChar

19+module Data.Text.Internal.Unsafe.Char

1720 (

18− unsafeChr

21+ ord

22+ , unsafeChr

1923 , unsafeChr8

2024 , unsafeChr32

2125 , unsafeWrite

2226 -- , unsafeWriteRev

2327 ) where

2428

29+#ifdef ASSERTS

2530import Control.Exception (assert)

31+#endif

2632import Control.Monad.ST (ST)

2733import Data.Bits ((.&.))

28−import Data.Char (ord)

29−import Data.Text.UnsafeShift (shiftR)

30−import GHC.Exts (Char(..), chr#, word2Int#)

34+import Data.Text.Internal.Unsafe.Shift (shiftR)

35+import GHC.Exts (Char(..), Int(..), chr#, ord#, word2Int#)

3136import GHC.Word (Word8(..), Word16(..), Word32(..))

3237import qualified Data.Text.Array as A

3338

39+ord :: Char -> Int

40+ord (C# c#) = I# (ord# c#)

41+{-# INLINE ord #-}

42+

3443unsafeChr :: Word16 -> Char

3544unsafeChr (W16# w#) = C# (chr# (word2Int# w#))

3645{-# INLINE unsafeChr #-}

@@ -43,17 +52,23 @@ unsafeChr32 :: Word32 -> Char

4352unsafeChr32 (W32# w#) = C# (chr# (word2Int# w#))

4453{-# INLINE unsafeChr32 #-}

4554

46−unsafeWrite :: A.MArray s Word16 -> Int -> Char -> ST s Int

55+-- | Write a character into the array at the given offset. Returns

56+-- the number of 'Word16's written.

57+unsafeWrite :: A.MArray s -> Int -> Char -> ST s Int

4758unsafeWrite marr i c

4859 | n < 0x10000 = do

49− assert (i >= 0) . assert (i < A.length marr) $

50− A.unsafeWrite marr i (fromIntegral n)

51− return (i+1)

60+#if defined(ASSERTS)

61+ assert (i >= 0) . assert (i < A.length marr) $ return ()

62+#endif

63+ A.unsafeWrite marr i (fromIntegral n)

64+ return 1

5265 | otherwise = do

53− assert (i >= 0) . assert (i < A.length marr - 1) $

54− A.unsafeWrite marr i lo

66+#if defined(ASSERTS)

67+ assert (i >= 0) . assert (i < A.length marr - 1) $ return ()

68+#endif

69+ A.unsafeWrite marr i lo

5570 A.unsafeWrite marr (i+1) hi

56− return (i+2)

71+ return 2

5772 where n = ord c

5873 m = n - 0x10000

5974 lo = fromIntegral $ (m `shiftR` 10) + 0xD800

Data/Text/UnsafeShift.hs → Data/Text/Internal/Unsafe/Shift.hsrenamed+7−4

@@ -1,18 +1,21 @@

11{-# LANGUAGE MagicHash #-}

22

33-- |

4−-- Module : Data.Text.UnsafeShift

4+-- Module : Data.Text.Internal.Unsafe.Shift

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

66--

77-- License : BSD-style

8−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

9−-- duncan@haskell.org

8+-- Maintainer : bos@serpentine.com

109-- Stability : experimental

1110-- Portability : GHC

1211--

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

1316-- Fast, unchecked bit shifting functions.

1417

15−module Data.Text.UnsafeShift

18+module Data.Text.Internal.Unsafe.Shift

1619 (

1720 UnsafeShift(..)

1821 ) where

Data/Text/Lazy.hs+723−222

@@ -1,37 +1,56 @@

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

2−{-# LANGUAGE BangPatterns #-}

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+

310-- |

411-- Module : Data.Text.Lazy

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

613--

714-- License : BSD-style

8−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

9−-- duncan@haskell.org

15+-- Maintainer : bos@serpentine.com

1016-- Stability : experimental

1117-- Portability : GHC

1218--

1319-- A time and space-efficient implementation of Unicode text using

14−-- lists of packed arrays. This representation is suitable for high

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

1526-- performance use and for streaming large quantities of data. It

1627-- provides a means to manipulate a large body of text without

1728-- requiring that the entire content be resident in memory.

1829--

1930-- Some operations, such as 'concat', 'append', 'reverse' and 'cons',

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.

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.

2637--

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

2839-- clashes with "Prelude" functions. eg.

2940--

30−-- > import qualified Data.Text.Lazy as B

41+-- > import qualified Data.Text.Lazy as L

3142

3243module Data.Text.Lazy

3344 (

45+ -- * Fusion

46+ -- $fusion

47+

48+ -- * Acceptable data

49+ -- $replacement

50+

51+ -- * Types

3452 Text

53+

3554 -- * Creation and elimination

3655 , pack

3756 , unpack

@@ -39,6 +58,10 @@ module Data.Text.Lazy

3958 , empty

4059 , fromChunks

4160 , toChunks

61+ , toStrict

62+ , fromStrict

63+ , foldrChunks

64+ , foldlChunks

4265

4366 -- * Basic interface

4467 , cons

@@ -51,6 +74,7 @@ module Data.Text.Lazy

5174 , init

5275 , null

5376 , length

77+ , compareLength

5478

5579 -- * Transformations

5680 , map

@@ -65,6 +89,7 @@ module Data.Text.Lazy

6589 , toCaseFold

6690 , toLower

6791 , toUpper

92+ , toTitle

6893

6994 -- ** Justification

7095 , justifyLeft

@@ -100,7 +125,10 @@ module Data.Text.Lazy

100125 , mapAccumR

101126

102127 -- ** Generation and unfolding

128+ , repeat

103129 , replicate

130+ , cycle

131+ , iterate

104132 , unfoldr

105133 , unfoldrN

106134

@@ -108,8 +136,11 @@ module Data.Text.Lazy

108136

109137 -- ** Breaking strings

110138 , take

139+ , takeEnd

111140 , drop

141+ , dropEnd

112142 , takeWhile

143+ , takeWhileEnd

113144 , dropWhile

114145 , dropWhileEnd

115146 , dropAround

@@ -117,9 +148,10 @@ module Data.Text.Lazy

117148 , stripStart

118149 , stripEnd

119150 , splitAt

120− , spanBy

151+ , span

152+ , breakOn

153+ , breakOnEnd

121154 , break

122− , breakBy

123155 , group

124156 , groupBy

125157 , inits

@@ -127,8 +159,8 @@ module Data.Text.Lazy

127159

128160 -- ** Breaking into many substrings

129161 -- $split

162+ , splitOn

130163 , split

131− , splitBy

132164 , chunksOf

133165 -- , breakSubstring

134166

@@ -143,14 +175,19 @@ module Data.Text.Lazy

143175 , isSuffixOf

144176 , isInfixOf

145177

178+ -- ** View patterns

179+ , stripPrefix

180+ , stripSuffix

181+ , commonPrefixes

182+

146183 -- * Searching

147184 , filter

148185 , find

149− , findBy

150− , partitionBy

186+ , breakOnAll

187+ , partition

151188

152189 -- , findSubstring

153−

190+

154191 -- * Indexing

155192 , index

156193 , count

@@ -163,34 +200,140 @@ module Data.Text.Lazy

163200 -- , sort

164201 ) where

165202

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

167− Eq(..), Ord(..), Read(..), Show(..),

168− (&&), (+), (-), (.), ($), (++),

169− div, flip, fromIntegral, not, otherwise)

203+import Prelude (Char, Bool(..), Maybe(..), String,

204+ Eq(..), Ord(..), Ordering(..), Read(..), Show(..),

205+ (&&), (||), (+), (-), (.), ($), (++),

206+ error, flip, fmap, fromIntegral, not, otherwise, quot)

170207import qualified Prelude as P

208+#if defined(HAVE_DEEPSEQ)

209+import Control.DeepSeq (NFData(..))

210+#endif

171211import Data.Int (Int64)

172212import qualified Data.List as L

173213import 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))

174217import Data.Monoid (Monoid(..))

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

219+import Data.Semigroup (Semigroup(..))

220+#endif

175221import Data.String (IsString(..))

176222import qualified Data.Text as T

177223import qualified Data.Text.Internal as T

178−import qualified Data.Text.Fusion.Common as S

224+import qualified Data.Text.Internal.Fusion.Common as S

179225import qualified Data.Text.Unsafe as T

180−import qualified Data.Text.Lazy.Fusion as S

181−import Data.Text.Fusion.Internal (PairS(..))

182−import Data.Text.Lazy.Fusion (stream, unstream)

183−import Data.Text.Lazy.Internal (Text(..), chunk, empty, foldlChunks, foldrChunks)

184−import Data.Text.Internal (textP)

185−import Data.Text.Lazy.Search (indices)

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

186313

187314instance Eq Text where

188− t1 == t2 = stream t1 == stream t2

315+ (==) = equal

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

190317

191318instance Ord Text where

192− compare t1 t2 = compare (stream t1) (stream t2)

193− {-# INLINE compare #-}

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

194337

195338instance Show Text where

196339 showsPrec p ps r = showsPrec p (unpack ps) r

@@ -198,27 +341,108 @@ instance Show Text where

198341instance Read Text where

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

200343

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+

201352instance Monoid Text where

202353 mempty = empty

354+#if MIN_VERSION_base(4,9,0)

355+ mappend = (<>) -- future-proof definition

356+#else

203357 mappend = append

358+#endif

204359 mconcat = concat

205360

206361instance IsString Text where

207362 fromString = pack

208363

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+

371+#if defined(HAVE_DEEPSEQ)

372+instance NFData Text where

373+ rnf Empty = ()

374+ rnf (Chunk _ ts) = rnf ts

375+#endif

376+

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'

390+instance Data Text where

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

402+#endif

403+

404+packConstr :: Constr

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

406+

407+textDataType :: DataType

408+textDataType = mkDataType "Data.Text.Lazy.Text" [packConstr]

409+

209410-- | /O(n)/ Convert a 'String' into a 'Text'.

210411--

211−-- This function is subject to array fusion.

412+-- Subject to fusion. Performs replacement on invalid scalar values.

212413pack :: String -> Text

213−pack s = unstream (S.streamList s)

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

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

215416

216417-- | /O(n)/ Convert a 'Text' into a 'String'.

217−-- Subject to array fusion.

418+-- Subject to fusion.

218419unpack :: Text -> String

219420unpack t = S.unstreamList (stream t)

220421{-# INLINE [1] unpack #-}

221422

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.

222446singleton :: Char -> Text

223447singleton c = Chunk (T.singleton c) Empty

224448{-# INLINE [1] singleton #-}

@@ -238,10 +462,28 @@ fromChunks cs = L.foldr chunk Empty cs

238462toChunks :: Text -> [T.Text]

239463toChunks cs = foldrChunks (:) [] cs

240464

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.

241481cons :: Char -> Text -> Text

242482cons c t = Chunk (T.singleton c) t

243483{-# INLINE [1] cons #-}

244484

485+infixr 5 `cons`

486+

245487{-# RULES

246488"LAZY TEXT cons -> fused" [~1] forall c t.

247489 cons c t = unstream (S.cons c (stream t))

@@ -249,6 +491,8 @@ cons c t = Chunk (T.singleton c) t

249491 unstream (S.cons c (stream t)) = cons c t

250492 #-}

251493

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.

252496snoc :: Text -> Char -> Text

253497snoc t c = foldrChunks Chunk (singleton c) t

254498{-# INLINE [1] snoc #-}

@@ -260,8 +504,7 @@ snoc t c = foldrChunks Chunk (singleton c) t

260504 unstream (S.snoc (stream t) c) = snoc t c

261505 #-}

262506

263−-- | /O(n\/c)/ Appends one 'Text' to another. Subject to array

264−-- fusion.

507+-- | /O(n\/c)/ Appends one 'Text' to another. Subject to fusion.

265508append :: Text -> Text -> Text

266509append xs ys = foldrChunks Chunk ys xs

267510{-# INLINE [1] append #-}

@@ -274,22 +517,22 @@ append xs ys = foldrChunks Chunk ys xs

274517 #-}

275518

276519-- | /O(1)/ Returns the first character and rest of a 'Text', or

277−-- 'Nothing' if empty. Subject to array fusion.

520+-- 'Nothing' if empty. Subject to fusion.

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

279−uncons Empty = Nothing

280−uncons (Chunk t ts) =

281− Just (T.unsafeHead t,

282− if T.length t == 1 then ts else Chunk (T.unsafeTail t) ts)

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

283526{-# INLINE uncons #-}

284527

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

286−-- non-empty. Subject to array fusion.

529+-- non-empty. Subject to fusion.

287530head :: Text -> Char

288531head t = S.head (stream t)

289532{-# INLINE head #-}

290533

291534-- | /O(1)/ Returns all characters after the head of a 'Text', which

292−-- must be non-empty. Subject to array fusion.

535+-- must be non-empty. Subject to fusion.

293536tail :: Text -> Text

294537tail (Chunk t ts) = chunk (T.tail t) ts

295538tail Empty = emptyError "tail"

@@ -302,8 +545,8 @@ tail Empty = emptyError "tail"

302545 unstream (S.tail (stream t)) = tail t

303546 #-}

304547

305−-- | /O(1)/ Returns all but the last character of a 'Text', which must

306−-- be non-empty. Subject to array fusion.

548+-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must

549+-- be non-empty. Subject to fusion.

307550init :: Text -> Text

308551init (Chunk t0 ts0) = go t0 ts0

309552 where go t (Chunk t' ts) = Chunk t (go t' ts)

@@ -318,7 +561,7 @@ init Empty = emptyError "init"

318561 unstream (S.init (stream t)) = init t

319562 #-}

320563

321−-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to array

564+-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to

322565-- fusion.

323566null :: Text -> Bool

324567null Empty = True

@@ -338,8 +581,8 @@ isSingleton :: Text -> Bool

338581isSingleton = S.isSingleton . stream

339582{-# INLINE isSingleton #-}

340583

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

342−-- non-empty. Subject to array fusion.

584+-- | /O(n\/c)/ Returns the last character of a 'Text', which must be

585+-- non-empty. Subject to fusion.

343586last :: Text -> Char

344587last Empty = emptyError "last"

345588last (Chunk t ts) = go t ts

@@ -354,6 +597,8 @@ last (Chunk t ts) = go t ts

354597 S.last (stream t) = last t

355598 #-}

356599

600+-- | /O(n)/ Returns the number of characters in a 'Text'.

601+-- Subject to fusion.

357602length :: Text -> Int64

358603length = foldlChunks go 0

359604 where go l t = l + fromIntegral (T.length t)

@@ -366,27 +611,46 @@ length = foldlChunks go 0

366611 S.length (stream t) = length t

367612 #-}

368613

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+

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

370−-- each element of @t@. Subject to array fusion.

629+-- each element of @t@. Subject to fusion. Performs replacement on

630+-- invalid scalar values.

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

372−map f t = unstream (S.map f (stream t))

632+map f t = unstream (S.map (safe . f) (stream t))

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

374634

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

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

377637-- argument between each element of the list.

378638intercalate :: Text -> [Text] -> Text

379−intercalate t ts = unstream (S.intercalate (stream t) (L.map stream ts))

639+intercalate t = concat . (F.intersperse t)

380640{-# INLINE intercalate #-}

381641

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

383−-- between the characters of a 'Text'. Subject to array fusion.

384−intersperse :: Char -> Text -> Text

385−intersperse c t = unstream (S.intersperse c (stream t))

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

386647{-# INLINE intersperse #-}

387648

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

389−-- specified fill character on the right. Subject to fusion. Examples:

650+-- specified fill character on the right. Subject to fusion. Performs

651+-- replacement on invalid scalar values.

652+--

653+-- Examples:

390654--

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

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

@@ -405,7 +669,10 @@ justifyLeft k c t

405669 #-}

406670

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

408−-- specified fill character on the left. Examples:

672+-- specified fill character on the left. Performs replacement on

673+-- invalid scalar values.

674+--

675+-- Examples:

409676--

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

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

@@ -416,8 +683,11 @@ justifyRight k c t

416683 where len = length t

417684{-# INLINE justifyRight #-}

418685

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

420−-- specified fill character on either side. Examples:

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:

421691--

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

423693center :: Int64 -> Char -> Text -> Text

@@ -426,7 +696,7 @@ center k c t

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

427697 where len = length t

428698 d = k - len

429− r = d `div` 2

699+ r = d `quot` 2

430700 l = d - r

431701{-# INLINE center #-}

432702

@@ -445,12 +715,38 @@ reverse = rev Empty

445715 where rev a Empty = a

446716 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts

447717

448−-- | /O(m)*O(n)/ Replace every occurrence of one substring with another.

449−replace :: Text -- ^ Text to search for

450− -> Text -- ^ Replacement text

451− -> Text -- ^ Input text

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.

452746 -> Text

453−replace s d = intercalate d . split s

747+ -- ^ @haystack@ in which to search.

748+ -> Text

749+replace s d = intercalate d . splitOn s

454750{-# INLINE replace #-}

455751

456752-- ----------------------------------------------------------------------------

@@ -465,9 +761,10 @@ replace s d = intercalate d . split s

465761-- functions may map one input character to two or three output

466762-- characters.

467763

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

469−-- useful for performing caseless (or case insensitive) string

470−-- comparisons.

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.

471768--

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

473770--

@@ -484,45 +781,70 @@ toCaseFold t = unstream (S.toCaseFold (stream t))

484781{-# INLINE [0] toCaseFold #-}

485782

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

487−-- conversion. The result string may be longer than the input string.

488−-- For instance, the Latin capital letter I with dot above (U+0130)

489−-- maps to the sequence Latin small letter i (U+0069) followed by

490−-- combining dot above (U+0307).

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

491790toLower :: Text -> Text

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

493792{-# INLINE toLower #-}

494793

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

496−-- conversion. The result string may be longer than the input string.

497−-- For instance, the German eszett (U+00DF) maps to the two-letter

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

498799-- sequence SS.

499800toUpper :: Text -> Text

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

501802{-# INLINE toUpper #-}

502803

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+

503827-- | /O(n)/ 'foldl', applied to a binary operator, a starting value

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

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

506−-- Subject to array fusion.

507−foldl :: (b -> Char -> b) -> b -> Text -> b

830+-- Subject to fusion.

831+foldl :: (a -> Char -> a) -> a -> Text -> a

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

509833{-# INLINE foldl #-}

510834

511835-- | /O(n)/ A strict version of 'foldl'.

512−-- Subject to array fusion.

513−foldl' :: (b -> Char -> b) -> b -> Text -> b

836+-- Subject to fusion.

837+foldl' :: (a -> Char -> a) -> a -> Text -> a

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

515839{-# INLINE foldl' #-}

516840

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

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

519−-- fusion.

842+-- and thus must be applied to a non-empty 'Text'. Subject to fusion.

520843foldl1 :: (Char -> Char -> Char) -> Text -> Char

521844foldl1 f t = S.foldl1 f (stream t)

522845{-# INLINE foldl1 #-}

523846

524−-- | /O(n)/ A strict version of 'foldl1'.

525−-- Subject to array fusion.

847+-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.

526848foldl1' :: (Char -> Char -> Char) -> Text -> Char

527849foldl1' f t = S.foldl1' f (stream t)

528850{-# INLINE foldl1' #-}

@@ -530,59 +852,61 @@ foldl1' f t = S.foldl1' f (stream t)

530852-- | /O(n)/ 'foldr', applied to a binary operator, a starting value

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

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

533−-- Subject to array fusion.

534−foldr :: (Char -> b -> b) -> b -> Text -> b

855+-- Subject to fusion.

856+foldr :: (Char -> a -> a) -> a -> Text -> a

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

536858{-# INLINE foldr #-}

537859

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

539−-- thust must be applied to a non-empty 'Text'. Subject to array

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

540862-- fusion.

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

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

543865{-# INLINE foldr1 #-}

544866

545−-- | /O(n)/ Concatenate a list of 'Text's. Subject to array fusion.

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

546868concat :: [Text] -> Text

547−concat ts = unstream (S.concat (L.map stream ts))

869+concat = to

870+ where

871+ go Empty css = to css

872+ go (Chunk c cs) css = Chunk c (go cs css)

873+ to [] = Empty

874+ to (cs:css) = go cs css

548875{-# INLINE concat #-}

549876

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

551−-- concatenate the results. This function is subject to array fusion.

552−--

553−-- Note: if in 'concatMap' @f@ @t@, @f@ is defined in terms of fusible

554−-- functions, it will also be fusible.

878+-- concatenate the results.

555879concatMap :: (Char -> Text) -> Text -> Text

556−concatMap f t = unstream (S.concatMap (stream . f) (stream t))

880+concatMap f = concat . foldr ((:) . f) []

557881{-# INLINE concatMap #-}

558882

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

560−-- 'Text' @t@ satisifes the predicate @p@. Subject to array fusion.

884+-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.

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

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

563887{-# INLINE any #-}

564888

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

566−-- 'Text' @t@ satisify the predicate @p@. Subject to array fusion.

890+-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.

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

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

569893{-# INLINE all #-}

570894

571895-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which

572−-- must be non-empty. Subject to array fusion.

896+-- must be non-empty. Subject to fusion.

573897maximum :: Text -> Char

574898maximum t = S.maximum (stream t)

575899{-# INLINE maximum #-}

576900

577901-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which

578−-- must be non-empty. Subject to array fusion.

902+-- must be non-empty. Subject to fusion.

579903minimum :: Text -> Char

580904minimum t = S.minimum (stream t)

581905{-# INLINE minimum #-}

582906

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

584−-- successive reduced values from the left. This function is subject

585−-- to array fusion.

908+-- successive reduced values from the left. Subject to fusion.

909+-- Performs replacement on invalid scalar values.

586910--

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

588912--

@@ -590,11 +914,13 @@ minimum t = S.minimum (stream t)

590914--

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

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

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

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

918+ where g a b = safe (f a b)

594919{-# INLINE scanl #-}

595920

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

597−-- value argument. This function is subject to array fusion.

922+-- value argument. Subject to fusion. Performs replacement on

923+-- invalid scalar values.

598924--

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

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

@@ -603,51 +929,83 @@ scanl1 f t0 = case uncons t0 of

603929 Just (t,ts) -> scanl f t ts

604930{-# INLINE scanl1 #-}

605931

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

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

933+-- replacement on invalid scalar values.

607934--

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

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

610−scanr f v = reverse . scanl (flip f) v . reverse

937+scanr f v = reverse . scanl g v . reverse

938+ where g a b = safe (f b a)

611939

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

613−-- value argument.

941+-- value argument. Performs replacement on invalid scalar values.

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

615943scanr1 f t | null t = empty

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

617945

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

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

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

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

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

949+-- replacement on invalid scalar values.

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

622−mapAccumL f s t = case uncons t of

623− Nothing -> (s, empty)

624− Just (x, xs) -> (s'', cons y ys)

625− where (s', y ) = f s x

626− (s'',ys) = mapAccumL f s' xs

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

627958

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

629−-- 'foldr'; it applies a function to each element of a 'Text', passing

630−-- an accumulating parameter from right to left, and returning a final

631−-- value of this accumulator together with the new 'Text'.

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.

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

633−mapAccumR f s t = case uncons t of

634− Nothing -> (s, empty)

635− Just (x, xs) -> (s'', cons y ys)

636− where (s'',y ) = f s' x

637− (s', ys) = mapAccumR f s xs

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

638978

639979-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input

640−-- @t@ repeated @n@ times. Subject to fusion.

980+-- @t@ repeated @n@ times.

641981replicate :: Int64 -> Text -> Text

642982replicate n t

643− | isSingleton t = replicateChar n (head t)

644− | otherwise = unstream (S.replicateI n (S.stream t))

645−{-# INLINE replicate #-}

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

6461004

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

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

6491007replicateChar :: Int64 -> Char -> Text

650−replicateChar n c = unstream (S.replicateCharI n c)

1008+replicateChar n c = unstream (S.replicateCharI n (safe c))

6511009{-# INLINE replicateChar #-}

6521010

6531011{-# RULES

@@ -660,9 +1018,10 @@ replicateChar n c = unstream (S.replicateCharI n c)

6601018-- 'Text' from a seed value. The function takes the element and

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

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

663−-- string, and @b@ is the seed value for further production.

664−unfoldr :: (a -> Maybe (Char,a)) -> a -> Text

665−unfoldr f s = unstream (S.unfoldr f s)

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)

6661025{-# INLINE unfoldr #-}

6671026

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

@@ -670,8 +1029,9 @@ unfoldr f s = unstream (S.unfoldr f s)

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

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

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

673−unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Text

674−unfoldrN n f s = unstream (S.unfoldrN n f s)

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)

6751035{-# INLINE unfoldrN #-}

6761036

6771037-- | /O(n)/ 'take' @n@, applied to a 'Text', returns the prefix of the

@@ -695,16 +1055,32 @@ take i t0 = take' i t0

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

6961056 #-}

6971057

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+

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

699−-- 'Text' of length @n@, or the empty 'Text' if @n@ is greater than the

700−-- length of the 'Text'. Subject to fusion.

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

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

7011077drop :: Int64 -> Text -> Text

7021078drop i t0

7031079 | i <= 0 = t0

7041080 | otherwise = drop' i t0

7051081 where drop' 0 ts = ts

7061082 drop' _ Empty = Empty

707− drop' n (Chunk t ts)

1083+ drop' n (Chunk t ts)

7081084 | n < len = Chunk (T.drop (fromIntegral n) t) ts

7091085 | otherwise = drop' (n - len) ts

7101086 where len = fromIntegral (T.length t)

@@ -717,6 +1093,23 @@ drop i t0

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

7181094 #-}

7191095

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+

7201113-- | /O(n)/ 'dropWords' @n@ returns the suffix with @n@ 'Word16'

7211114-- values dropped, or the empty 'Text' if @n@ is greater than the

7221115-- number of 'Word16' values present.

@@ -727,14 +1120,14 @@ dropWords i t0

7271120 where drop' 0 ts = ts

7281121 drop' _ Empty = Empty

7291122 drop' n (Chunk (T.Text arr off len) ts)

730− | n < len' = chunk (textP arr (off+n') (len-n')) ts

1123+ | n < len' = chunk (text arr (off+n') (len-n')) ts

7311124 | otherwise = drop' (n - len') ts

7321125 where len' = fromIntegral len

7331126 n' = fromIntegral n

7341127

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

736−-- the longest prefix (possibly empty) of elements that satisfy @p@.

737−-- This function is subject to array fusion.

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.

7381131takeWhile :: (Char -> Bool) -> Text -> Text

7391132takeWhile p t0 = takeWhile' t0

7401133 where takeWhile' Empty = Empty

@@ -751,9 +1144,23 @@ takeWhile p t0 = takeWhile' t0

7511144"LAZY TEXT takeWhile -> unfused" [1] forall p t.

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

7531146 #-}

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

7541161

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

756−-- 'takeWhile' @p@ @t@. This function is subject to array fusion.

1163+-- 'takeWhile' @p@ @t@. Subject to fusion.

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

7581165dropWhile p t0 = dropWhile' t0

7591166 where dropWhile' Empty = Empty

@@ -769,9 +1176,11 @@ dropWhile p t0 = dropWhile' t0

7691176"LAZY TEXT dropWhile -> unfused" [1] forall p t.

7701177 unstream (S.dropWhile p (stream t)) = dropWhile p t

7711178 #-}

1179+

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

773−-- dropping characters that fail the predicate @p@ from the end of

1181+-- dropping characters that satisfy the predicate @p@ from the end of

7741182-- @t@.

1183+--

7751184-- Examples:

7761185--

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

@@ -788,7 +1197,7 @@ dropWhileEnd p = go

7881197{-# INLINE dropWhileEnd #-}

7891198

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

791−-- dropping characters that fail the predicate @p@ from both the

1200+-- dropping characters that satisfy the predicate @p@ from both the

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

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

7941203dropAround p = dropWhile p . dropWhileEnd p

@@ -838,8 +1247,8 @@ splitAtWord _ Empty = empty :*: empty

8381247splitAtWord x (Chunk c@(T.Text arr off len) cs)

8391248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs

8401249 in Chunk c h :*: t

841− | otherwise = chunk (textP arr off y) empty :*:

842− chunk (textP arr (off+y) (len-y)) cs

1250+ | otherwise = chunk (text arr off y) empty :*:

1251+ chunk (text arr (off+y) (len-y)) cs

8431252 where y = fromIntegral x

8441253

8451254-- | /O(n+m)/ Find the first instance of @needle@ (which must be

@@ -849,16 +1258,16 @@ splitAtWord x (Chunk c@(T.Text arr off len) cs)

8491258--

8501259-- Examples:

8511260--

852−-- > break "::" "a::b::c" ==> ("a", "::b::c")

853−-- > break "/" "foobar" ==> ("foobar", "")

1261+-- > breakOn "::" "a::b::c" ==> ("a", "::b::c")

1262+-- > breakOn "/" "foobar" ==> ("foobar", "")

8541263--

8551264-- Laws:

8561265--

8571266-- > append prefix match == haystack

858−-- > where (prefix, match) = break needle haystack

1267+-- > where (prefix, match) = breakOn needle haystack

8591268--

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

861−-- want to break on every instance of a substring), use 'find'

1270+-- want to break on every instance of a substring), use 'breakOnAll'

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

8631272--

8641273-- This function is strict in its first argument, and lazy in its

@@ -866,52 +1275,63 @@ splitAtWord x (Chunk c@(T.Text arr off len) cs)

8661275--

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

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

869−break :: Text -> Text -> (Text, Text)

870−break pat src

871− | null pat = emptyError "break"

1278+breakOn :: Text -> Text -> (Text, Text)

1279+breakOn pat src

1280+ | null pat = emptyError "breakOn"

8721281 | otherwise = case indices pat src of

8731282 [] -> (src, empty)

8741283 (x:_) -> let h :*: t = splitAtWord x src

8751284 in (h, t)

8761285

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

1287+--

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

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

1290+-- remainder of @haystack@, following the match.

1291+--

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)

1295+ in (reverse b, reverse a)

1296+{-# INLINE breakOnEnd #-}

1297+

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

878−-- @haystack@. The first element of the returned pair is the prefix

879−-- of @haystack@ prior to any matches of @needle@. The second is a

880−-- list of pairs.

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

8811300--

882−-- The first element of each pair in the list is a span from the

883−-- beginning of a match to the beginning of the next match, while the

884−-- second is a span from the beginning of the match to the end of the

885−-- input.

1301+-- * The entire string prior to the /k/th match (i.e. the prefix)

1302+--

1303+-- * The /k/th match, followed by the remainder of the string

8861304--

8871305-- Examples:

8881306--

889−-- > find "::" ""

890−-- > ==> ("", [])

891−-- > find "/" "a/b/c/d"

892−-- > ==> ("a", [("/b","/b/c/d"), ("/c","/c/d"), ("/d","/d")])

1307+-- > breakOnAll "::" ""

1308+-- > ==> []

1309+-- > breakOnAll "/" "a/b/c/"

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

8931311--

8941312-- This function is strict in its first argument, and lazy in its

8951313-- second.

8961314--

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

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

899−find :: Text -> Text -> (Text, [(Text, Text)])

900−find pat src

901− | null pat = emptyError "find"

902− | otherwise = case indices pat src of

903− [] -> (src, [])

904− (x:xs) -> let h :*: t = splitAtWord x src

905− in (h, go x xs t)

1317+--

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

1324+ | otherwise = go 0 empty src (indices pat src)

9061325 where

907− go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs

908− in (h, cs) : go x xs t

909− go _ _ cs = [(cs,cs)]

1326+ go !n p s (x:xs) = let h :*: t = splitAtWord (x-n) s

1327+ h' = append p h

1328+ in (h',t) : go x h' t xs

1329+ go _ _ _ _ = []

9101330

911−-- | /O(n)/ 'breakBy' is like 'spanBy', but the prefix returned is over

1331+-- | /O(n)/ 'break' is like 'span', but the prefix returned is over

9121332-- elements that fail the predicate @p@.

913−breakBy :: (Char -> Bool) -> Text -> (Text, Text)

914−breakBy p t0 = break' t0

1333+break :: (Char -> Bool) -> Text -> (Text, Text)

1334+break p t0 = break' t0

9151335 where break' Empty = (empty, empty)

9161336 break' c@(Chunk t ts) =

9171337 case T.findIndex p t of

@@ -921,13 +1341,13 @@ breakBy p t0 = break' t0

9211341 | otherwise -> let (a,b) = T.splitAt n t

9221342 in (Chunk a Empty, Chunk b ts)

9231343

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

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

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

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

9271347-- remainder of the list.

928−spanBy :: (Char -> Bool) -> Text -> (Text, Text)

929−spanBy p = breakBy (not . p)

930−{-# INLINE spanBy #-}

1348+span :: (Char -> Bool) -> Text -> (Text, Text)

1349+span p = break (not . p)

1350+{-# INLINE span #-}

9311351

9321352-- | The 'group' function takes a 'Text' and returns a list of 'Text's

9331353-- such that the concatenation of the result is equal to the argument.

@@ -946,7 +1366,7 @@ group = groupBy (==)

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

9471367groupBy _ Empty = []

9481368groupBy eq (Chunk t ts) = cons x ys : groupBy eq zs

949− where (ys,zs) = spanBy (eq x) xs

1369+ where (ys,zs) = span (eq x) xs

9501370 x = T.unsafeHead t

9511371 xs = chunk (T.unsafeTail t) ts

9521372

@@ -972,43 +1392,49 @@ tails ts@(Chunk t ts')

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

9731393-- are slices of the original.

9741394

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

976−-- 'Text' argument, consuming the delimiter. An empty delimiter is

977−-- invalid, and will cause an error to be raised.

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.

9781399--

9791400-- Examples:

9801401--

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

982−-- > split "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]

983−-- > split "x" "x" == ["",""]

984−--

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

9851406-- and

9861407--

987−-- > intercalate s . split s == id

988−-- > split (singleton c) == splitBy (==c)

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

9891412--

9901413-- This function is strict in its first argument, and lazy in its

9911414-- second.

9921415--

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

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

995−split :: Text -- ^ Text to split on

996− -> Text -- ^ Input text

997− -> [Text]

998−split pat src

999− | null pat = emptyError "split"

1000− | isSingleton pat = splitBy (== head pat) src

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

10011427 | otherwise = go 0 (indices pat src) src

10021428 where

10031429 go _ [] cs = [cs]

10041430 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs

10051431 in h : go (x+l) xs (dropWords l t)

10061432 l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat

1007−{-# INLINE [1] split #-}

1433+{-# INLINE [1] splitOn #-}

10081434

10091435{-# RULES

1010−"LAZY TEXT split/singleton -> splitBy/==" [~1] forall c t.

1011− split (singleton c) t = splitBy (==c) t

1436+"LAZY TEXT splitOn/singleton -> split/==" [~1] forall c t.

1437+ splitOn (singleton c) t = split (==c) t

10121438 #-}

10131439

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

@@ -1016,16 +1442,16 @@ split pat src

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

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

10181444--

1019−-- > splitBy (=='a') "aabbaca" == ["","","bb","c",""]

1020−-- > splitBy (=='a') [] == [""]

1021−splitBy :: (Char -> Bool) -> Text -> [Text]

1022−splitBy _ Empty = [Empty]

1023−splitBy p (Chunk t0 ts0) = comb [] (T.splitBy p t0) ts0

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

10241450 where comb acc (s:[]) Empty = revChunks (s:acc) : []

1025− comb acc (s:[]) (Chunk t ts) = comb (s:acc) (T.splitBy p t) ts

1451+ comb acc (s:[]) (Chunk t ts) = comb (s:acc) (T.split p t) ts

10261452 comb acc (s:ss) ts = revChunks (s:acc) : comb [] ss ts

1027− comb _ [] _ = impossibleError "splitBy"

1028−{-# INLINE splitBy #-}

1453+ comb _ [] _ = impossibleError "split"

1454+{-# INLINE split #-}

10291455

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

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

@@ -1045,14 +1471,14 @@ chunksOf k = go

10451471-- newline 'Char's. The resulting strings do not contain newlines.

10461472lines :: Text -> [Text]

10471473lines Empty = []

1048−lines t = let (l,t') = breakBy ((==) '\n') t

1474+lines t = let (l,t') = break ((==) '\n') t

10491475 in l : if null t' then []

10501476 else lines (tail t')

10511477

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

10531479-- representing white space.

10541480words :: Text -> [Text]

1055−words = L.filter (not . null) . splitBy isSpace

1481+words = L.filter (not . null) . split isSpace

10561482{-# INLINE words #-}

10571483

10581484-- | /O(n)/ Joins lines, after appending a terminating newline to

@@ -1067,8 +1493,7 @@ unwords = intercalate (singleton ' ')

10671493{-# INLINE unwords #-}

10681494

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

1070−-- 'True' iff the first is a prefix of the second. This function is

1071−-- subject to fusion.

1496+-- 'True' iff the first is a prefix of the second. Subject to fusion.

10721497isPrefixOf :: Text -> Text -> Bool

10731498isPrefixOf Empty _ = True

10741499isPrefixOf _ Empty = False

@@ -1117,6 +1542,81 @@ isInfixOf needle haystack

11171542 isInfixOf (singleton n) h = S.elem n (S.stream h)

11181543 #-}

11191544

1545+-------------------------------------------------------------------------------

1546+-- * View patterns

1547+

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

1549+-- matches the entire first string.

1550+--

1551+-- Examples:

1552+--

1553+-- > stripPrefix "foo" "foobar" == Just "bar"

1554+-- > stripPrefix "" "baz" == Just "baz"

1555+-- > stripPrefix "foo" "quux" == Nothing

1556+--

1557+-- This is particularly useful with the @ViewPatterns@ extension to

1558+-- GHC, as follows:

1559+--

1560+-- > {-# LANGUAGE ViewPatterns #-}

1561+-- > import Data.Text.Lazy as T

1562+-- >

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

1601+--

1602+-- Examples:

1603+--

1604+-- > stripSuffix "bar" "foobar" == Just "foo"

1605+-- > stripSuffix "" "baz" == Just "baz"

1606+-- > stripSuffix "foo" "quux" == Nothing

1607+--

1608+-- This is particularly useful with the @ViewPatterns@ extension to

1609+-- GHC, as follows:

1610+--

1611+-- > {-# LANGUAGE ViewPatterns #-}

1612+-- > import Data.Text.Lazy as T

1613+-- >

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

1619+

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

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

11221622-- predicate.

@@ -1124,21 +1624,21 @@ filter :: (Char -> Bool) -> Text -> Text

11241624filter p t = unstream (S.filter p (stream t))

11251625{-# INLINE filter #-}

11261626

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

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

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

11291629-- if there is no such element.

1130−findBy :: (Char -> Bool) -> Text -> Maybe Char

1131−findBy p t = S.findBy p (stream t)

1132−{-# INLINE findBy #-}

1630+find :: (Char -> Bool) -> Text -> Maybe Char

1631+find p t = S.findBy p (stream t)

1632+{-# INLINE find #-}

11331633

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

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

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

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

11371637--

1138−-- > partitionBy p t == (filter p t, filter (not . p) t)

1139−partitionBy :: (Char -> Bool) -> Text -> (Text, Text)

1140−partitionBy p t = (filter p t, filter (not . p) t)

1141−{-# INLINE partitionBy #-}

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

11421642

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

11441644index :: Text -> Int64 -> Char

@@ -1154,9 +1654,9 @@ index t n = S.index (stream t) n

11541654count :: Text -> Text -> Int64

11551655count pat src

11561656 | null pat = emptyError "count"

1157− | otherwise = len (indices pat src)

1158− where len [] = 0

1159− len (_:xs) = 1 + len xs

1657+ | otherwise = go 0 (indices pat src)

1658+ where go !n [] = n

1659+ go !n (_:xs) = go (n+1) xs

11601660{-# INLINE [1] count #-}

11611661

11621662{-# RULES

@@ -1165,8 +1665,7 @@ count pat src

11651665 #-}

11661666

11671667-- | /O(n)/ The 'countChar' function returns the number of times the

1168−-- query element appears in the given 'Text'. This function is subject

1169−-- to fusion.

1668+-- query element appears in the given 'Text'. Subject to fusion.

11701669countChar :: Char -> Text -> Int64

11711670countChar c t = S.countChar c (stream t)

11721671

@@ -1180,8 +1679,10 @@ zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)

11801679

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

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

1682+-- Performs replacement on invalid scalar values.

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

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

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

1685+ where g a b = safe (f a b)

11851686{-# INLINE [0] zipWith #-}

11861687

11871688revChunks :: [T.Text] -> Text

Data/Text/Lazy/Builder.hsnew file+58

@@ -0,0 +1,58 @@

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

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

5+

6+-----------------------------------------------------------------------------

7+-- |

8+-- Module : Data.Text.Lazy.Builder

11+-- License : BSD-style (see LICENSE)

12+--

13+-- Maintainer : Johan Tibell <johan.tibell@gmail.com>

14+-- Stability : experimental

15+-- Portability : portable to Hugs and GHC

16+--

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

29+--

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+

40+-----------------------------------------------------------------------------

41+

42+module Data.Text.Lazy.Builder

43+ ( -- * The Builder type

44+ Builder

45+ , toLazyText

46+ , toLazyTextWith

47+

48+ -- * Constructing Builders

49+ , singleton

50+ , fromText

51+ , fromLazyText

52+ , fromString

53+

54+ -- * Flushing the buffer state

55+ , flush

56+ ) where

57+

58+import Data.Text.Internal.Builder

Data/Text/Lazy/Builder/Int.hsnew file+262

@@ -0,0 +1,262 @@

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.hsnew file+242

@@ -0,0 +1,242 @@

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+215−30

@@ -1,55 +1,240 @@

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

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

15-- |

26-- Module : Data.Text.Lazy.Encoding

3−-- Copyright : (c) Bryan O'Sullivan 2009

48--

59-- License : BSD-style

6−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

7−-- duncan@haskell.org

10+-- Maintainer : bos@serpentine.com

811-- Stability : experimental

912-- Portability : portable

1013--

1114-- Functions for converting lazy 'Text' values to and from lazy

1215-- 'ByteString', using several standard encodings.

1316--

14−-- To make use of a much larger variety of encodings, use the @text-icu@

15−-- package.

17+-- To gain access to a much larger variety of encodings, use the

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

1619

1720module Data.Text.Lazy.Encoding

1821 (

1922 -- * Decoding ByteStrings to Text

20− -- decodeASCII

21− decodeUtf8

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

2236 , decodeUtf8With

23− --, decodeUtf16LE

24− --, decodeUtf16BE

25− --, decodeUtf32LE

26− --, decodeUtf32BE

37+ , decodeUtf16LEWith

38+ , decodeUtf16BEWith

39+ , decodeUtf32LEWith

40+ , decodeUtf32BEWith

2741

2842 -- * Encoding Text to ByteStrings

2943 , encodeUtf8

30− --, encodeUtf16LE

31− --, encodeUtf16BE

32− --, encodeUtf32LE

33− --, encodeUtf32BE

44+ , encodeUtf16LE

45+ , encodeUtf16BE

46+ , encodeUtf32LE

47+ , encodeUtf32BE

48+

49+ -- * Encoding Text using ByteString Builders

50+ , encodeUtf8Builder

51+ , encodeUtf8BuilderEscaped

3452 ) where

3553

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

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)

4171

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

43−decodeUtf8With :: OnDecodeError -> ByteString -> Text

44−decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)

45−{-# INLINE decodeUtf8With #-}

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

4694

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

48−decodeUtf8 :: ByteString -> 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

111+

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

49120decodeUtf8 = decodeUtf8With strictDecode

50−{-# INLINE decodeUtf8 #-}

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

51236

52−-- | Encode text using UTF-8 encoding.

53−encodeUtf8 :: Text -> ByteString

54−encodeUtf8 txt = E.unstream (E.restreamUtf8 (F.stream txt))

55−{-# INLINE encodeUtf8 #-}

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

Data/Text/Lazy/Encoding/Fusion.hsdeleted−147

@@ -1,147 +0,0 @@

1−{-# LANGUAGE BangPatterns, 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, rtharper@aftereternity.co.uk,

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.Internal (M(..), PairS(..), S(..))

39−import Data.Text.Fusion.Size

40−import Data.Text.UnsafeChar (unsafeChr8)

41−import Data.Word (Word8)

42−import qualified Data.Text.Encoding.Utf8 as U8

43−import System.IO.Unsafe (unsafePerformIO)

44−import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)

45−import Foreign.Storable (pokeByteOff)

46−import Data.ByteString.Internal (mallocByteString, memcpy)

47−import Control.Exception (assert)

48−import qualified Data.ByteString.Internal as B

49−

50−-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using

51−-- UTF-8 encoding.

52−streamUtf8 :: OnDecodeError -> ByteString -> Stream Char

53−streamUtf8 onErr bs0 = Stream next (bs0 :*: empty :*: 0) unknownSize

54− where

55− empty = S N N N N

56− {-# INLINE next #-}

57− next (bs@(Chunk ps _) :*: S N _ _ _ :*: i)

58− | i < len && U8.validate1 a =

59− Yield (unsafeChr8 a) (bs :*: empty :*: i+1)

60− | i + 1 < len && U8.validate2 a b =

61− Yield (U8.chr2 a b) (bs :*: empty :*: i+2)

62− | i + 2 < len && U8.validate3 a b c =

63− Yield (U8.chr3 a b c) (bs :*: empty :*: i+3)

64− | i + 4 < len && U8.validate4 a b c d =

65− Yield (U8.chr4 a b c d) (bs :*: empty :*: i+4)

66− where len = B.length ps

67− a = B.unsafeIndex ps i

68− b = B.unsafeIndex ps (i+1)

69− c = B.unsafeIndex ps (i+2)

70− d = B.unsafeIndex ps (i+3)

71− next st@(bs :*: s :*: i) =

72− case s of

73− S (J a) N _ _ | U8.validate1 a ->

74− Yield (unsafeChr8 a) es

75− S (J a) (J b) N _ | U8.validate2 a b ->

76− Yield (U8.chr2 a b) es

77− S (J a) (J b) (J c) N | U8.validate3 a b c ->

78− Yield (U8.chr3 a b c) es

79− S (J a) (J b) (J c) (J d) | U8.validate4 a b c d ->

80− Yield (U8.chr4 a b c d) es

81− _ -> consume st

82− where es = bs :*: empty :*: i

83− {-# INLINE consume #-}

84− consume (bs@(Chunk ps rest) :*: s :*: i)

85− | i >= B.length ps = consume (rest :*: s :*: 0)

86− | otherwise =

87− case s of

88− S N _ _ _ -> next (bs :*: S x N N N :*: i+1)

89− S a N _ _ -> next (bs :*: S a x N N :*: i+1)

90− S a b N _ -> next (bs :*: S a b x N :*: i+1)

91− S a b c N -> next (bs :*: S a b c x :*: i+1)

92− S (J a) b c d -> decodeError "streamUtf8" "UTF-8" onErr (Just a)

93− (bs :*: S b c d N :*: i+1)

94− where x = J (B.unsafeIndex ps i)

95− consume (Empty :*: S N _ _ _ :*: _) = Done

96− consume st = decodeError "streamUtf8" "UTF-8" onErr Nothing st

97−{-# INLINE [0] streamUtf8 #-}

98−

99−-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.

100−unstreamChunks :: Int -> Stream Word8 -> ByteString

101−unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)

102− where chunk s1 len1 = unsafePerformIO $ do

103− let len = min len1 chunkSize

104− mallocByteString len >>= loop len 0 s1

105− where

106− loop !n !off !s fp = case next s of

107− Done | off == 0 -> return Empty

108− | otherwise -> do

109− bs <- trimUp fp off

110− return $! Chunk bs Empty

111− Skip s' -> loop n off s' fp

112− Yield x s'

113− | off == chunkSize -> do

114− bs <- trimUp fp off

115− return (Chunk bs (chunk s (n - B.length bs)))

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− {-# NOINLINE trimUp #-}

127− trimUp fp off = return $! B.PS fp 0 off

128− copy0 :: ForeignPtr Word8 -> Int -> Int -> IO (ForeignPtr Word8)

129− copy0 !src !srcLen !destLen = assert (srcLen <= destLen) $ do

130− dest <- mallocByteString destLen

131− withForeignPtr src $ \src' ->

132− withForeignPtr dest $ \dest' ->

133− memcpy dest' src' (fromIntegral srcLen)

134− return dest

135−

136−-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.

137−unstream :: Stream Word8 -> ByteString

138−unstream = unstreamChunks defaultChunkSize

139−

140−decodeError :: forall s. String -> String -> OnDecodeError -> Maybe Word8

141− -> s -> Step s Char

142−decodeError func kind onErr mb i =

143− case onErr desc mb of

144− Nothing -> Skip i

145− Just c -> Yield c i

146− where desc = "Data.Text.Lazy.Encoding.Fusion." ++ func ++ ": Invalid " ++

147− kind ++ " stream"

Data/Text/Lazy/Fusion.hsdeleted−109

@@ -1,109 +0,0 @@

1−-- |

2−-- Module : Data.Text.Lazy.Fusion

3−-- Copyright : (c) Bryan O'Sullivan 2009

4−--

5−-- License : BSD-style

6−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

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.Unsafe (iter)

33−import Data.Int (Int64)

34−

35−default(Int64)

36−

37−-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.

38−stream :: Text -> Stream Char

39−stream text = Stream next (text :*: 0) 4 -- random HINT

40− where

41− next (Empty :*: _) = Done

42− next (txt@(Chunk t@(I.Text _ _ len) ts) :*: i)

43− | i >= len = next (ts :*: 0)

44− | otherwise = Yield c (txt :*: i+d)

45− where (c,d) = iter t i

46−{-# INLINE [0] stream #-}

47−

48−-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given

49−-- chunk size.

50−unstreamChunks :: Int -> Stream Char -> Text

51−unstreamChunks chunkSize (Stream next s0 len0)

52− | isEmpty len0 = Empty

53− | otherwise = outer s0

54− where

55− outer s = case next s of

56− Done -> Empty

57− Skip s' -> outer s'

58− Yield x s' -> I.Text arr 0 len `chunk` outer s''

59− where (arr,(s'',len)) = A.run2 fill

60− fill = do a <- A.unsafeNew unknownLength

61− i <- unsafeWrite a 0 x

62− inner a unknownLength s' i

63− unknownLength = 4

64− inner marr len s i

65− | i + 1 >= chunkSize = return (marr, (s,i))

66− | i + 1 >= len = do

67− let newLen = min (len * 2) chunkSize

68− marr' <- A.unsafeNew newLen

69− A.copy marr marr'

70− inner marr' newLen s i

71− | otherwise =

72− case next s of

73− Done -> return (marr,(s,i))

74− Skip s' -> inner marr len s' i

75− Yield x s' -> unsafeWrite marr i x >>= inner marr len s'

76−{-# INLINE [0] unstreamChunks #-}

77−

78−-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using

79−-- 'defaultChunkSize'.

80−unstream :: Stream Char -> Text

81−unstream = unstreamChunks defaultChunkSize

82−{-# INLINE [0] unstream #-}

83−

84−-- | /O(n)/ Returns the number of characters in a text.

85−length :: Stream Char -> Int64

86−length = S.lengthI

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

88−

89−{-# RULES "LAZY STREAM stream/unstream fusion" forall s.

90− stream (unstream s) = s #-}

91−

92−-- | /O(n)/ Like 'unfoldr', 'unfoldrN64' builds a stream from a seed

93−-- value. However, the length of the result is limited by the

94−-- first argument to 'unfoldrN64'. This function is more efficient than

95−-- 'unfoldr' when the length of the result is known.

96−unfoldrN :: Int64 -> (a -> Maybe (Char,a)) -> a -> Stream Char

97−unfoldrN n = S.unfoldrNI n

98−{-# INLINE [0] unfoldrN #-}

99−

100−-- | /O(n)/ stream index (subscript) operator, starting from 0.

101−index :: Stream Char -> Int64 -> Char

102−index = S.indexI

103−{-# INLINE [0] index #-}

104−

105−-- | /O(n)/ The 'count' function returns the number of times the query

106−-- element appears in the given stream.

107−countChar :: Char -> Stream Char -> Int64

108−countChar = S.countCharI

109−{-# INLINE [0] countChar #-}

Data/Text/Lazy/IO.hsnew file+196

@@ -0,0 +1,196 @@

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

2+#if __GLASGOW_HASKELL__ >= 702

3+{-# LANGUAGE Trustworthy #-}

4+#endif

5+-- |

6+-- Module : Data.Text.Lazy.IO

9+-- License : BSD-style

10+-- Maintainer : bos@serpentine.com

11+-- Stability : experimental

12+-- Portability : GHC

13+--

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

18+

19+module Data.Text.Lazy.IO

20+ (

21+ -- * Performance

22+ -- $performance

23+

24+ -- * Locale support

25+ -- $locale

26+ -- * File-at-a-time operations

27+ readFile

28+ , writeFile

29+ , appendFile

30+ -- * Operations on handles

31+ , hGetContents

32+ , hGetLine

33+ , hPutStr

34+ , hPutStrLn

35+ -- * Special cases for standard input and output

36+ , interact

37+ , getContents

38+ , getLine

39+ , putStr

40+ , putStrLn

41+ ) where

42+

43+import Data.Text.Lazy (Text)

44+import Prelude hiding (appendFile, getContents, getLine, interact,

45+ putStr, putStrLn, readFile, writeFile)

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

47+ withFile)

48+import qualified Data.Text.IO as T

49+import qualified Data.Text.Lazy as L

50+import qualified Control.Exception as E

51+import Control.Monad (when)

52+import Data.IORef (readIORef)

53+import Data.Text.Internal.IO (hGetLineWith, readChunk)

54+import Data.Text.Internal.Lazy (chunk, empty)

55+import GHC.IO.Buffer (isEmptyBuffer)

56+import GHC.IO.Exception (IOException(..), IOErrorType(..), ioException)

57+import GHC.IO.Handle.Internals (augmentIOError, hClose_help,

58+ wantReadableHandle, withHandle)

59+import GHC.IO.Handle.Types (Handle__(..), HandleType(..))

60+import System.IO (BufferMode(..), hGetBuffering, hSetBuffering)

61+import System.IO.Error (isEOFError)

62+import 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.

78+

79+-- | Read a file and return its contents as a string. The file is

80+-- read lazily, as with 'getContents'.

81+readFile :: FilePath -> IO Text

82+readFile name = openFile name ReadMode >>= hGetContents

83+

84+-- | Write a string to a file. The file is truncated to zero length

85+-- before writing begins.

86+writeFile :: FilePath -> Text -> IO ()

87+writeFile p = withFile p WriteMode . flip hPutStr

88+

89+-- | Write a string the end of a file.

90+appendFile :: FilePath -> Text -> IO ()

91+appendFile p = withFile p AppendMode . flip hPutStr

92+

93+-- | Lazily read the remaining contents of a 'Handle'. The 'Handle'

94+-- will be closed after the read completes, or on error.

95+hGetContents :: 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))

109+

110+lazyRead :: Handle -> IO Text

111+lazyRead h = unsafeInterleaveIO $

112+ withHandle "hGetContents" h $ \hh -> do

113+ case haType hh of

114+ ClosedHandle -> return (hh, L.empty)

115+ SemiClosedHandle -> lazyReadBuffered h hh

116+ _ -> ioException

117+ (IOError (Just h) IllegalOperation "hGetContents"

118+ "illegal handle type" Nothing Nothing)

119+

120+lazyReadBuffered :: Handle -> Handle__ -> IO (Handle__, Text)

121+lazyReadBuffered h hh@Handle__{..} = do

122+ buf <- readIORef haCharBuffer

123+ (do t <- readChunk hh buf

124+ ts <- lazyRead h

125+ return (hh, chunk t ts)) `E.catch` \e -> do

126+ (hh', _) <- hClose_help hh

127+ if isEOFError e

128+ then return $ if isEmptyBuffer buf

129+ then (hh', empty)

130+ else (hh', L.singleton '\r')

131+ else E.throwIO (augmentIOError e "hGetContents" h)

132+

133+-- | Read a single line from a handle.

134+hGetLine :: Handle -> IO Text

135+hGetLine = hGetLineWith L.fromChunks

136+

137+-- | Write a string to a handle.

138+hPutStr :: Handle -> Text -> IO ()

139+hPutStr h = mapM_ (T.hPutStr h) . L.toChunks

140+

141+-- | Write a string to a handle, followed by a newline.

142+hPutStrLn :: Handle -> Text -> IO ()

143+hPutStrLn h t = hPutStr h t >> hPutChar h '\n'

144+

145+-- | The 'interact' function takes a function of type @Text -> Text@

146+-- as its argument. The entire input from the standard input device is

147+-- passed (lazily) to this function as its argument, and the resulting

148+-- string is output on the standard output device.

149+interact :: (Text -> Text) -> IO ()

150+interact f = putStr . f =<< getContents

151+

152+-- | Lazily read all user input on 'stdin' as a single string.

153+getContents :: IO Text

154+getContents = hGetContents stdin

155+

156+-- | Read a single line of user input from 'stdin'.

157+getLine :: IO Text

158+getLine = hGetLine stdin

159+

160+-- | Write a string to 'stdout'.

161+putStr :: Text -> IO ()

162+putStr = hPutStr stdout

163+

164+-- | Write a string to 'stdout', followed by a newline.

165+putStrLn :: Text -> IO ()

166+putStrLn = hPutStrLn stdout

167+

168+-- $locale

169+--

170+-- /Note/: The behaviour of functions in this module depends on the

171+-- version of GHC you are using.

172+--

173+-- Beginning with GHC 6.12, text I\/O is performed using the system or

174+-- handle's current locale and line ending conventions.

175+--

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

177+-- support/ locale-sensitive I\/O or line ending conversion. On these

178+-- versions of GHC, functions in this library all use UTF-8. What

179+-- does this mean in practice?

180+--

181+-- * All data that is read will be decoded as UTF-8.

182+--

183+-- * Before data is written, it is first encoded as UTF-8.

184+--

185+-- * On both reading and writing, the platform's native newline

186+-- conversion is performed.

187+--

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

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

190+--

191+-- > import qualified Data.ByteString.Lazy as B

192+-- > import Data.Text.Lazy (Text)

193+-- > import Data.Text.Lazy.Encoding (encodeUtf16)

194+-- >

195+-- > putStr_Utf16LE :: Text -> IO ()

196+-- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)

Data/Text/Lazy/Internal.hs+9−92

@@ -1,103 +1,20 @@

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, rtharper@aftereternity.co.uk,

8−-- duncan@haskell.org

7+-- Maintainer : bos@serpentine.com

98-- Stability : experimental

109-- Portability : GHC

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.

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+

1614module Data.Text.Lazy.Internal

15+ {-# DEPRECATED "Use Data.Text.Internal.Lazy instead" #-}

1716 (

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

17+ module Data.Text.Internal.Lazy

3118 ) where

3219

33−import qualified Data.Text.Internal as T

34−import qualified Data.Text as T

35−import Data.Typeable (Typeable)

36−import Data.Word (Word16)

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 32k, less the memory management overhead.

91−defaultChunkSize :: Int

92−defaultChunkSize = 32 * k - chunkOverhead

93− where k = 1024 `div` sizeOf (undefined :: Word16)

94−{-# INLINE defaultChunkSize #-}

95−

96−-- | Currently set to 4k, less the memory management overhead.

97−smallChunkSize :: Int

98−smallChunkSize = 4 * k - chunkOverhead

99− where k = 1024 `div` sizeOf (undefined :: Word16)

100−

101−-- | The memory management overhead. Currently this is tuned for GHC only.

102−chunkOverhead :: Int

103−chunkOverhead = 2 * sizeOf (undefined :: Int)

20+import Data.Text.Internal.Lazy

Data/Text/Lazy/Read.hsnew file+193

@@ -0,0 +1,193 @@

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/Read.hsnew file+201

@@ -0,0 +1,201 @@

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/Show.hsnew file+89

@@ -0,0 +1,89 @@

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+75−31

@@ -1,9 +1,9 @@

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

12-- |

23-- Module : Data.Text.Unsafe

3−-- Copyright : (c) Bryan O'Sullivan 2009

45-- License : BSD-style

5−-- Maintainer : bos@serpentine.com, rtharper@aftereternity.co.uk,

6−-- duncan@haskell.org

6+-- Maintainer : bos@serpentine.com

77-- Stability : experimental

88-- Portability : portable

99--

@@ -11,69 +11,113 @@

1111-- use in heavily tested code.

1212module Data.Text.Unsafe

1313 (

14− iter

14+ inlineInterleaveST

15+ , inlinePerformIO

16+ , unsafeDupablePerformIO

17+ , Iter(..)

18+ , iter

1519 , iter_

1620 , reverseIter

21+ , reverseIter_

1722 , unsafeHead

1823 , unsafeTail

24+ , lengthWord16

25+ , takeWord16

26+ , dropWord16

1927 ) where

20−

28+

29+#if defined(ASSERTS)

2130import Control.Exception (assert)

31+#endif

32+import Data.Text.Internal.Encoding.Utf16 (chr2)

2233import Data.Text.Internal (Text(..))

23−import Data.Text.UnsafeChar (unsafeChr)

24−import Data.Text.Encoding.Utf16 (chr2)

34+import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)

35+import Data.Text.Internal.Unsafe.Char (unsafeChr)

2536import qualified Data.Text.Array as A

37+import GHC.IO (unsafeDupablePerformIO)

2638

2739-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'

2840-- omits the check for the empty case, so there is an obligation on

2941-- the programmer to provide a proof that the 'Text' is non-empty.

3042unsafeHead :: Text -> Char

31−unsafeHead (Text arr off len)

43+unsafeHead (Text arr off _len)

3244 | m < 0xD800 || m > 0xDBFF = unsafeChr m

3345 | otherwise = chr2 m n

34− where m = assert (len > 0) $ A.unsafeIndex arr off

35− n = assert (len > 1) $ A.unsafeIndex arr (off+1)

46+ where m = A.unsafeIndex arr off

47+ n = A.unsafeIndex arr (off+1)

3648{-# INLINE unsafeHead #-}

3749

38−-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeHead'

50+-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'

3951-- omits the check for the empty case, so there is an obligation on

4052-- the programmer to provide a proof that the 'Text' is non-empty.

4153unsafeTail :: Text -> Text

4254unsafeTail t@(Text arr off len) =

43− assert (d <= len) $ Text arr (off+d) (len-d)

55+#if defined(ASSERTS)

56+ assert (d <= len) $

57+#endif

58+ Text arr (off+d) (len-d)

4459 where d = iter_ t 0

4560{-# INLINE unsafeTail #-}

4661

47−-- | /O(1)/ Iterate one step forwards through a UTF-16 array,

48−-- returning the current character and the delta to add to give the

49−-- next offset to iterate at.

50−iter :: Text -> Int -> (Char,Int)

51−iter (Text arr off len) i

52− | m < 0xD800 || m > 0xDBFF = (unsafeChr m, 1)

53− | otherwise = (chr2 m n, 2)

54− where m = assert (i < len) $ A.unsafeIndex arr j

55− n = assert (i + 1 < len) $ A.unsafeIndex arr k

56− j = assert (i >= 0) $ off + i

57− k = j + 1

62+data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int

63+

64+-- | /O(1)/ Iterate (unsafely) one step forwards through a UTF-16

65+-- array, returning the current character and the delta to add to give

66+-- the next offset to iterate at.

67+iter :: Text -> Int -> Iter

68+iter (Text arr off _len) i

69+ | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1

70+ | otherwise = Iter (chr2 m n) 2

71+ where m = A.unsafeIndex arr j

72+ n = A.unsafeIndex arr k

73+ j = off + i

74+ k = j + 1

5875{-# INLINE iter #-}

5976

6077-- | /O(1)/ Iterate one step through a UTF-16 array, returning the

6178-- delta to add to give the next offset to iterate at.

6279iter_ :: Text -> Int -> Int

63−iter_ (Text arr off len) i | m < 0xD800 || m > 0xDBFF = 1

64− | otherwise = 2

65− where m = assert (i >= 0 && i < len) $ A.unsafeIndex arr (off+i)

80+iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1

81+ | otherwise = 2

82+ where m = A.unsafeIndex arr (off+i)

6683{-# INLINE iter_ #-}

6784

6885-- | /O(1)/ Iterate one step backwards through a UTF-16 array,

6986-- returning the current character and the delta to add (i.e. a

7087-- negative number) to give the next offset to iterate at.

7188reverseIter :: Text -> Int -> (Char,Int)

72−reverseIter (Text arr off len) i

89+reverseIter (Text arr off _len) i

7390 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)

7491 | otherwise = (chr2 n m, -2)

75− where m = assert (i < len) $ A.unsafeIndex arr j

76− n = assert (i - 1 >= 0) $ A.unsafeIndex arr k

77− j = assert (i >= 0) $ off + i

78− k = j - 1

92+ where m = A.unsafeIndex arr j

93+ n = A.unsafeIndex arr k

94+ j = off + i

95+ k = j - 1

7996{-# INLINE reverseIter #-}

97+

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

119+

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

READMEdeleted−43

@@ -1,43 +0,0 @@

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.markdownnew file+42

@@ -0,0 +1,42 @@

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.

TODOdeleted−6

@@ -1,6 +0,0 @@

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/.gitignorenew file+1

@@ -0,0 +1 @@

1+dist

benchmarks/Setup.hsnew file+2

@@ -0,0 +1,2 @@

1+import Distribution.Simple

2+main = defaultMain

benchmarks/cbits/time_iconv.cnew file+35

@@ -0,0 +1,35 @@

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.hsnew file+79

@@ -0,0 +1,79 @@

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.hsnew file+75

@@ -0,0 +1,75 @@

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.hsnew file+67

@@ -0,0 +1,67 @@

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.hsnew file+33

@@ -0,0 +1,33 @@

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.hsnew file+38

@@ -0,0 +1,38 @@

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.hsnew file+33

@@ -0,0 +1,33 @@

1+-- | Benchmarks simple file reading

2+--

3+-- Tested in this benchmark:

4+--

5+-- * Reading a file from the disk

6+--

7+module 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.hsnew file+58

@@ -0,0 +1,58 @@

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.hsnew file+138

@@ -0,0 +1,138 @@

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.hsnew file+42

@@ -0,0 +1,42 @@

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.hsnew file+98

@@ -0,0 +1,98 @@

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.hsnew file+68

@@ -0,0 +1,68 @@

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.hsnew file+71

@@ -0,0 +1,71 @@

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.hsnew file+53

@@ -0,0 +1,53 @@

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.hsnew file+41

@@ -0,0 +1,41 @@

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.hsnew file+486

@@ -0,0 +1,486 @@

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.hsnew file+93

@@ -0,0 +1,93 @@

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.hsnew file+43

@@ -0,0 +1,43 @@

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.hsnew file+48

@@ -0,0 +1,48 @@

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.hsnew file+104

@@ -0,0 +1,104 @@

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.hsnew file+36

@@ -0,0 +1,36 @@

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.hsnew file+32

@@ -0,0 +1,32 @@

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.hsnew file+30

@@ -0,0 +1,30 @@

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/.gitignorenew file+2

@@ -0,0 +1,2 @@

1+__pycache__

2+*.pyc

benchmarks/python/cut.pynew file+12

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

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.pynew file+50

@@ -0,0 +1,50 @@

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.pynew file+13

@@ -0,0 +1,13 @@

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.pynew file+25

@@ -0,0 +1,25 @@

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.pynew file+18

@@ -0,0 +1,18 @@

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.rbnew file+16

@@ -0,0 +1,16 @@

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.rbnew file+50

@@ -0,0 +1,50 @@

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.rbnew file+15

@@ -0,0 +1,15 @@

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.rbnew file+22

@@ -0,0 +1,22 @@

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.rbnew file+14

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

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.cabalnew file+66

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

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.cnew file+311

@@ -0,0 +1,311 @@

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.mdnew file+164

@@ -0,0 +1,164 @@

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.hnew file+11

@@ -0,0 +1,11 @@

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+6−2

@@ -17,8 +17,12 @@ main = do

1717 S.difference a b

1818 text <- tidy "Data.Text"

1919 lazy <- tidy "Data.Text.Lazy"

20− putStrLn "In Data.Text:"

20+ list <- tidy "Data.List"

21+ putStrLn "Text \\ List:"

22+ diff text list

23+ putStrLn ""

24+ putStrLn "Text \\ Lazy:"

2125 diff text lazy

2226 putStrLn ""

23− putStrLn "In Data.Text.Lazy:"

27+ putStrLn "Lazy \\ Text:"

2428 diff lazy text

scripts/Arsec.hs+4−9

@@ -1,6 +1,7 @@

11module Arsec

22 (

3− comment

3+ Comment

4+ , comment

45 , semi

56 , showC

67 , unichar

@@ -23,13 +24,7 @@ import Text.ParserCombinators.Parsec.Combinator hiding (optional)

2324import Text.ParserCombinators.Parsec.Error

2425import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many)

2526

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

27+type Comment = String

3328

3429unichar :: Parser Char

3530unichar = chr . fst . head . readHex <$> many1 hexDigit

@@ -40,7 +35,7 @@ unichars = manyTill (unichar <* spaces) semi

4035semi :: Parser ()

4136semi = char ';' *> spaces *> pure ()

4237

43−comment :: Parser String

38+comment :: Parser Comment

4439comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"

4540

4641showC :: Char -> String

scripts/CaseFolding.hs+14−10

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

44

55module CaseFolding

66 (

7− Fold(..)

7+ CaseFolding(..)

8+ , Fold(..)

89 , parseCF

910 , mapCF

1011 ) where

@@ -18,25 +19,28 @@ data Fold = Fold {

1819 , name :: String

1920 } deriving (Eq, Ord, Show)

2021

21−entries :: Parser [Fold]

22−entries = many comment *> many (entry <* many comment)

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)

2327 where

2428 entry = Fold <$> unichar <* semi

2529 <*> oneOf "CFST" <* semi

2630 <*> unichars

2731 <*> (string "# " *> manyTill anyToken (char '\n'))

2832

29−parseCF :: FilePath -> IO (Either ParseError [Fold])

33+parseCF :: FilePath -> IO (Either ParseError CaseFolding)

3034parseCF name = parse entries name <$> readFile name

3135

32−mapCF :: [Fold] -> [String]

33−mapCF ms = typ ++ (map nice . filter p $ ms) ++ [last]

36+mapCF :: CaseFolding -> [String]

37+mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]

3438 where

35− typ = ["foldMapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char"

36− ,"{-# INLINE foldMapping #-}"]

37− last = "foldMapping c s = Yield (toLower c) (s :!: '\\0' :!: '\\0')"

39+ typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"

40+ ,"{-# NOINLINE foldMapping #-}"]

41+ last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"

3842 nice c = "-- " ++ name c ++ "\n" ++

39− "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (s :!: " ++ y ++ " :!: " ++ z ++ ")"

43+ "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"

4044 where [x,y,z] = (map showC . take 3) (mapping c ++ repeat '\0')

4145 p f = status f `elem` "CF" &&

4246 mapping f /= [toLower (code f)]

scripts/CaseMapping.hs+11−5

@@ -8,7 +8,7 @@ import SpecialCasing

88main = do

99 args <- getArgs

1010 let oname = case args of

11− [] -> "../Data/Text/Fusion/CaseMapping.hs"

11+ [] -> "../Data/Text/Internal/Fusion/CaseMapping.hs"

1212 [o] -> o

1313 psc <- parseSC "SpecialCasing.txt"

1414 pcf <- parseCF "CaseFolding.txt"

@@ -19,14 +19,20 @@ main = do

1919 Left err -> print err >> return undefined

2020 Right ms -> return ms

2121 h <- openFile oname WriteMode

22− mapM_ (hPutStrLn h) ["{-# LANGUAGE Rank2Types #-}"

22+ let comments = map ("--" ++) $

23+ take 2 (cfComments cfs) ++ take 2 (scComments scs)

24+ mapM_ (hPutStrLn h) $

25+ ["{-# LANGUAGE Rank2Types #-}"

2326 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"

24− ,"-- Generated by scripts/SpecialCasing.hs"

25− ,"module Data.Text.Fusion.CaseMapping where"

27+ ,"-- Generated by scripts/CaseMapping.hs"] ++

28+ comments ++

29+ [""

30+ ,"module Data.Text.Internal.Fusion.CaseMapping where"

2631 ,"import Data.Char"

27− ,"import Data.Text.Fusion.Internal"

32+ ,"import Data.Text.Internal.Fusion.Types"

2833 ,""]

2934 mapM_ (hPutStrLn h) (mapSC "upper" upper toUpper scs)

3035 mapM_ (hPutStrLn h) (mapSC "lower" lower toLower scs)

36+ mapM_ (hPutStrLn h) (mapSC "title" title toTitle scs)

3137 mapM_ (hPutStrLn h) (mapCF cfs)

3238 hClose h

scripts/SpecialCasing.hs+16−10

@@ -4,13 +4,17 @@

44

55module SpecialCasing

66 (

7− Case(..)

7+ SpecialCasing(..)

8+ , Case(..)

89 , parseSC

910 , mapSC

1011 ) where

1112

1213import Arsec

1314

15+data SpecialCasing = SC { scComments :: [Comment], scCasing :: [Case] }

16+ deriving (Show)

17+

1418data Case = Case {

1519 code :: Char

1620 , lower :: [Char]

@@ -20,8 +24,8 @@ data Case = Case {

2024 , name :: String

2125 } deriving (Eq, Ord, Show)

2226

23−entries :: Parser [Case]

24−entries = many comment *> many (entry <* many comment)

27+entries :: Parser SpecialCasing

28+entries = SC <$> many comment <*> many (entry <* many comment)

2529 where

2630 entry = Case <$> unichar <* semi

2731 <*> unichars

@@ -30,17 +34,19 @@ entries = many comment *> many (entry <* many comment)

3034 <*> manyTill anyToken (string "# ")

3135 <*> manyTill anyToken (char '\n')

3236

33−parseSC :: FilePath -> IO (Either ParseError [Case])

37+parseSC :: FilePath -> IO (Either ParseError SpecialCasing)

3438parseSC name = parse entries name <$> readFile name

3539

36−mapSC :: String -> (Case -> String) -> (Char -> Char) -> [Case] -> [String]

37−mapSC which access twiddle ms = typ ++ (map nice . filter p $ ms) ++ [last]

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]

3844 where

39− typ = [which ++ "Mapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char"

40− ,"{-# INLINE " ++ which ++ "Mapping #-}"]

41− last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (s :!: '\\0' :!: '\\0')"

45+ typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"

46+ ,"{-# NOINLINE " ++ which ++ "Mapping #-}"]

47+ last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (CC s '\\0' '\\0')"

4248 nice c = "-- " ++ name c ++ "\n" ++

43− which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (s :!: " ++ y ++ " :!: " ++ z ++ ")"

49+ which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"

4450 where [x,y,z] = (map showC . take 3) (access c ++ repeat '\0')

4551 p c = [k] /= a && a /= [twiddle k] && null (conditions c)

4652 where a = access c

tests-and-benchmarks.markdownnew file+63

@@ -0,0 +1,63 @@

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/.ghcinew file+1

@@ -0,0 +1 @@

1+:set -DHAVE_DEEPSEQ -isrc -i../..

tests/Bench.hsdeleted−171

@@ -1,171 +0,0 @@

1−import BenchUtils

2−import System.Mem

3−import Control.Concurrent

4−import Data.Char

5−import System.CPUTime

6−import System.IO

7−import System.IO.Unsafe

8−import Text.Printf

9−import Control.Exception

10−

11−import qualified Data.Text as T

12−import qualified Data.Text.Encoding as E

13−import Data.Text.Internal

14−import qualified Data.Text.Fusion as S

15−

16−import qualified Data.List as L

17−import qualified Data.ByteString.Char8 as B

18−import qualified Data.ByteString as B8

19−import Data.ByteString (ByteString)

20−import Data.Word

21−import qualified System.IO.UTF8 as UTF8

22−

23−main = do ascii_bs <- B.readFile "text/test/ascii.txt"

24− let ascii_txt = E.decodeASCII ascii_bs

25− let ascii_str = T.unpack ascii_txt

26− force (ascii_txt,ascii_str,ascii_bs)

27− printf " # Text\t\tString\tByteString\n"

28− run 1 (ascii_txt,ascii_str,ascii_bs) ascii_tests

29−

30−

31−ascii_tests = [

32− ("cons",

33− [F (app1 (T.cons '\88')),

34− F (app2 ((:) '\88') ),

35− F (app3 (B8.cons 88) )]),

36− ("head",

37− [F (app1 T.head),

38− F (app2 L.head),

39− F (app3 B.head)]),

40− ("last",

41− [F (app1 T.last),

42− F (app2 L.last),

43− F (app3 B.last)]),

44− ("tail",

45− [F (app1 T.tail),

46− F (app2 L.tail),

47− F (app3 B.tail)]),

48− ("init",

49− [F (app1 T.init),

50− Flist (app2 L.init),

51− F (app3 B.init) ]),

52− ("null",

53− [F (app1 T.null),

54− F (app2 L.null),

55− F (app3 B.null) ]),

56− ("length",

57− [F (app1 T.length),

58− F (app2 L.length),

59− F (app3 B.length)]),

60− ("map",

61− [F (app1 $ T.map succ),

62− Flist (app2 (L.map succ)),

63− F (app3 $ B.map succ)]),

64− ("filter",

65− [F $ app1 $ T.filter (/= '\101'),

66− Flist $ app2 $ L.filter (/= '\101'),

67− F $ app3 $ B8.filter (/= 101)]),

68− ("foldl'",

69− [F (app1 $ T.foldl' (\a w -> a+1::Int) 0),

70− F (app2 $ L.foldl' (\a w -> a+1::Int) 0),

71− F (app3 $ B.foldl' (\a w -> a+1::Int) 0)

72− ]),

73− ("drop",

74− [F (app1 $ T.drop 30000000),

75− Flist (app2 $ L.drop 30000000),

76− F (app3 $ B.drop 30000000)

77− ]),

78− ("take",

79− [F (app1 $ T.take 30000000),

80− Flist (app2 $ L.take 30000000),

81− F (app3 $ B.take 30000000)]),

82− ("words",

83− [F (app1 $ T.words),

84− Flist (app2 $ L.words),

85− F (app3 $ B.words)])

86− ]

87−

88−bmp_tests = [

89− ("cons",

90− [F (app1 (T.cons '\88')),

91− F (app2 ((:) '\88') )]),

92− ("head",

93− [F (app1 T.head),

94− F (app2 L.head)]),

95− ("last",

96− [F (app1 T.last),

97− F (app2 L.last)]),

98− ("tail",

99− [F (app1 T.tail),

100− F (app2 L.tail)]),

101− ("init",

102− [F (app1 T.init),

103− Flist (app2 L.init)]),

104− ("null",

105− [F (app1 T.null),

106− F (app2 L.null),

107− F (app3 B.null)]),

108− ("length",

109− [F (app1 T.length),

110− F (app2 L.length),

111− F (app3 B.length)]),

112− ("map",

113− [F (app1 $ T.map succ),

114− Flist (app2 (L.map succ))]),

115− ("filter",

116− [F $ app1 $ T.filter (/= '\101'),

117− Flist $ app2 $ L.filter (/= '\101')]),

118− ("foldl'",

119− [F (app1 $ T.foldl' (\a w -> a+1::Int) 0),

120− F (app2 $ L.foldl' (\a w -> a+1::Int) 0)]),

121− ("drop",

122− [F (app1 $ T.drop 30000000),

123− Flist (app2 $ L.drop 30000000)]),

124− ("take",

125− [F (app1 $ T.take 30000000),

126− Flist (app2 $ L.take 30000000)]),

127− ("words",

128− [F (app1 $ T.words),

129− Flist (app2 $ L.words)])

130− ]

131−

132−smp_sip_tests = [

133− ("cons",

134− [F (app1 (T.cons '\65624')),

135− F (app2 ((:) '\65624'))]),

136− ("head",

137− [F (app1 T.head),

138− F (app2 L.head)]),

139− ("last",

140− [F (app1 T.last),

141− F (app2 L.last)]),

142− ("tail",

143− [F (app1 T.tail),

144− F (app2 L.tail)]),

145− ("init",

146− [F (app1 T.init),

147− Flist (app2 L.init)]),

148− ("null",

149− [F (app1 T.null),

150− F (app2 L.null),

151− F (app3 B.null) ]),

152− ("length",

153− [F (app1 T.length ),

154− F (app2 L.length),

155− F (app3 B.length)]),

156− ("map",

157− [F (app1 $ T.map succ),

158− Flist (app2 (L.map succ))]),

159− ("filter",

160− [F $ app1 $ T.filter (/= '\65624'),

161− Flist $ app2 $ L.filter (/= '\65624')]),

162− ("foldl'",

163− [F (app1 $ T.foldl' (\a w -> a+1::Int) 0),

164− F (app2 $ L.foldl' (\a w -> a+1::Int) 0)]),

165− ("drop",

166− [F (app1 $ T.drop 30000000),

167− Flist (app2 $ L.drop 30000000)]),

168− ("take",

169− [F (app1 $ T.take 30000000),

170− Flist (app2 $ L.take 30000000)])

171− ]

tests/BenchUtils.hsdeleted−79

@@ -1,79 +0,0 @@

1−{-# LANGUAGE ExistentialQuantification #-}

2−module BenchUtils where

3−

4−import qualified Data.List as L

5−import Data.ByteString (ByteString(..))

6−import Data.Word

7−import Text.Printf

8−import System.IO

9−import Data.Text.Internal (Text(..))

10−import System.Mem

11−import System.CPUTime

12−import Control.Exception

13−import Control.Concurrent

14−

15−data Result = T | B

16−

17−data F a = forall b. F (a -> b) | forall b. Flist (a -> [b])

18−

19−class Forceable a where

20− force :: a -> IO Result

21− force v = v `seq` return T

22−

23−instance Forceable Text

24−

25−seqList = L.foldl' (flip seq) (return ())

26−instance Forceable [a] where

27− force = L.foldl' (flip seq) (return T)

28−

29−instance Forceable ByteString

30−instance Forceable Char

31−instance Forceable Bool

32−instance Forceable Int

33−instance Forceable Word8

34−

35−instance (Forceable a, Forceable b) => Forceable (a,b) where

36− force (a,b) = force a >> force b

37−

38−instance (Forceable a, Forceable b, Forceable c) => Forceable (a,b,c) where

39− force (a,b,c) = force a >> force b >> force c

40−

41−run c x tests = sequence_ $ zipWith (runTest c x) [1..] tests

42−

43−runTest :: Int -> a -> Int -> (String,[F a]) -> IO ()

44−runTest count x n (name,tests) = do

45− printf "%2d " n

46− fn tests

47− printf "\t# %-16s\n" (show name)

48− hFlush stdout

49− where fn xs = case xs of

50− [f,g,h] -> runN count f x >> putStr "\t"

51− >> runN count g x >> putStr "\t"

52− >> runN count h x >> putStr "\t"

53− [f,g] -> runN count f x >> putStr "\t"

54− >> runN count g x >> putStr "\t\t"

55− [f] -> runN count f x >> putStr "\t\t\t"

56− _ -> return ()

57− run f x = performGC >> threadDelay 100 >> time f x

58− runN 0 f x = return ()

59− runN c f x = run f x >> runN (c-1) f x

60−

61−time (Flist f) a = do

62− start <- getCPUTime

63− v <- seqList (f a)

64− end <- getCPUTime

65− let diff = (fromIntegral (end - start)) / 10^12

66− printf "%0.3f" (diff :: Double)

67− hFlush stdout

68−

69−time (F f) a = do

70− start <- getCPUTime

71− v <- evaluate (f a)

72− end <- getCPUTime

73− let diff = (fromIntegral (end - start)) / 10^12

74− printf "%0.3f" (diff :: Double)

75− hFlush stdout

76−

77−app1 f (x,y,z) = f x

78−app2 f (x,y,z) = f y

79−app3 f (x,y,z) = f z

tests/EncodingBench.hsdeleted−106

@@ -1,106 +0,0 @@

1−{-# LANGUAGE ExistentialQuantification #-}

2−

3−import BenchUtils

4−import qualified Data.Text.Utf8.Fusion as U8

5−import qualified Data.Text.Utf8.Internal as U8I

6−import qualified Data.Text.Utf32.Fusion as U32

7−import qualified Data.Text.Utf32.Internal as U32I

8−import qualified Data.Text.Fusion as S

9−import Data.Text.Fusion (bsStream,Encoding(..))

10−import qualified Data.Text as T

11−import qualified Data.ByteString as B

12−import Text.Printf

13−import System.Mem

14−

15−instance Forceable U32I.Text

16−instance Forceable U8I.Text

17−

18−data E a = forall b. E (a -> b) | EText (a -> S.Stream Char)

19−

20−main = do force (ascii_tests, smp_sip_tests)

21− ascii <- B.readFile "ascii.txt"

22− let ascii8 = U8.unstream (bsStream ascii ASCII)

23− let ascii16 = S.unstream (bsStream ascii ASCII)

24− let ascii32 = U32.unstream (bsStream ascii ASCII)

25− force (ascii8, ascii16, ascii32)

26− printf " # Utf8\t\tUtf16\tUtf32\n"

27− run 1 (ascii8, ascii16, ascii32) ascii_tests

28− performGC

29− bmp <- B.readFile "bmp.txt"

30− let bmp8 = U8.unstream (bsStream bmp Utf8)

31− let bmp16 = S.unstream (bsStream bmp Utf8)

32− let bmp32 = U32.unstream (bsStream bmp Utf8)

33− force (bmp8, bmp16, bmp32)

34− printf " # Utf8\t\tUtf16\tUtf32\n"

35− run 1 (bmp8, bmp16, bmp32) ascii_tests

36− performGC

37− smp_sip <- B.readFile "smp_sip.txt"

38− let smp_sip8 = U8.unstream (bsStream smp_sip Utf8)

39− let smp_sip16 = S.unstream (bsStream smp_sip Utf8)

40− let smp_sip32 = U32.unstream (bsStream smp_sip Utf8)

41− force (smp_sip8, smp_sip16, smp_sip32)

42− printf " # Utf8\t\tUtf16\tUtf32\n"

43− run 1 (smp_sip8, smp_sip16, smp_sip32) smp_sip_tests

44−

45−ascii_tests = [

46− ("cons" ,

47− [F $ app1 $ U8.unstream . S.cons '\88' . U8.stream,

48− F $ app2 $ S.unstream . S.cons '\88' . S.stream,

49− F $ app3 $ U32.unstream . S.cons '\88' . U32.stream]),

50− ("length",

51− [F $ app1 $ S.length . U8.stream,

52− F $ app2 $ S.length . S.stream,

53− F $ app3 $ S.length . U32.stream]),

54− ("map" ,

55− [F $ app1 $ U8.unstream . S.map succ . U8.stream,

56− F $ app2 $ S.unstream . S.map succ . S.stream,

57− F $ app3 $ U32.unstream . S.map succ . U32.stream]),

58− ("filter",

59− [F $ app1 $ U8.unstream . S.filter (/= '\101') . U8.stream,

60− F $ app2 $ S.unstream . S.filter (/= '\101') . S.stream,

61− F $ app3 $ U32.unstream . S.filter (/= '\101') . U32.stream]),

62− ("take",

63− [F $ app1 $ U8.unstream . S.take 1000000 . U8.stream,

64− F $ app2 $ S.unstream . S.take 1000000 . S.stream,

65− F $ app3 $ U32.unstream . S.take 1000000 . U32.stream]),

66− ("drop" ,

67− [F $ app1 $ U8.unstream . S.drop 1000000 . U8.stream,

68− F $ app2 $ S.unstream . S.drop 1000000 . S.stream,

69− F $ app3 $ U32.unstream . S.drop 1000000 . U32.stream]),

70− ("foldl'",

71− [F $ app1 $ S.foldl' (\a w -> a+1::Int) 0 . U8.stream,

72− F $ app2 $ S.foldl' (\a w -> a+1::Int) 0 . S.stream,

73− F $ app3 $ S.foldl' (\a w -> a+1::Int) 0 . U32.stream

74− ])

75− ]

76−

77−smp_sip_tests = [

78− ("cons" ,

79− [F $ app1 $ U8.unstream . S.cons '\88' . U8.stream,

80− F $ app2 $ S.unstream . S.cons '\88' . S.stream,

81− F $ app3 $ U32.unstream . S.cons '\88' . U32.stream]),

82− ("length",

83− [F $ app1 $ S.length . U8.stream,

84− F $ app2 $ S.length . S.stream,

85− F $ app3 $ S.length . U32.stream]),

86− ("map" ,

87− [F $ app1 $ U8.unstream . S.map succ . U8.stream,

88− F $ app2 $ S.unstream . S.map succ . S.stream,

89− F $ app3 $ U32.unstream . S.map succ . U32.stream]),

90− ("filter",

91− [F $ app1 $ U8.unstream . S.filter (/= '\101') . U8.stream,

92− F $ app2 $ S.unstream . S.filter (/= '\101') . S.stream,

93− F $ app3 $ U32.unstream . S.filter (/= '\101') . U32.stream]),

94− ("take",

95− [F $ app1 $ U8.unstream . S.take 1000000 . U8.stream,

96− F $ app2 $ S.unstream . S.take 1000000 . S.stream,

97− F $ app3 $ U32.unstream . S.take 1000000 . U32.stream]),

98− ("drop" ,

99− [F $ app1 $ U8.unstream . S.drop 1000000 . U8.stream,

100− F $ app2 $ S.unstream . S.drop 1000000 . S.stream,

101− F $ app3 $ U32.unstream . S.drop 1000000 . U32.stream]),

102− ("foldl'",

103− [F $ app1 $ S.foldl' (\a w -> a+1::Int) 0 . U8.stream,

104− F $ app2 $ S.foldl' (\a w -> a+1::Int) 0 . S.stream,

105− F $ app3 $ S.foldl' (\a w -> a+1::Int) 0 . U32.stream])

106− ]

tests/FusionBench.hsdeleted−53

@@ -1,53 +0,0 @@

1−import Prelude hiding (zip,zip3)

2−

3−import BenchUtils

4−import Data.Char

5−import qualified Data.List as L

6−import qualified Data.ByteString as B

7−import qualified Data.Text as T

8−import Data.Text.Fusion (Encoding(..))

9−import qualified Data.Text.Fusion as S

10−import Text.Printf

11−import System.IO

12−import System.Mem

13−import qualified System.IO.UTF8 as UTF8

14−

15−main = do ascii_str <- readFile "ascii.txt"

16− ascii_bs <- B.readFile "ascii.txt"

17− let ascii_txt = T.decode ASCII ascii_bs

18− force (ascii_txt,ascii_str,ascii_bs)

19− printf " # Text\t\tString\tByteString\n"

20− run 1 (ascii_txt,ascii_str,ascii_bs) ascii_tests

21−

22−trd (a,b,c) = c

23−

24−ascii_tests = [

25− ("map/map",

26− [F $ T.map pred . T.map succ . fst,

27− Flist $ L.map pred . L.map succ . snd,

28− F $ B.map pred . B.map succ . trd]),

29− ("filter/filter",

30− [F $ T.filter (/= '\101') . T.filter (/= '\102') . fst,

31− Flist $ L.filter (/= '\101') . L.filter (/= '\102') . snd,

32− F $ B.filter (/= 101) . B.filter (/= 102) . trd]),

33− ("filter/map",

34− [F $ T.filter (/= '\103') . T.map succ . fst,

35− Flist $ L.filter (/= '\103') . L.map succ . snd,

36− F $ B.filter (/= 103) . B.map succ . trd]),

37− ("map/filter",

38− [F $ T.map succ . T.filter (/= '\104') . fst,

39− Flist $ L.map succ . L.filter (/= '\104') . snd,

40− F $ B.map succ . B.filter (/= 104) . trd]),

41− ("foldl'/map",

42− [F $ T.foldl' (const . (+1)) (0 :: Int) . T.map succ . fst,

43− F $ L.foldl' (const . (+1)) (0 :: Int) . L.map succ . snd,

44− F $ B.foldl' (const . (+1)) (0 :: Int) . B.map succ . trd]),

45− ("foldl'/filter",

46− [F $ T.foldl' (const . (+2)) (0::Int) . T.filter (/= '\105') . fst,

47− F $ L.foldl' (const . (+2)) (0::Int) . L.filter (/= '\105') . snd,

48− F $ B.foldl' (const . (+2)) (0::Int) . B.filter (/= 105) . trd]),

49− ("foldl'/map/filter",

50− [F $ T.foldl' (const.(+3)) (0::Int) . T.map succ . T.filter (/='\110') . fst,

51− F $ L.foldl' (const.(+3)) (0::Int) . L.map succ . L.filter (/='\110') . snd,

52− F $ B.foldl' (const . (+3)) (0::Int) . B.map succ . B.filter (/= 110) . trd])

53− ]

tests/LiteralRuleTest.hsnew file+21

@@ -0,0 +1,21 @@

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+29−58

@@ -1,69 +1,40 @@

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 \

5− -package bytestring -package QuickCheck -package test-framework \

6− -package test-framework-quickcheck -ignore-package text \

7− -fno-ignore-asserts

8−ghc-base-flags += -Wall -fno-warn-orphans -fno-warn-missing-signatures

9−ghc-flags := $(ghc-base-flags) -i../dist/build -package-name text-$(version)

10−ghc-hpc-flags := $(ghc-base-flags) -fhpc -fno-ignore-asserts -odir hpcdir \

11− -hidir hpcdir -i..

12−lib := ../dist/build/libHStext-$(version).a

13−lib-srcs := $(shell grep '^ *Data' ../text.cabal | \

14− sed -e 's,\.,/,g' -e 's,$$,.hs,')

1+count = 1000

152

16−cabal := $(shell which cabal 2>/dev/null)

3+all: coverage literal-rule-test

174

18−all: qc coverage

5+literal-rule-test:

6+ ./literal-rule-test.sh

197

20−lib: $(lib)

8+coverage: build coverage/hpc_index.html

219

22−$(lib): $(lib-srcs:%=../%)

23−ifeq ($(cabal),)

24− cd .. && runghc Setup configure --user --prefix=$(HOME)

25− cd .. && runghc Setup build

26−else

27− cd .. && cabal configure

28− cd .. && cabal build

29−endif

10+build: text-test-data

11+ cabal configure -fhpc

12+ cabal build

3013

31−Properties.o: QuickCheckUtils.o SlowFunctions.o

14+text-test-data:

15+ hg clone https://bitbucket.org/bos/text-test-data

16+ $(MAKE) -C text-test-data

3217

33−QuickCheckUtils.o: $(lib)

18+coverage/text-tests.tix:

19+ -mkdir -p coverage

20+ ./dist/build/text-tests/text-tests -a $(count)

21+ mv text-tests.tix $@

3422

35−qc: Properties.o QuickCheckUtils.o SlowFunctions.o

36− $(ghc) $(ghc-flags) -threaded -o $@ $^ $(lib)

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

3727

38−sb: SearchBench.o

39− $(ghc) $(ghc-flags) -threaded -o $@ $^ $(lib)

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

4033

41−qc-hpc: Properties.hs QuickCheckUtils.hs $(lib-srcs:%=../%)

42− -mkdir -p hpcdir

43− @rm -f $@.tix

44− $(ghc) $(ghc-hpc-flags) $(ghc-opt-flags) -ihpcdir \

45− --make -threaded -o $@ $<

46−

47−coverage: qc-hpc-html/hpc_index.html

48−

49−qc-hpc-html/hpc_index.html: qc-hpc

50− ./qc-hpc -a 100 +RTS -N2

51− hpc markup qc-hpc --exclude=Main --exclude=Properties \

52− --exclude=Data.Text.Fusion.CaseMapping \

53− --exclude=QuickCheckUtils --srcdir=.. --srcdir=. --destdir=$(dir $@)

54−

55−SearchBench.o: ghc-opt-flags = -O

56−%.o: %.hs

57− $(ghc) $(ghc-flags) $(ghc-opt-flags) -c -o $@ $<

58−

59−hpcdir/%.o: %.hs

60− $(ghc) $(ghc-hpc-flags) $(ghc-opt-flags) --make -c -o $@ $<

61−

62−.PHONY: testdata

63−testdata: text-testdata.tar.bz2

64−

65−text-testdata.tar.bz2:

66− curl -O http://projects.haskell.org/text/text-testdata.tar.bz2

34+coverage/hpc_index.html: coverage/coverage.tix

35+ hpc markup --destdir=coverage coverage/coverage.tix

6736

6837clean:

69− -rm -rf *.o *.hi *.tix qc qc-hpc hpcdir .hpc qc-hpc-html

38+ rm -rf dist coverage .hpc

39+

40+.PHONY: build coverage all literal-rule-test

tests/Properties.hsdeleted−888

@@ -1,888 +0,0 @@

1−{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,

2− ScopedTypeVariables, TypeSynonymInstances #-}

3−{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}

4−

5−import Test.QuickCheck hiding (evaluate)

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.Encoding as E

18−import Control.Exception (SomeException, evaluate, try)

19−import qualified Data.Text.Fusion as S

20−import qualified Data.Text.Fusion.Common as S

21−import Data.Text.Fusion.Size

22−import qualified Data.Text.Lazy.Encoding as EL

23−import qualified Data.Text.Lazy.Fusion as SL

24−import qualified Data.Text.UnsafeShift as U

25−import qualified Data.List as L

26−import Prelude hiding (replicate)

27−import System.IO.Unsafe (unsafePerformIO)

28−import Test.Framework (defaultMain, testGroup)

29−import Test.Framework.Providers.QuickCheck (testProperty)

30−import Data.Text.Search (indices)

31−import qualified Data.Text.Lazy.Search as S (indices)

32−import qualified SlowFunctions as Slow

33−

34−import QuickCheckUtils (NotEmpty(..), small)

35−

36−-- Ensure that two potentially bottom values (in the sense of crashing

37−-- for some inputs, not looping infinitely) either both crash, or both

38−-- give comparable results for some input.

39−(=^=) :: (Eq a, Show a) => a -> a -> Bool

40−{-# NOINLINE (=^=) #-}

41−i =^= j = unsafePerformIO $ do

42− x <- try (evaluate i)

43− y <- try (evaluate j)

44− case (x,y) of

45− (Left (_ :: SomeException), Left (_ :: SomeException))

46− -> return True

47− (Right a, Right b) -> return (a == b)

48− e -> trace ("*** Divergence: " ++ show e) return False

49−infix 4 =^=

50−

51−t_pack_unpack = (T.unpack . T.pack) `eq` id

52−tl_pack_unpack = (TL.unpack . TL.pack) `eq` id

53−t_stream_unstream = (S.unstream . S.stream) `eq` id

54−tl_stream_unstream = (SL.unstream . SL.stream) `eq` id

55−t_reverse_stream t = (S.reverse . S.reverseStream) t == t

56−t_singleton c = [c] == (T.unpack . T.singleton) c

57−tl_singleton c = [c] == (TL.unpack . TL.singleton) c

58−tl_unstreamChunks x = f 11 x == f 1000 x

59− where f n = SL.unstreamChunks n . S.streamList

60−tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id

61−

62−t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a

63− where a = T.map (\c -> chr (ord c `mod` 128)) t

64−t_utf8 = (E.decodeUtf8 . E.encodeUtf8) `eq` id

65−tl_utf8 = (EL.decodeUtf8 . EL.encodeUtf8) `eq` id

66−t_utf16LE = (E.decodeUtf16LE . E.encodeUtf16LE) `eq` id

67−t_utf16BE = (E.decodeUtf16BE . E.encodeUtf16BE) `eq` id

68−t_utf32LE = (E.decodeUtf32LE . E.encodeUtf32LE) `eq` id

69−t_utf32BE = (E.decodeUtf32BE . E.encodeUtf32BE) `eq` id

70−

71−class Stringy s where

72− packS :: String -> s

73− unpackS :: s -> String

74− splitAtS :: Int -> s -> (s,s)

75− packSChunkSize :: Int -> String -> s

76− packSChunkSize _ = packS

77−

78−instance Stringy String where

79− packS = id

80− unpackS = id

81− splitAtS = splitAt

82−

83−instance Stringy (S.Stream Char) where

84− packS = S.streamList

85− unpackS = S.unstreamList

86− splitAtS n s = (S.take n s, S.drop n s)

87−

88−instance Stringy T.Text where

89− packS = T.pack

90− unpackS = T.unpack

91− splitAtS = T.splitAt

92−

93−instance Stringy TL.Text where

94− packSChunkSize k = SL.unstreamChunks k . S.streamList

95− packS = TL.pack

96− unpackS = TL.unpack

97− splitAtS = TL.splitAt . fromIntegral

98−

99−-- Do two functions give the same answer?

100−eq :: (Eq a, Show a) => (t -> a) -> (t -> a) -> t -> Bool

101−eq a b s = a s =^= b s

102−

103−-- What about with the RHS packed?

104−eqP :: (Eq a, Show a, Stringy s) =>

105− (String -> a) -> (s -> a) -> String -> Word8 -> Bool

106−eqP f g s w = eql "orig" (f s) (g t) &&

107− eql "mini" (f s) (g mini) &&

108− eql "head" (f sa) (g ta) &&

109− eql "tail" (f sb) (g tb)

110− where t = packS s

111− mini = packSChunkSize 10 s

112− (sa,sb) = splitAt m s

113− (ta,tb) = splitAtS m t

114− l = length s

115− m | l == 0 = n

116− | otherwise = n `mod` l

117− n = fromIntegral w

118− eql d a b | a =^= b = True

119− | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False

120−

121−-- For tests that have O(n^2) running times or input sizes, resize

122−-- their inputs to the square root of the originals.

123−unsquare :: (Arbitrary a, Show a, Testable b) => (a -> b) -> Property

124−unsquare = forAll . sized $ \n -> resize (smallish n) arbitrary

125− where smallish = round . (sqrt :: Double -> Double) . fromIntegral

126−

127−s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)

128− where _types = s :: String

129−sf_Eq p s =

130− ((L.filter p s==) . L.filter p) `eq`

131− (((S.filter p $ S.streamList s)==) . S.filter p . S.streamList)

132−t_Eq s = (s==) `eq` ((T.pack s==) . T.pack)

133−tl_Eq s = (s==) `eq` ((TL.pack s==) . TL.pack)

134−s_Ord s = (compare s) `eq` (compare (S.streamList s) . S.streamList)

135− where _types = s :: String

136−sf_Ord p s =

137− ((compare $ L.filter p s) . L.filter p) `eq`

138− (compare (S.filter p $ S.streamList s) . S.filter p . S.streamList)

139−t_Ord s = (compare s) `eq` (compare (T.pack s) . T.pack)

140−tl_Ord s = (compare s) `eq` (compare (TL.pack s) . TL.pack)

141−t_Read = id `eq` (T.unpack . read . show)

142−tl_Read = id `eq` (TL.unpack . read . show)

143−t_Show = show `eq` (show . T.pack)

144−tl_Show = show `eq` (show . TL.pack)

145−t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))

146−tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))

147−t_mconcat = unsquare (mconcat `eq` (unpackS . mconcat . L.map T.pack))

148−tl_mconcat = unsquare (mconcat `eq` (unpackS . mconcat . L.map TL.pack))

149−t_IsString = fromString `eqP` (T.unpack . fromString)

150−tl_IsString = fromString `eqP` (TL.unpack . fromString)

151−

152−s_cons x = (x:) `eqP` (unpackS . S.cons x)

153−s_cons_s x = (x:) `eqP` (unpackS . S.unstream . S.cons x)

154−sf_cons p x = ((x:) . L.filter p) `eqP` (unpackS . S.cons x . S.filter p)

155−t_cons x = (x:) `eqP` (unpackS . T.cons x)

156−tl_cons x = (x:) `eqP` (unpackS . TL.cons x)

157−s_snoc x = (++ [x]) `eqP` (unpackS . (flip S.snoc) x)

158−t_snoc x = (++ [x]) `eqP` (unpackS . (flip T.snoc) x)

159−tl_snoc x = (++ [x]) `eqP` (unpackS . (flip TL.snoc) x)

160−s_append s = (s++) `eqP` (unpackS . S.append (S.streamList s))

161−s_append_s s = (s++) `eqP` (unpackS . S.unstream . S.append (S.streamList s))

162−sf_append p s = (L.filter p s++) `eqP` (unpackS . S.append (S.filter p $ S.streamList s))

163−t_append s = (s++) `eqP` (unpackS . T.append (packS s))

164−

165−uncons (x:xs) = Just (x,xs)

166−uncons _ = Nothing

167−

168−s_uncons = uncons `eqP` (fmap (second unpackS) . S.uncons)

169−sf_uncons p = (uncons . L.filter p) `eqP` (fmap (second unpackS) . S.uncons . S.filter p)

170−t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)

171−tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)

172−s_head = head `eqP` S.head

173−sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)

174−t_head = head `eqP` T.head

175−tl_head = head `eqP` TL.head

176−s_last = last `eqP` S.last

177−sf_last p = (last . L.filter p) `eqP` (S.last . S.filter p)

178−t_last = last `eqP` T.last

179−tl_last = last `eqP` TL.last

180−s_tail = tail `eqP` (unpackS . S.tail)

181−s_tail_s = tail `eqP` (unpackS . S.unstream . S.tail)

182−sf_tail p = (tail . L.filter p) `eqP` (unpackS . S.tail . S.filter p)

183−t_tail = tail `eqP` (unpackS . T.tail)

184−tl_tail = tail `eqP` (unpackS . TL.tail)

185−s_init = init `eqP` (unpackS . S.init)

186−s_init_s = init `eqP` (unpackS . S.unstream . S.init)

187−sf_init p = (init . L.filter p) `eqP` (unpackS . S.init . S.filter p)

188−t_init = init `eqP` (unpackS . T.init)

189−tl_init = init `eqP` (unpackS . TL.init)

190−s_null = null `eqP` S.null

191−sf_null p = (null . L.filter p) `eqP` (S.null . S.filter p)

192−t_null = null `eqP` T.null

193−tl_null = null `eqP` TL.null

194−s_length = length `eqP` S.length

195−sf_length p = (length . L.filter p) `eqP` (S.length . S.filter p)

196−t_length = length `eqP` T.length

197−tl_length = length `eqP` (fromIntegral . TL.length)

198−

199−s_map f = map f `eqP` (unpackS . S.map f)

200−s_map_s f = map f `eqP` (unpackS . S.unstream . S.map f)

201−sf_map p f = (map f . L.filter p) `eqP` (unpackS . S.map f . S.filter p)

202−t_map f = map f `eqP` (unpackS . T.map f)

203−tl_map f = map f `eqP` (unpackS . TL.map f)

204−t_intercalate c = unsquare (L.intercalate c `eq` (unpackS . T.intercalate (packS c) . map packS))

205−tl_intercalate c = unsquare (L.intercalate c `eq` (unpackS . TL.intercalate (TL.pack c) . map TL.pack))

206−s_intersperse c = L.intersperse c `eqP` (unpackS . S.intersperse c)

207−s_intersperse_s c = L.intersperse c `eqP` (unpackS . S.unstream . S.intersperse c)

208−sf_intersperse p c= (L.intersperse c . L.filter p) `eqP` (unpackS . S.intersperse c . S.filter p)

209−t_intersperse c = L.intersperse c `eqP` (unpackS . T.intersperse c)

210−tl_intersperse c = L.intersperse c `eqP` (unpackS . TL.intersperse c)

211−t_transpose = unsquare (L.transpose `eq` (map unpackS . T.transpose . map packS))

212−tl_transpose = unsquare (L.transpose `eq` (map unpackS . TL.transpose . map TL.pack))

213−t_reverse = L.reverse `eqP` (unpackS . T.reverse)

214−tl_reverse = L.reverse `eqP` (unpackS . TL.reverse)

215−t_reverse_short n = L.reverse `eqP` (unpackS . S.reverse . shorten n . S.stream)

216−

217−t_replace s d = (L.intercalate d . split s) `eqP` (unpackS . T.replace (T.pack s) (T.pack d))

218−tl_replace s d = (L.intercalate d . split s) `eqP` (unpackS . TL.replace (TL.pack s) (TL.pack d))

219−

220−split :: (Eq a) => [a] -> [a] -> [[a]]

221−split pat src0

222− | l == 0 = error "empty"

223− | otherwise = go src0

224− where

225− l = length pat

226− go src = search 0 src

227− where

228− search _ [] = [src]

229− search !n s@(_:s')

230− | pat `L.isPrefixOf` s = take n src : go (drop l s)

231− | otherwise = search (n+1) s'

232−

233−s_toCaseFold_length xs = S.length (S.toCaseFold s) >= length xs

234− where s = S.streamList xs

235−sf_toCaseFold_length p xs =

236− (S.length . S.toCaseFold . S.filter p $ s) >= (length . L.filter p $ xs)

237− where s = S.streamList xs

238−t_toCaseFold_length t = T.length (T.toCaseFold t) >= T.length t

239−tl_toCaseFold_length t = TL.length (TL.toCaseFold t) >= TL.length t

240−t_toLower_length t = T.length (T.toLower t) >= T.length t

241−t_toLower_lower t = p (T.toLower t) >= p t

242− where p = T.length . T.filter isLower

243−tl_toLower_lower t = p (TL.toLower t) >= p t

244− where p = TL.length . TL.filter isLower

245−t_toUpper_length t = T.length (T.toUpper t) >= T.length t

246−t_toUpper_upper t = p (T.toUpper t) >= p t

247− where p = T.length . T.filter isUpper

248−tl_toUpper_upper t = p (TL.toUpper t) >= p t

249− where p = TL.length . TL.filter isUpper

250−

251−justifyLeft k c s = s ++ L.replicate (k - length s) c

252−justifyRight m n s = L.replicate (m - length s) n ++ s

253−

254−s_justifyLeft k c = justifyLeft k c `eqP` (unpackS . S.justifyLeftI k c)

255−s_justifyLeft_s k c = justifyLeft k c `eqP` (unpackS . S.unstream . S.justifyLeftI k c)

256−sf_justifyLeft p k c =

257− (justifyLeft k c . L.filter p) `eqP` (unpackS . S.justifyLeftI k c . S.filter p)

258−t_justifyLeft k c = justifyLeft k c `eqP` (unpackS . T.justifyLeft k c)

259−tl_justifyLeft k c = justifyLeft k c `eqP` (unpackS . TL.justifyLeft (fromIntegral k) c)

260−t_justifyRight k c = justifyRight k c `eqP` (unpackS . T.justifyRight k c)

261−tl_justifyRight k c = justifyRight k c `eqP` (unpackS . TL.justifyRight (fromIntegral k) c)

262−

263−sf_foldl p f z = (L.foldl f z . L.filter p) `eqP` (S.foldl f z . S.filter p)

264− where _types = f :: Char -> Char -> Char

265−t_foldl f z = L.foldl f z `eqP` (T.foldl f z)

266− where _types = f :: Char -> Char -> Char

267−tl_foldl f z = L.foldl f z `eqP` (TL.foldl f z)

268− where _types = f :: Char -> Char -> Char

269−sf_foldl' p f z = (L.foldl' f z . L.filter p) `eqP` (S.foldl' f z . S.filter p)

270− where _types = f :: Char -> Char -> Char

271−t_foldl' f z = L.foldl' f z `eqP` T.foldl' f z

272− where _types = f :: Char -> Char -> Char

273−tl_foldl' f z = L.foldl' f z `eqP` TL.foldl' f z

274− where _types = f :: Char -> Char -> Char

275−sf_foldl1 p f = (L.foldl1 f . L.filter p) `eqP` (S.foldl1 f . S.filter p)

276−t_foldl1 f = L.foldl1 f `eqP` T.foldl1 f

277−tl_foldl1 f = L.foldl1 f `eqP` TL.foldl1 f

278−sf_foldl1' p f = (L.foldl1' f . L.filter p) `eqP` (S.foldl1' f . S.filter p)

279−t_foldl1' f = L.foldl1' f `eqP` T.foldl1' f

280−tl_foldl1' f = L.foldl1' f `eqP` TL.foldl1' f

281−sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)

282− where _types = f :: Char -> Char -> Char

283−t_foldr f z = L.foldr f z `eqP` T.foldr f z

284− where _types = f :: Char -> Char -> Char

285−tl_foldr f z = L.foldr f z `eqP` TL.foldr f z

286− where _types = f :: Char -> Char -> Char

287−sf_foldr1 p f = (L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)

288−t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f

289−tl_foldr1 f = L.foldr1 f `eqP` TL.foldr1 f

290−

291−s_concat_s = unsquare (L.concat `eq` (unpackS . S.unstream . S.concat . map packS))

292−sf_concat p = unsquare ((L.concat . map (L.filter p)) `eq` (unpackS . S.concat . map (S.filter p . packS)))

293−t_concat = unsquare (L.concat `eq` (unpackS . T.concat . map packS))

294−tl_concat = unsquare (L.concat `eq` (unpackS . TL.concat . map TL.pack))

295−sf_concatMap p f = unsquare ((L.concatMap f . L.filter p) `eqP` (unpackS . S.concatMap (packS . f) . S.filter p))

296−t_concatMap f = unsquare (L.concatMap f `eqP` (unpackS . T.concatMap (packS . f)))

297−tl_concatMap f = unsquare (L.concatMap f `eqP` (unpackS . TL.concatMap (TL.pack . f)))

298−sf_any q p = (L.any p . L.filter q) `eqP` (S.any p . S.filter q)

299−t_any p = L.any p `eqP` T.any p

300−tl_any p = L.any p `eqP` TL.any p

301−sf_all q p = (L.all p . L.filter q) `eqP` (S.all p . S.filter q)

302−t_all p = L.all p `eqP` T.all p

303−tl_all p = L.all p `eqP` TL.all p

304−sf_maximum p = (L.maximum . L.filter p) `eqP` (S.maximum . S.filter p)

305−t_maximum = L.maximum `eqP` T.maximum

306−tl_maximum = L.maximum `eqP` TL.maximum

307−sf_minimum p = (L.minimum . L.filter p) `eqP` (S.minimum . S.filter p)

308−t_minimum = L.minimum `eqP` T.minimum

309−tl_minimum = L.minimum `eqP` TL.minimum

310−

311−sf_scanl p f z = (L.scanl f z . L.filter p) `eqP` (unpackS . S.scanl f z . S.filter p)

312−t_scanl f z = L.scanl f z `eqP` (unpackS . T.scanl f z)

313−tl_scanl f z = L.scanl f z `eqP` (unpackS . TL.scanl f z)

314−t_scanl1 f = L.scanl1 f `eqP` (unpackS . T.scanl1 f)

315−tl_scanl1 f = L.scanl1 f `eqP` (unpackS . TL.scanl1 f)

316−t_scanr f z = L.scanr f z `eqP` (unpackS . T.scanr f z)

317−tl_scanr f z = L.scanr f z `eqP` (unpackS . TL.scanr f z)

318−t_scanr1 f = L.scanr1 f `eqP` (unpackS . T.scanr1 f)

319−tl_scanr1 f = L.scanr1 f `eqP` (unpackS . TL.scanr1 f)

320−

321−t_mapAccumL f z = unsquare (L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z))

322− where _types = f :: Int -> Char -> (Int,Char)

323−tl_mapAccumL f z = unsquare (L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z))

324− where _types = f :: Int -> Char -> (Int,Char)

325−t_mapAccumR f z = unsquare (L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z))

326− where _types = f :: Int -> Char -> (Int,Char)

327−tl_mapAccumR f z = unsquare (L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z))

328− where _types = f :: Int -> Char -> (Int,Char)

329−

330−replicate n l = concat (L.replicate n l)

331−

332−t_replicate n = replicate n `eq` (unpackS . T.replicate n . packS)

333−tl_replicate n = replicate n `eq` (unpackS . TL.replicate (fromIntegral n) . packS)

334−

335−unf :: Int -> Char -> Maybe (Char, Char)

336−unf n c | fromEnum c * 100 > n = Nothing

337− | otherwise = Just (c, succ c)

338−

339−t_unfoldr n = L.unfoldr (unf n) `eq` (unpackS . T.unfoldr (unf n))

340−tl_unfoldr n = L.unfoldr (unf n) `eq` (unpackS . TL.unfoldr (unf n))

341−t_unfoldrN n m = (L.take n . L.unfoldr (unf m)) `eq`

342− (unpackS . T.unfoldrN n (unf m))

343−tl_unfoldrN n m = (L.take n . L.unfoldr (unf m)) `eq`

344− (unpackS . TL.unfoldrN (fromIntegral n) (unf m))

345−

346−unpack2 :: (Stringy s) => (s,s) -> (String,String)

347−unpack2 = unpackS *** unpackS

348−

349−s_take n = L.take n `eqP` (unpackS . S.take n)

350−s_take_s m = L.take n `eqP` (unpackS . S.unstream . S.take n)

351− where n = small m

352−sf_take p n = (L.take n . L.filter p) `eqP` (unpackS . S.take n . S.filter p)

353−t_take n = L.take n `eqP` (unpackS . T.take n)

354−tl_take n = L.take n `eqP` (unpackS . TL.take (fromIntegral n))

355−s_drop n = L.drop n `eqP` (unpackS . S.drop n)

356−s_drop_s m = L.drop n `eqP` (unpackS . S.unstream . S.drop n)

357− where n = small m

358−sf_drop p n = (L.drop n . L.filter p) `eqP` (unpackS . S.drop n . S.filter p)

359−t_drop n = L.drop n `eqP` (unpackS . T.drop n)

360−tl_drop n = L.drop n `eqP` (unpackS . TL.drop (fromIntegral n))

361−s_take_drop m = (L.take n . L.drop n) `eqP` (unpackS . S.take n . S.drop n)

362− where n = small m

363−s_take_drop_s m = (L.take n . L.drop n) `eqP` (unpackS . S.unstream . S.take n . S.drop n)

364− where n = small m

365−s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)

366−s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)

367−sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP` (unpackS . S.takeWhile p . S.filter q)

368−t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)

369−tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)

370−s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

371−s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)

372−sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP` (unpackS . S.dropWhile p . S.filter q)

373−t_dropWhile p = L.dropWhile p `eqP` (unpackS . T.dropWhile p)

374−tl_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

375−t_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . T.dropWhileEnd p)

376−tl_dropWhileEnd p = (L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . TL.dropWhileEnd p)

377−t_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . T.dropAround p)

378−tl_dropAround p = (L.dropWhile p . L.reverse . L.dropWhile p . L.reverse) `eqP` (unpackS . TL.dropAround p)

379−t_stripStart = T.dropWhile isSpace `eq` T.stripStart

380−tl_stripStart = TL.dropWhile isSpace `eq` TL.stripStart

381−t_stripEnd = T.dropWhileEnd isSpace `eq` T.stripEnd

382−tl_stripEnd = TL.dropWhileEnd isSpace `eq` TL.stripEnd

383−t_strip = T.dropAround isSpace `eq` T.strip

384−tl_strip = TL.dropAround isSpace `eq` TL.strip

385−t_splitAt n = L.splitAt n `eqP` (unpack2 . T.splitAt n)

386−tl_splitAt n = L.splitAt n `eqP` (unpack2 . TL.splitAt (fromIntegral n))

387−t_spanBy p = L.span p `eqP` (unpack2 . T.spanBy p)

388−tl_spanBy p = L.span p `eqP` (unpack2 . TL.spanBy p)

389−

390−t_break_id s = squid `eq` (uncurry T.append . T.break s)

391− where squid t | T.null s = error "empty"

392− | otherwise = t

393−tl_break_id s = squid `eq` (uncurry TL.append . TL.break s)

394− where squid t | TL.null s = error "empty"

395− | otherwise = t

396−t_break_start (NotEmpty s) t = let (_,m) = T.break s t

397− in T.null m || s `T.isPrefixOf` m

398−tl_break_start (NotEmpty s) t = let (_,m) = TL.break s t

399− in TL.null m || s `TL.isPrefixOf` m

400−t_breakBy p = L.break p `eqP` (unpack2 . T.breakBy p)

401−tl_breakBy p = L.break p `eqP` (unpack2 . TL.breakBy p)

402−t_group = L.group `eqP` (map unpackS . T.group)

403−tl_group = L.group `eqP` (map unpackS . TL.group)

404−t_groupBy p = L.groupBy p `eqP` (map unpackS . T.groupBy p)

405−tl_groupBy p = L.groupBy p `eqP` (map unpackS . TL.groupBy p)

406−t_inits = L.inits `eqP` (map unpackS . T.inits)

407−tl_inits = L.inits `eqP` (map unpackS . TL.inits)

408−t_tails = L.tails `eqP` (map unpackS . T.tails)

409−tl_tails = L.tails `eqP` (map unpackS . TL.tails)

410−

411−t_findSplit s t = (T.split s `eq` splitty) u

412− where splitty v = case T.find s v of

413− (x,xs) -> x : L.map (T.drop (T.length s) . fst) xs

414− u = T.concat [t,s,t]

415−tl_findSplit s t = (TL.split s `eq` splitty) u

416− where splitty v = case TL.find s v of

417− (x,xs) -> x : L.map (TL.drop (TL.length s) . fst) xs

418− u = TL.concat [t,s,t]

419−t_split_split s = unsquare ((T.split s `eq` Slow.split s) .

420− T.intercalate s)

421−tl_split_split s = unsquare (((TL.split (chunkify s) . chunkify) `eq`

422− (map chunkify . T.split s)) .

423− T.intercalate s)

424−t_split_i (NotEmpty t) = id `eq` (T.intercalate t . T.split t)

425−tl_split_i (NotEmpty t) = id `eq` (TL.intercalate t . TL.split t)

426−

427−t_splitBy p = splitBy p `eqP` (map unpackS . T.splitBy p)

428−t_splitBy_count c = (L.length . T.splitBy (==c)) `eq` ((1+) . T.count (T.singleton c))

429−t_splitBy_split c = T.splitBy (==c) `eq` T.split (T.singleton c)

430−tl_splitBy p = splitBy p `eqP` (map unpackS . TL.splitBy p)

431−

432−splitBy :: (a -> Bool) -> [a] -> [[a]]

433−splitBy _ [] = [[]]

434−splitBy p xs = loop xs

435− where loop s | null s' = [l]

436− | otherwise = l : loop (tail s')

437− where (l, s') = break p s

438−

439−t_chunksOf_same_lengths k = all ((==k) . T.length) . ini . T.chunksOf k

440− where ini [] = []

441− ini xs = init xs

442−

443−t_chunksOf_length k t = len == T.length t || (k <= 0 && len == 0)

444− where len = L.sum . L.map T.length $ T.chunksOf k t

445−

446−chunkify = TL.fromChunks . (:[])

447−

448−tl_chunksOf k = T.chunksOf k `eq` (map (T.concat . TL.toChunks) . TL.chunksOf (fromIntegral k) . chunkify)

449−

450−t_lines = L.lines `eqP` (map unpackS . T.lines)

451−tl_lines = L.lines `eqP` (map unpackS . TL.lines)

452−{-

453−t_lines' = lines' `eqP` (map unpackS . T.lines')

454− where lines' "" = []

455− lines' s = let (l, s') = break eol s

456− in l : case s' of

457− [] -> []

458− ('\r':'\n':s'') -> lines' s''

459− (_:s'') -> lines' s''

460− eol c = c == '\r' || c == '\n'

461−-}

462−t_words = L.words `eqP` (map unpackS . T.words)

463−

464−tl_words = L.words `eqP` (map unpackS . TL.words)

465−t_unlines = unsquare (L.unlines `eq` (unpackS . T.unlines . map packS))

466−tl_unlines = unsquare (L.unlines `eq` (unpackS . TL.unlines . map packS))

467−t_unwords = unsquare (L.unwords `eq` (unpackS . T.unwords . map packS))

468−tl_unwords = unsquare (L.unwords `eq` (unpackS . TL.unwords . map packS))

469−

470−s_isPrefixOf s = L.isPrefixOf s `eqP` (S.isPrefixOf (S.stream $ packS s) . S.stream)

471−sf_isPrefixOf p s = (L.isPrefixOf s . L.filter p) `eqP` (S.isPrefixOf (S.stream $ packS s) . S.filter p . S.stream)

472−t_isPrefixOf s = L.isPrefixOf s`eqP` T.isPrefixOf (packS s)

473−tl_isPrefixOf s = L.isPrefixOf s`eqP` TL.isPrefixOf (packS s)

474−t_isSuffixOf s = L.isSuffixOf s`eqP` T.isSuffixOf (packS s)

475−tl_isSuffixOf s = L.isSuffixOf s`eqP` TL.isSuffixOf (packS s)

476−t_isInfixOf s = L.isInfixOf s `eqP` T.isInfixOf (packS s)

477−tl_isInfixOf s = L.isInfixOf s `eqP` TL.isInfixOf (packS s)

478−

479−sf_elem p c = (L.elem c . L.filter p) `eqP` (S.elem c . S.filter p)

480−sf_filter q p = (L.filter p . L.filter q) `eqP` (unpackS . S.filter p . S.filter q)

481−t_filter p = L.filter p `eqP` (unpackS . T.filter p)

482−tl_filter p = L.filter p `eqP` (unpackS . TL.filter p)

483−sf_findBy q p = (L.find p . L.filter q) `eqP` (S.findBy p . S.filter q)

484−t_findBy p = L.find p `eqP` T.findBy p

485−tl_findBy p = L.find p `eqP` TL.findBy p

486−t_partition p = L.partition p `eqP` (unpack2 . T.partitionBy p)

487−tl_partition p = L.partition p `eqP` (unpack2 . TL.partitionBy p)

488−

489−sf_index p s = forAll (choose (-l,l*2)) ((L.filter p s L.!!) `eq` S.index (S.filter p $ packS s))

490− where l = L.length s

491−t_index s = forAll (choose (-l,l*2)) ((s L.!!) `eq` T.index (packS s))

492− where l = L.length s

493−

494−tl_index s = forAll (choose (-l,l*2)) ((s L.!!) `eq` (TL.index (packS s) . fromIntegral))

495− where l = L.length s

496−

497−t_findIndex p = L.findIndex p `eqP` T.findIndex p

498−t_count t = (subtract 1 . L.length . T.split t) `eq` T.count t

499−tl_count t = (subtract 1 . L.genericLength . TL.split t) `eq` TL.count t

500−t_zip s = L.zip s `eqP` T.zip (packS s)

501−tl_zip s = L.zip s `eqP` TL.zip (packS s)

502−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)

503−t_zipWith c s = L.zipWith c s `eqP` (unpackS . T.zipWith c (packS s))

504−tl_zipWith c s = L.zipWith c s `eqP` (unpackS . TL.zipWith c (packS s))

505−

506−t_indices = unsquare (\s -> Slow.indices s `eq` indices s)

507−tl_indices = unsquare (\s -> lazyIndices s `eq` S.indices s)

508− where lazyIndices s t = map fromIntegral $ Slow.indices (conc s) (conc t)

509− conc = T.concat . TL.toChunks

510−t_indices_occurs t = unsquare (\ts -> let s = T.intercalate t ts

511− in Slow.indices t s == indices t s)

512−

513−-- Bit shifts.

514−shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k

515− where width = round (log (fromIntegral m) / log 2 :: Double)

516− (m,_) = (maxBound, m == w)

517−shiftR w = forAll (choose (0,width-1)) $ \k -> Bits.shiftR w k == U.shiftR w k

518− where width = round (log (fromIntegral m) / log 2 :: Double)

519− (m,_) = (maxBound, m == w)

520−

521−shiftL_Int = shiftL :: Int -> Property

522−shiftL_Word16 = shiftL :: Word16 -> Property

523−shiftL_Word32 = shiftL :: Word32 -> Property

524−shiftR_Int = shiftR :: Int -> Property

525−shiftR_Word16 = shiftR :: Word16 -> Property

526−shiftR_Word32 = shiftR :: Word32 -> Property

527−

528−-- Regression tests.

529−s_filter_eq s = S.filter p t == S.streamList (filter p s)

530− where p = (/= S.last t)

531− t = S.streamList s

532−

533−-- Make a stream appear shorter than it really is, to ensure that

534−-- functions that consume inaccurately sized streams behave

535−-- themselves.

536−shorten :: Int -> S.Stream a -> S.Stream a

537−shorten n t@(S.Stream arr off len)

538− | n > 0 = S.Stream arr off (smaller (exactSize n) len)

539− | otherwise = t

540−

541−main = defaultMain tests

542−

543−tests = [

544− testGroup "creation/elimination" [

545− testProperty "t_pack_unpack" t_pack_unpack,

546− testProperty "tl_pack_unpack" tl_pack_unpack,

547− testProperty "t_stream_unstream" t_stream_unstream,

548− testProperty "tl_stream_unstream" tl_stream_unstream,

549− testProperty "t_reverse_stream" t_reverse_stream,

550− testProperty "t_singleton" t_singleton,

551− testProperty "tl_singleton" tl_singleton,

552− testProperty "tl_unstreamChunks" tl_unstreamChunks,

553− testProperty "tl_chunk_unchunk" tl_chunk_unchunk

554− ],

555−

556− testGroup "transcoding" [

557− testProperty "t_ascii" t_ascii,

558− testProperty "t_utf8" t_utf8,

559− testProperty "tl_utf8" tl_utf8,

560− testProperty "t_utf16LE" t_utf16LE,

561− testProperty "t_utf16BE" t_utf16BE,

562− testProperty "t_utf32LE" t_utf32LE,

563− testProperty "t_utf32BE" t_utf32BE

564− ],

565−

566− testGroup "instances" [

567− testProperty "s_Eq" s_Eq,

568− testProperty "sf_Eq" sf_Eq,

569− testProperty "t_Eq" t_Eq,

570− testProperty "tl_Eq" tl_Eq,

571− testProperty "s_Ord" s_Ord,

572− testProperty "sf_Ord" sf_Ord,

573− testProperty "t_Ord" t_Ord,

574− testProperty "tl_Ord" tl_Ord,

575− testProperty "t_Read" t_Read,

576− testProperty "tl_Read" tl_Read,

577− testProperty "t_Show" t_Show,

578− testProperty "tl_Show" tl_Show,

579− testProperty "t_mappend" t_mappend,

580− testProperty "tl_mappend" tl_mappend,

581− testProperty "t_mconcat" t_mconcat,

582− testProperty "tl_mconcat" tl_mconcat,

583− testProperty "t_IsString" t_IsString,

584− testProperty "tl_IsString" tl_IsString

585− ],

586−

587− testGroup "basics" [

588− testProperty "s_cons" s_cons,

589− testProperty "s_cons_s" s_cons_s,

590− testProperty "sf_cons" sf_cons,

591− testProperty "t_cons" t_cons,

592− testProperty "tl_cons" tl_cons,

593− testProperty "s_snoc" s_snoc,

594− testProperty "t_snoc" t_snoc,

595− testProperty "tl_snoc" tl_snoc,

596− testProperty "s_append" s_append,

597− testProperty "s_append_s" s_append_s,

598− testProperty "sf_append" sf_append,

599− testProperty "t_append" t_append,

600− testProperty "s_uncons" s_uncons,

601− testProperty "sf_uncons" sf_uncons,

602− testProperty "t_uncons" t_uncons,

603− testProperty "tl_uncons" tl_uncons,

604− testProperty "s_head" s_head,

605− testProperty "sf_head" sf_head,

606− testProperty "t_head" t_head,

607− testProperty "tl_head" tl_head,

608− testProperty "s_last" s_last,

609− testProperty "sf_last" sf_last,

610− testProperty "t_last" t_last,

611− testProperty "tl_last" tl_last,

612− testProperty "s_tail" s_tail,

613− testProperty "s_tail_s" s_tail_s,

614− testProperty "sf_tail" sf_tail,

615− testProperty "t_tail" t_tail,

616− testProperty "tl_tail" tl_tail,

617− testProperty "s_init" s_init,

618− testProperty "s_init_s" s_init_s,

619− testProperty "sf_init" sf_init,

620− testProperty "t_init" t_init,

621− testProperty "tl_init" tl_init,

622− testProperty "s_null" s_null,

623− testProperty "sf_null" sf_null,

624− testProperty "t_null" t_null,

625− testProperty "tl_null" tl_null,

626− testProperty "s_length" s_length,

627− testProperty "sf_length" sf_length,

628− testProperty "t_length" t_length,

629− testProperty "tl_length" tl_length

630− ],

631−

632− testGroup "transformations" [

633− testProperty "s_map" s_map,

634− testProperty "s_map_s" s_map_s,

635− testProperty "sf_map" sf_map,

636− testProperty "t_map" t_map,

637− testProperty "tl_map" tl_map,

638− testProperty "t_intercalate" t_intercalate,

639− testProperty "tl_intercalate" tl_intercalate,

640− testProperty "s_intersperse" s_intersperse,

641− testProperty "s_intersperse_s" s_intersperse_s,

642− testProperty "sf_intersperse" sf_intersperse,

643− testProperty "t_intersperse" t_intersperse,

644− testProperty "tl_intersperse" tl_intersperse,

645− testProperty "t_transpose" t_transpose,

646− testProperty "tl_transpose" tl_transpose,

647− testProperty "t_reverse" t_reverse,

648− testProperty "tl_reverse" tl_reverse,

649− testProperty "t_reverse_short" t_reverse_short,

650− testProperty "t_replace" t_replace,

651− testProperty "tl_replace" tl_replace,

652−

653− testGroup "case conversion" [

654− testProperty "s_toCaseFold_length" s_toCaseFold_length,

655− testProperty "sf_toCaseFold_length" sf_toCaseFold_length,

656− testProperty "t_toCaseFold_length" t_toCaseFold_length,

657− testProperty "tl_toCaseFold_length" tl_toCaseFold_length,

658− testProperty "t_toLower_length" t_toLower_length,

659− testProperty "t_toLower_lower" t_toLower_lower,

660− testProperty "tl_toLower_lower" tl_toLower_lower,

661− testProperty "t_toUpper_length" t_toUpper_length,

662− testProperty "t_toUpper_upper" t_toUpper_upper,

663− testProperty "tl_toUpper_upper" tl_toUpper_upper

664− ],

665−

666− testGroup "justification" [

667− testProperty "s_justifyLeft" s_justifyLeft,

668− testProperty "s_justifyLeft_s" s_justifyLeft_s,

669− testProperty "sf_justifyLeft" sf_justifyLeft,

670− testProperty "t_justifyLeft" t_justifyLeft,

671− testProperty "tl_justifyLeft" tl_justifyLeft,

672− testProperty "t_justifyRight" t_justifyRight,

673− testProperty "tl_justifyRight" tl_justifyRight

674− ]

675− ],

676−

677− testGroup "folds" [

678− testProperty "sf_foldl" sf_foldl,

679− testProperty "t_foldl" t_foldl,

680− testProperty "tl_foldl" tl_foldl,

681− testProperty "sf_foldl'" sf_foldl',

682− testProperty "t_foldl'" t_foldl',

683− testProperty "tl_foldl'" tl_foldl',

684− testProperty "sf_foldl1" sf_foldl1,

685− testProperty "t_foldl1" t_foldl1,

686− testProperty "tl_foldl1" tl_foldl1,

687− testProperty "t_foldl1'" t_foldl1',

688− testProperty "sf_foldl1'" sf_foldl1',

689− testProperty "tl_foldl1'" tl_foldl1',

690− testProperty "sf_foldr" sf_foldr,

691− testProperty "t_foldr" t_foldr,

692− testProperty "tl_foldr" tl_foldr,

693− testProperty "sf_foldr1" sf_foldr1,

694− testProperty "t_foldr1" t_foldr1,

695− testProperty "tl_foldr1" tl_foldr1,

696−

697− testGroup "special" [

698− testProperty "s_concat_s" s_concat_s,

699− testProperty "sf_concat" sf_concat,

700− testProperty "t_concat" t_concat,

701− testProperty "tl_concat" tl_concat,

702− testProperty "sf_concatMap" sf_concatMap,

703− testProperty "t_concatMap" t_concatMap,

704− testProperty "tl_concatMap" tl_concatMap,

705− testProperty "sf_any" sf_any,

706− testProperty "t_any" t_any,

707− testProperty "tl_any" tl_any,

708− testProperty "sf_all" sf_all,

709− testProperty "t_all" t_all,

710− testProperty "tl_all" tl_all,

711− testProperty "sf_maximum" sf_maximum,

712− testProperty "t_maximum" t_maximum,

713− testProperty "tl_maximum" tl_maximum,

714− testProperty "sf_minimum" sf_minimum,

715− testProperty "t_minimum" t_minimum,

716− testProperty "tl_minimum" tl_minimum

717− ]

718− ],

719−

720− testGroup "construction" [

721− testGroup "scans" [

722− testProperty "sf_scanl" sf_scanl,

723− testProperty "t_scanl" t_scanl,

724− testProperty "tl_scanl" tl_scanl,

725− testProperty "t_scanl1" t_scanl1,

726− testProperty "tl_scanl1" tl_scanl1,

727− testProperty "t_scanr" t_scanr,

728− testProperty "tl_scanr" tl_scanr,

729− testProperty "t_scanr1" t_scanr1,

730− testProperty "tl_scanr1" tl_scanr1

731− ],

732−

733− testGroup "mapAccum" [

734− testProperty "t_mapAccumL" t_mapAccumL,

735− testProperty "tl_mapAccumL" tl_mapAccumL,

736− testProperty "t_mapAccumR" t_mapAccumR,

737− testProperty "tl_mapAccumR" tl_mapAccumR

738− ],

739−

740− testGroup "unfolds" [

741− testProperty "t_replicate" t_replicate,

742− testProperty "tl_replicate" tl_replicate,

743− testProperty "t_unfoldr" t_unfoldr,

744− testProperty "tl_unfoldr" tl_unfoldr,

745− testProperty "t_unfoldrN" t_unfoldrN,

746− testProperty "tl_unfoldrN" tl_unfoldrN

747− ]

748− ],

749−

750− testGroup "substrings" [

751− testGroup "breaking" [

752− testProperty "s_take" s_take,

753− testProperty "s_take_s" s_take_s,

754− testProperty "sf_take" sf_take,

755− testProperty "t_take" t_take,

756− testProperty "tl_take" tl_take,

757− testProperty "s_drop" s_drop,

758− testProperty "s_drop_s" s_drop_s,

759− testProperty "sf_drop" sf_drop,

760− testProperty "t_drop" t_drop,

761− testProperty "tl_drop" tl_drop,

762− testProperty "s_take_drop" s_take_drop,

763− testProperty "s_take_drop_s" s_take_drop_s,

764− testProperty "s_takeWhile" s_takeWhile,

765− testProperty "s_takeWhile_s" s_takeWhile_s,

766− testProperty "sf_takeWhile" sf_takeWhile,

767− testProperty "t_takeWhile" t_takeWhile,

768− testProperty "tl_takeWhile" tl_takeWhile,

769− testProperty "sf_dropWhile" sf_dropWhile,

770− testProperty "s_dropWhile" s_dropWhile,

771− testProperty "s_dropWhile_s" s_dropWhile_s,

772− testProperty "t_dropWhile" t_dropWhile,

773− testProperty "tl_dropWhile" tl_dropWhile,

774− testProperty "t_dropWhileEnd" t_dropWhileEnd,

775− testProperty "tl_dropWhileEnd" tl_dropWhileEnd,

776− testProperty "t_dropAround" t_dropAround,

777− testProperty "tl_dropAround" tl_dropAround,

778− testProperty "t_stripStart" t_stripStart,

779− testProperty "tl_stripStart" tl_stripStart,

780− testProperty "t_stripEnd" t_stripEnd,

781− testProperty "tl_stripEnd" tl_stripEnd,

782− testProperty "t_strip" t_strip,

783− testProperty "tl_strip" tl_strip,

784− testProperty "t_splitAt" t_splitAt,

785− testProperty "tl_splitAt" tl_splitAt,

786− testProperty "t_spanBy" t_spanBy,

787− testProperty "tl_spanBy" tl_spanBy,

788− testProperty "t_break_id" t_break_id,

789− testProperty "tl_break_id" tl_break_id,

790− testProperty "t_break_start" t_break_start,

791− testProperty "tl_break_start" tl_break_start,

792− testProperty "t_breakBy" t_breakBy,

793− testProperty "tl_breakBy" tl_breakBy,

794− testProperty "t_group" t_group,

795− testProperty "tl_group" tl_group,

796− testProperty "t_groupBy" t_groupBy,

797− testProperty "tl_groupBy" tl_groupBy,

798− testProperty "t_inits" t_inits,

799− testProperty "tl_inits" tl_inits,

800− testProperty "t_tails" t_tails,

801− testProperty "tl_tails" tl_tails

802− ],

803−

804− testGroup "breaking many" [

805− testProperty "t_findSplit" t_findSplit,

806− testProperty "tl_findSplit" tl_findSplit,

807− testProperty "t_split_split" t_split_split,

808− testProperty "tl_split_split" tl_split_split,

809− testProperty "t_split_i" t_split_i,

810− testProperty "tl_split_i" tl_split_i,

811− testProperty "t_splitBy" t_splitBy,

812− testProperty "t_splitBy_count" t_splitBy_count,

813− testProperty "t_splitBy_split" t_splitBy_split,

814− testProperty "tl_splitBy" tl_splitBy,

815− testProperty "t_chunksOf_same_lengths" t_chunksOf_same_lengths,

816− testProperty "t_chunksOf_length" t_chunksOf_length,

817− testProperty "tl_chunksOf" tl_chunksOf

818− ],

819−

820− testGroup "lines and words" [

821− testProperty "t_lines" t_lines,

822− testProperty "tl_lines" tl_lines,

823− --testProperty "t_lines'" t_lines',

824− testProperty "t_words" t_words,

825− testProperty "tl_words" tl_words,

826− testProperty "t_unlines" t_unlines,

827− testProperty "tl_unlines" tl_unlines,

828− testProperty "t_unwords" t_unwords,

829− testProperty "tl_unwords" tl_unwords

830− ]

831− ],

832−

833− testGroup "predicates" [

834− testProperty "s_isPrefixOf" s_isPrefixOf,

835− testProperty "sf_isPrefixOf" sf_isPrefixOf,

836− testProperty "t_isPrefixOf" t_isPrefixOf,

837− testProperty "tl_isPrefixOf" tl_isPrefixOf,

838− testProperty "t_isSuffixOf" t_isSuffixOf,

839− testProperty "tl_isSuffixOf" tl_isSuffixOf,

840− testProperty "t_isInfixOf" t_isInfixOf,

841− testProperty "tl_isInfixOf" tl_isInfixOf

842− ],

843−

844− testGroup "searching" [

845− testProperty "sf_elem" sf_elem,

846− testProperty "sf_filter" sf_filter,

847− testProperty "t_filter" t_filter,

848− testProperty "tl_filter" tl_filter,

849− testProperty "sf_findBy" sf_findBy,

850− testProperty "t_findBy" t_findBy,

851− testProperty "tl_findBy" tl_findBy,

852− testProperty "t_partition" t_partition,

853− testProperty "tl_partition" tl_partition

854− ],

855−

856− testGroup "indexing" [

857− testProperty "sf_index" sf_index,

858− testProperty "t_index" t_index,

859− testProperty "tl_index" tl_index,

860− testProperty "t_findIndex" t_findIndex,

861− testProperty "t_count" t_count,

862− testProperty "tl_count" tl_count,

863− testProperty "t_indices" t_indices,

864− testProperty "tl_indices" tl_indices,

865− testProperty "t_indices_occurs" t_indices_occurs

866− ],

867−

868− testGroup "zips" [

869− testProperty "t_zip" t_zip,

870− testProperty "tl_zip" tl_zip,

871− testProperty "sf_zipWith" sf_zipWith,

872− testProperty "t_zipWith" t_zipWith,

873− testProperty "tl_zipWith" tl_zipWith

874− ],

875−

876− testGroup "regressions" [

877− testProperty "s_filter_eq" s_filter_eq

878− ],

879−

880− testGroup "shifts" [

881− testProperty "shiftL_Int" shiftL_Int,

882− testProperty "shiftL_Word16" shiftL_Word16,

883− testProperty "shiftL_Word32" shiftL_Word32,

884− testProperty "shiftR_Int" shiftR_Int,

885− testProperty "shiftR_Word16" shiftR_Word16,

886− testProperty "shiftR_Word32" shiftR_Word32

887− ]

888− ]

tests/QuickCheckUtils.hsdeleted−128

@@ -1,128 +0,0 @@

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, oneof, sized, variant, 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− coarbitrary c = variant (fromEnum c `rem` 4)

21−

22−instance Random Word8 where

23− randomR = integralRandomR

24− random = randomR (minBound,maxBound)

25−

26−instance Arbitrary Word8 where

27− arbitrary = choose (minBound,maxBound)

28− coarbitrary c = variant (fromEnum c `rem` 4)

29−

30−instance Arbitrary B.ByteString where

31− arbitrary = B.pack `fmap` arbitrary

32− coarbitrary s = coarbitrary (B.unpack s)

33−

34−instance Random Word16 where

35− randomR = integralRandomR

36− random = randomR (minBound,maxBound)

37−

38−instance Arbitrary Word16 where

39− arbitrary = choose (minBound,maxBound)

40− coarbitrary c = variant (fromEnum c `rem` 4)

41−

42−instance Random Word32 where

43− randomR = integralRandomR

44− random = randomR (minBound,maxBound)

45−

46−instance Arbitrary Word32 where

47− arbitrary = choose (minBound,maxBound)

48− coarbitrary c = variant (fromEnum c `rem` 4)

49−

50−instance Arbitrary Char where

51− arbitrary = oneof [choose ('\0','\55295'), choose ('\57344','\1114111')]

52− coarbitrary c = variant (fromEnum c `rem` 4)

53−

54−instance Arbitrary T.Text where

55− arbitrary = T.pack `fmap` arbitrary

56− coarbitrary s = coarbitrary (T.unpack s)

57−

58−instance Arbitrary TL.Text where

59− arbitrary = TL.pack `fmap` arbitrary

60− coarbitrary s = coarbitrary (TL.unpack s)

61−

62−newtype NotEmpty a = NotEmpty { notEmpty :: a }

63− deriving (Eq, Ord, Show)

64−

65−instance Functor NotEmpty where

66− fmap f (NotEmpty a) = NotEmpty (f a)

67−

68−instance Arbitrary a => Arbitrary (NotEmpty [a]) where

69− arbitrary = sized (\n -> NotEmpty `fmap` (choose (1,n+1) >>= vector))

70− coarbitrary = coarbitrary . notEmpty

71−

72−instance Arbitrary (NotEmpty T.Text) where

73− arbitrary = (fmap T.pack) `fmap` arbitrary

74− coarbitrary = coarbitrary . notEmpty

75−

76−instance Arbitrary (NotEmpty TL.Text) where

77− arbitrary = (fmap TL.pack) `fmap` arbitrary

78− coarbitrary = coarbitrary . notEmpty

79−

80−instance Arbitrary (NotEmpty B.ByteString) where

81− arbitrary = (fmap B.pack) `fmap` arbitrary

82− coarbitrary = coarbitrary . notEmpty

83−

84−data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7

85− | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15

86− | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23

87− | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31

88− deriving (Eq, Ord, Enum, Bounded)

89−

90−small :: Small -> Int

91−small = fromEnum

92−

93−intf f a b = toEnum ((fromEnum a `f` fromEnum b) `mod` 32)

94−

95−instance Show Small where

96− show = show . fromEnum

97−

98−instance Read Small where

99− readsPrec n = map (first toEnum) . readsPrec n

100−

101−instance Num Small where

102− fromInteger = toEnum . fromIntegral

103− signum _ = 1

104− abs = id

105− (+) = intf (+)

106− (-) = intf (-)

107− (*) = intf (*)

108−

109−instance Real Small where

110− toRational = toRational . fromEnum

111−

112−instance Integral Small where

113− toInteger = toInteger . fromEnum

114− quotRem a b = (toEnum x, toEnum y)

115− where (x, y) = fromEnum a `quotRem` fromEnum b

116−

117−instance Random Small where

118− randomR = integralRandomR

119− random = randomR (minBound,maxBound)

120−

121−instance Arbitrary Small where

122− arbitrary = choose (minBound,maxBound)

123− coarbitrary c = variant (fromEnum c `rem` 4)

124−

125−integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)

126−integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,

127− fromIntegral b :: Integer) g of

128− (x,h) -> (fromIntegral x, h)

tests/READMEdeleted−2

@@ -1,2 +0,0 @@

1−You also need the test data from:

2−http://projects.haskell.org/text/text-testdata.tar.bz2

tests/SearchBench.hsdeleted−79

@@ -1,79 +0,0 @@

1−{-# LANGUAGE OverloadedStrings #-}

2−

3−import Criterion.Main

4−import Data.Text.Search

5−import qualified Data.Text as T

6−

7−main = defaultMain [

8− bench "big/fast" $ (length . search indices)

9− , bench "big/slow" $ (length . search slowIndices)

10− , bench "dna/fast" $ (length . searchDNA indices)

11− , bench "dna/slow" $ (length . searchDNA slowIndices)

12− ]

13−

14−search f n = f needle' haystack

15− where

16− needle' = T.drop (n `mod` 20) needle

17− needle = T.replicate 10 "abcdefghijklmnopqrstuvwxyz"

18− haystack = T.replicate 100 $

19− T.concat [ T.replicate 1000 "def"

20− , needle

21− , T.replicate 1000 "123"

22− ]

23−

24−searchDNA f n = f needle haystack

25− where

26− needle = T.take 4 . T.drop (n `mod` (T.length dna - 4)) $ dna

27− haystack = T.replicate 100 dna

28−

29−dna = "\

30−\CGTAACAAGGTTTCCGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGGGTT\

31−\AATCTGGAGGATCTGTTTACTTTGGTCACCCATGAGCATTTGCTGTTGAAGTGACCTAGAATTGCCATCG\

32−\AGCCTCCTTGGGAGCTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGCAGTTTTGCTCCAAGTCGTT\

33−\TGACACATAATTGGTGAAGGGGGTGGCATCCTTCCCTGACCCTCCCCCAACTATTTTTTTAACAACTCTC\

34−\AGCAACGGAGACTCAGTCTTCGGCAAATGCGATAAATGGTGTGAATTGCAGAATCCCGTGCACCATCGAG\

35−\TCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCTGCCTGGGCATTGCGAGTCATAT\

36−\CTCTCCCTTAACGAGGCTGTCCATACATACTGTTCAGCCGGTGCGGATGTGAGTTTGGCCCCTTGTTCTT\

37−\TGGTACGGGGGGTCTAAGAGCTGCATGGGCTTTTGATGGTCCTAAATACGGCAAGAGGTGGACGAACTAT\

38−\GCTACAACAAAATTGTTGTGCAGAGGCCCCGGGTTGTCGTATTAGATGGGCCACCGTAATCTGAAGACCC\

39−\TTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGGCCATTTGGTTGCGACCCCAGGTCAG\

40−\GTGAGCAACAGCTGTCGTAACAAGGTTTCCGTAGGGTGAACTGCGGAAGGATCATTGTTGAGATCACATA\

41−\ATAATTGATCGAGTTAATCTGGAGGATCTGTTTACTTGGGTCACCCATGGGCATTTGCTGTTGAAGTGAC\

42−\CTAGATTTGCCATCGAGCCTCCTTGGGAGCATCCTTGTTGGCGATATCTAAACCCTCAATTTTTCCCCCA\

43−\ATCAAATTACACAAAATTGGTGGAGGGGGTGGCATTCTTCCCTTACCCTCCCCCAAATATTTTTTTAACA\

44−\ACTCTCAGCAACGGATATCTCAGCTCTTGCATCGATGAAGAACCCACCGAAATGCGATAAATGGTGTGAA\

45−\TTGCAGAATCCCGTGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACG\

46−\CCTGCCTGGGCATTGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACATACTGTTCAGCCGGTGCG\

47−\GATGTGAGTTTGGCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGATGCATGGGCTTTTGATGGTCCTAA\

48−\ATACGGCAAGAGGTGGACGAACTATGCTACAACAAAATTGTTGTGCAAAGGCCCCGGGTTGTCGTATAAG\

49−\ATGGGCCACCGATATCTGAAGACCCTTTTGGACCCCATTGGAGCCCATCAACCCATGTCAGTTGATGGCC\

50−\ATTCGTAACAAGGTTTCCGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGA\

51−\GTTAATCTGGAGGATCTGTTTACTTGGGTCACCCATGGGCATTTGCTGTTGAAGTGACCTAGATTTGCCA\

52−\TCGAGCCTCCTTGGGAGCTTTCTTGTTGGCGATATCTAAACCCTTGCCCGGCAGAGTTTTGGGAATCCCG\

53−\TGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCTGCCTGGGCAT\

54−\TGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACACACCTGTTCAGCCGGTGCGGATGTGAGTTTG\

55−\GCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGCTGCATGGGCTTTTGATGGTCCTAAATACGGCAAGAG\

56−\GTGGACGAACTATGCTACAACAAAATTGTTGTGCAAAGGCCCCGGGTTGTCGTATTAGATGGGCCACCAT\

57−\AATCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGGCCATTTGGTTGC\

58−\GACCCAGTCAGGTGAGGGTAGGTGAACCTGCGGAAGGATCATTGTTGAGATCACATAATAATTGATCGAG\

59−\TTAATCTGGAGGATCTGTTTACTTTGGTCACCCATGGGCATTTGCTGTTGAAGTGACCTAGATTTGCCAT\

60−\CGAGCCTCCTTGGGAGCTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGGAGTTTGGCGCCAAGTCA\

61−\TATGACACATAATTGGTGAAGGGGGTGGCATCCTGCCCTGACCCTCCCCAAATTATTTTTTTAACAACTC\

62−\TCAGCAACGGATATCTCGGCTCTTGCATCGATGAAGAACGCAGCGAAATGCGATAAATGGTGTGAATTGC\

63−\AGAATCCCGTGAACCATCGAGTCTTTGGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCACGCCT\

64−\GCCTGGGCATTGGGAATCATATCTCTCCCCTAACGAGGCTATCCAAACATACTGTTCATCCGGTGCGGAT\

65−\GTGAGTTTGGCCCCTTGTTCTTTGGTACCGGGGGTCTAAGAGCTGCATGGGCATTTGATGGTCCTCAAAA\

66−\CGGCAAGAGGTGGACGAACTATGCCACAACAAAATTGTTGTCCCAAGGCCCCGGGTTGTCGTATTAGATG\

67−\GGCCACCGTAACCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATGACCA\

68−\TTTGTTGCGACCCCAGTCAGCTGAGCAACCCGCTGAGTGGAAGGTCATTGCCGATATCACATAATAATTG\

69−\ATCGAGTTAATCTGGAGGATCTGTTTACTTGGTCACCCATGAGCATTTGCTGTTGAAGTGACCTAGATTT\

70−\GCCATCGAGCCTCCTTGGGAGTTTTCTTGTTGGCGAGATCTAAACCCTTGCCCGGCGGAGTTGTGCGCCA\

71−\AGTCATATGACACATAATTGGTGAAGGGGGTGGCATCCTGCCCTGACCCTCCCCAAATTATTTTTTTAAC\

72−\AACTCTCAGCAACGGATATCTCGGCTCTTGCATCGATGAAGAACGCAGCGAAATGCGATAAATGGTGTGA\

73−\ATTGCAGAATCCCGTGAACCATCGAGTCTTTGAACGCAAGTTGCGCCCGAGGCCATCAGGCCAAGGGCAC\

74−\GCCTGCCTGGGCATTGCGAGTCATATCTCTCCCTTAACGAGGCTGTCCATACATACTGTTCATCCGGTGC\

75−\GGATGTGAGTTTGGCCCCTTGTTCTTTGGTACGGGGGGTCTAAGAGCTGCATGGGCATTTGATGGTCCTC\

76−\AAAACGGCAAGAGGTGGACGAACTATGCTACAACCAAATTGTTGTCCCAAGGCCCCGGGTTGTCGTATTA\

77−\GATGGGCCACCGTAACCTGAAGACCCTTTTGAACCCCATTGGAGGCCCATCAACCCATGATCAGTTGATG\

78−\ACCATGTGTTGCGACCCCAGTCAGCTGAGCAACGCGCTGAGCGTAACAAGGTTTCCGTAGGTGGACCTCC\

79−\GGGAGGATCATTGTTGAGATCACATAATAATTGATCGAGGTAATCTGGAGGATCTGCATATTTTGGTCAC"

tests/Tests.hsnew file+13

@@ -0,0 +1,13 @@

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.hsnew file+34

@@ -0,0 +1,34 @@

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.hsnew file+1363

@@ -0,0 +1,1363 @@

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.hsnew file+40

@@ -0,0 +1,40 @@

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.hsnew file+360

@@ -0,0 +1,360 @@

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.hsnew file+82

@@ -0,0 +1,82 @@

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/SlowFunctions.hs → tests/Tests/SlowFunctions.hsrenamed+8−9

@@ -1,9 +1,8 @@

11{-# LANGUAGE BangPatterns #-}

2−

3−module SlowFunctions

2+module Tests.SlowFunctions

43 (

54 indices

6− , split

5+ , splitOn

76 ) where

87

98import qualified Data.Text as T

@@ -23,12 +22,12 @@ indices needle@(Text _narr _noff nlen) haystack@(Text harr hoff hlen)

2322 where t = Text harr (hoff+i) (hlen-i)

2423 d = iter_ haystack i

2524

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

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

3231 | otherwise = go src0

3332 where

3433 l = T.length pat

tests/Tests/Utils.hsnew file+52

@@ -0,0 +1,52 @@

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/cabal.confignew file+6

@@ -0,0 +1,6 @@

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.shnew file+29

@@ -0,0 +1,29 @@

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.shnew file+62

@@ -0,0 +1,62 @@

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.cabalnew file+143

@@ -0,0 +1,143 @@

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+184−41

@@ -1,65 +1,208 @@

11name: text

2−version: 0.5

3−synopsis: An efficient packed Unicode text type

4−description: An efficient packed Unicode text type.

5−license: BSD3

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

635license-file: LICENSE

7−author: Tom Harper <rtharper@aftereternity.co.uk>

36+author: Bryan O'Sullivan <bos@serpentine.com>

837maintainer: Bryan O'Sullivan <bos@serpentine.com>

9− Tom Harper <rtharper@aftereternity.co.uk>

10− Duncan Coutts <duncan@haskell.org>

11−copyright: 2008-2009 Tom Harper, 2009 Bryan O'Sullivan

38+copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper

1239category: Data, Text

1340build-type: Simple

14−cabal-version: >= 1.2

15−extra-source-files: README

41+cabal-version: >= 1.8

42+extra-source-files:

43+ -- scripts/CaseFolding.txt

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

60+ tests/Makefile

61+ tests/Tests/*.hs

62+ tests/Tests/Properties/*.hs

63+ tests/cabal.config

64+ tests/scripts/*.sh

65+ tests/text-tests.cabal

66+

67+flag bytestring-builder

68+ description: Depend on the bytestring-builder package for backwards compatibility.

69+ default: False

70+ manual: False

1671

1772flag developer

1873 description: operate in developer mode

1974 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

2081

2182library

83+ c-sources: cbits/cbits.c

84+ include-dirs: include

85+

2286 exposed-modules:

2387 Data.Text

88+ Data.Text.Array

2489 Data.Text.Encoding

2590 Data.Text.Encoding.Error

2691 Data.Text.Foreign

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

27120 Data.Text.Lazy

121+ Data.Text.Lazy.Builder

122+ Data.Text.Lazy.Builder.Int

123+ Data.Text.Lazy.Builder.RealFloat

28124 Data.Text.Lazy.Encoding

29− other-modules:

30− Data.Text.Array

31− Data.Text.Encoding.Fusion

32− Data.Text.Encoding.Fusion.Common

33− Data.Text.Encoding.Utf16

34− Data.Text.Encoding.Utf32

35− Data.Text.Encoding.Utf8

36− Data.Text.Fusion

37− Data.Text.Fusion.CaseMapping

38− Data.Text.Fusion.Common

39− Data.Text.Fusion.Internal

40− Data.Text.Fusion.Size

41− Data.Text.Internal

42− Data.Text.Lazy.Encoding.Fusion

43− Data.Text.Lazy.Fusion

125+ Data.Text.Lazy.IO

44126 Data.Text.Lazy.Internal

45− Data.Text.Lazy.Search

46− Data.Text.Search

127+ Data.Text.Lazy.Read

128+ Data.Text.Read

47129 Data.Text.Unsafe

48− Data.Text.UnsafeChar

49− Data.Text.UnsafeShift

130+

131+ other-modules:

132+ Data.Text.Show

50133

51134 build-depends:

52− base < 5,

53− bytestring >= 0.9 && < 1.0

54− if impl(ghc >= 6.10)

55− build-depends:

56− ghc-prim, base >= 4

57−

58− -- gather extensive profiling data for now

59− ghc-prof-options: -auto-all

60−

61− ghc-options: -Wall -funbox-strict-fields -O2

62− if impl(ghc >= 6.8)

63− ghc-options: -fwarn-tabs

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

144+ else

145+ build-depends: bytestring >= 0.10.4

146+

147+ cpp-options: -DHAVE_DEEPSEQ

148+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

64149 if flag(developer)

150+ ghc-prof-options: -auto-all

65151 ghc-options: -Werror

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