886af05...master · text

.gitignore+1

since splitsnapshots

unifiedsplit

@@ -1,2 +1,3 @@

1dist

2cabal-dev

3+cabal.sandbox.config

.hgtags+14

@@ -50,3 +50,17 @@ d99cd091cdf71ce807a4255f6cc509c3154f51ea 0.11.3.1

50fb7299f22449750c653ac64dee4bd63c13ea6e4c 1.1.1.1

51eb170cb533b63534d166b5fd5344b36676adf140 1.1.1.2

52e749e05f715d02445803f653cd3d97d5395d7c6f 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+132−58

@@ -3,7 +3,9 @@

3#if __GLASGOW_HASKELL__ >= 702

4{-# LANGUAGE Trustworthy #-}

5#endif

6−{-# LANGUAGE MonoLocalBinds #-}

6+#if __GLASGOW_HASKELL__ >= 708

7+{-# LANGUAGE TypeFamilies #-}

8+#endif

7

9

8-- |

10-- |

9-- Module : Data.Text

11-- Module : Data.Text

@@ -127,6 +129,7 @@ module Data.Text

127 , drop

129 , drop

128 , dropEnd

130 , dropEnd

129 , takeWhile

131 , takeWhile

132+ , takeWhileEnd

130 , dropWhile

133 , dropWhile

131 , dropWhileEnd

134 , dropWhileEnd

132 , dropAround

135 , dropAround

@@ -189,15 +192,16 @@ module Data.Text

189

192

190 -- * Low level operations

193 -- * Low level operations

191 , copy

194 , copy

195+ , unpackCString#

192 ) where

196 ) where

193

197

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

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

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

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

196− Read(..), Show(..),

200+ Read(..),

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

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

198 not, return, otherwise, quot)

202 not, return, otherwise, quot)

199#if defined(HAVE_DEEPSEQ)

203#if defined(HAVE_DEEPSEQ)

200−import Control.DeepSeq (NFData)

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

201#endif

205#endif

202#if defined(ASSERTS)

206#if defined(ASSERTS)

203import Control.Exception (assert)

207import Control.Exception (assert)

@@ -209,13 +213,19 @@ import Control.Monad (foldM)

209import Control.Monad.ST (ST)

213import Control.Monad.ST (ST)

210import qualified Data.Text.Array as A

214import qualified Data.Text.Array as A

211import qualified Data.List as L

215import qualified Data.List as L

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

212import Data.Monoid (Monoid(..))

217import Data.Monoid (Monoid(..))

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

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

220+#endif

213import Data.String (IsString(..))

221import Data.String (IsString(..))

214import qualified Data.Text.Internal.Fusion as S

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

215import qualified Data.Text.Internal.Fusion.Common as S

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

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

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

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

217import Data.Text.Internal.Private (span_)

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

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

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

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

219import qualified Prelude as P

229import qualified Prelude as P

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

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

221 reverseIter_, unsafeHead, unsafeTail)

231 reverseIter_, unsafeHead, unsafeTail)

@@ -228,12 +238,13 @@ import Data.ByteString (ByteString)

228import qualified Data.Text.Lazy as L

238import qualified Data.Text.Lazy as L

229import Data.Int (Int64)

239import Data.Int (Int64)

230#endif

240#endif

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

231−#if __GLASGOW_HASKELL__ >= 702

242+#if __GLASGOW_HASKELL__ >= 708

232−import qualified GHC.CString as GHC

243+import qualified GHC.Exts as Exts

233−#else

244+#endif

234−import qualified GHC.Base as GHC

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

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

235#endif

247#endif

236−import GHC.Prim (Addr#)

237

248

238-- $strict

249-- $strict

239--

250--

@@ -319,24 +330,48 @@ instance Eq Text where

319instance Ord Text where

330instance Ord Text where

320 compare = compareText

331 compare = compareText

321

332

322−instance Show Text where

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

324−

325instance Read Text where

333instance Read Text where

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

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

327

335

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+

328instance Monoid Text where

344instance Monoid Text where

329 mempty = empty

345 mempty = empty

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

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

348+#else

330 mappend = append

349 mappend = append

350+#endif

331 mconcat = concat

351 mconcat = concat

332

352

333instance IsString Text where

353instance IsString Text where

334 fromString = pack

354 fromString = pack

335

355

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+

336#if defined(HAVE_DEEPSEQ)

363#if defined(HAVE_DEEPSEQ)

337−instance NFData Text

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

338#endif

365#endif

339

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+

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

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

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

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

342--

377--

@@ -360,6 +395,12 @@ instance Data Text where

360 _ -> P.error "gunfold"

395 _ -> P.error "gunfold"

361 dataTypeOf _ = textDataType

396 dataTypeOf _ = textDataType

362

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+

363packConstr :: Constr

404packConstr :: Constr

364packConstr = mkConstr textDataType "pack" [] Prefix

405packConstr = mkConstr textDataType "pack" [] Prefix

365

406

@@ -389,30 +430,6 @@ pack :: String -> Text

389pack = unstream . S.map safe . S.streamList

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

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

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

391

432

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

393−unpack :: Text -> String

394−unpack = S.unstreamList . stream

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

396−

397−-- | /O(n)/ Convert a literal string into a Text. Subject to fusion.

398−unpackCString# :: Addr# -> Text

399−unpackCString# addr# = unstream (S.streamCString# addr#)

400−{-# NOINLINE unpackCString# #-}

401−

402−{-# RULES "TEXT literal" forall a.

403− unstream (S.map safe (S.streamList (GHC.unpackCString# a)))

404− = unpackCString# a #-}

405−

406−{-# RULES "TEXT literal UTF8" forall a.

407− unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))

408− = unpackCString# a #-}

409−

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

411−-- Performs replacement on invalid scalar values.

412−singleton :: Char -> Text

413−singleton = unstream . S.singleton . safe

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

415−

416-- -----------------------------------------------------------------------------

433-- -----------------------------------------------------------------------------

417-- * Basic functions

434-- * Basic functions

418

435

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

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

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

470uncons t@(Text arr off len)

487uncons t@(Text arr off len)

471 | len <= 0 = Nothing

488 | len <= 0 = Nothing

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

472− | otherwise = Just (c, text arr (off+d) (len-d))

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

473− where Iter c d = iter t 0

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

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

475

492

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

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

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

555-- Subject to fusion.

572-- Subject to fusion.

556length :: Text -> Int

573length :: Text -> Int

557length t = S.length (stream t)

574length t = S.length (stream t)

558−{-# 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.

559

578

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

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

561-- Subject to fusion.

580-- Subject to fusion.

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

574

593

575{-# RULES

594{-# RULES

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

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

577− (==) (length t) n = compareLength t n == EQ

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

578 #-}

597 #-}

579

598

580{-# RULES

599{-# RULES

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

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

582− (/=) (length t) n = compareLength t n /= EQ

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

583 #-}

602 #-}

584

603

585{-# RULES

604{-# RULES

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

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

587− (<) (length t) n = compareLength t n == LT

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

588 #-}

607 #-}

589

608

590{-# RULES

609{-# RULES

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

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

592− (<=) (length t) n = compareLength t n /= GT

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

593 #-}

612 #-}

594

613

595{-# RULES

614{-# RULES

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

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

597− (>) (length t) n = compareLength t n == GT

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

598 #-}

617 #-}

599

618

600{-# RULES

619{-# RULES

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

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

602− (>=) (length t) n = compareLength t n /= LT

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

603 #-}

622 #-}

604

623

605-- -----------------------------------------------------------------------------

624-- -----------------------------------------------------------------------------

@@ -630,11 +649,37 @@ reverse :: Text -> Text

630reverse t = S.reverse (stream t)

649reverse t = S.reverse (stream t)

631{-# INLINE reverse #-}

650{-# INLINE reverse #-}

632

651

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

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"

634--

672--

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

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

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

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

637−replace :: Text -> Text -> Text -> Text

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.

682+ -> Text

638replace needle@(Text _ _ neeLen)

683replace needle@(Text _ _ neeLen)

639 (Text repArr repOff repLen)

684 (Text repArr repOff repLen)

640 haystack@(Text hayArr hayOff hayLen)

685 haystack@(Text hayArr hayOff hayLen)

@@ -696,7 +741,7 @@ replace needle@(Text _ _ neeLen)

696-- instead of itself.

741-- instead of itself.

697toCaseFold :: Text -> Text

742toCaseFold :: Text -> Text

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

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

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

744+{-# INLINE toCaseFold #-}

700

745

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

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

702-- conversion. Subject to fusion.

747-- conversion. Subject to fusion.

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

870{-# INLINE concatMap #-}

915{-# INLINE concatMap #-}

871

916

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

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

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

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

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

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

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

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

876{-# INLINE any #-}

921{-# INLINE any #-}

877

922

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

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

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

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

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

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

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

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

882{-# INLINE all #-}

927{-# INLINE all #-}

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

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

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

1108 #-}

1153 #-}

1109

1154

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+

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

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

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

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

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

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

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

1125 #-}

1191 #-}

1126

1192

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

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

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

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

1129-- @t@. Subject to fusion.

1195-- @t@. Subject to fusion.

1196+--

1130-- Examples:

1197-- Examples:

1131--

1198--

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

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

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

1146 #-}

1213 #-}

1147

1214

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

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

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

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

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

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

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

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

1152dropAround p = dropWhile p . dropWhileEnd p

1219dropAround p = dropWhile p . dropWhileEnd p

@@ -1241,9 +1308,9 @@ tails t | null t = [empty]

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

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

1242-- are slices of the original.

1309-- are slices of the original.

1243

1310

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

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

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

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

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

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

1247--

1314--

1248-- Examples:

1315-- Examples:

1249--

1316--

@@ -1256,9 +1323,16 @@ tails t | null t = [empty]

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

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

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

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

1258--

1325--

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

1327+--

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

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

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

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

1261−splitOn :: Text -> Text -> [Text]

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]

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

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

1263 | l <= 0 = emptyError "splitOn"

1337 | l <= 0 = emptyError "splitOn"

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

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

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

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

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

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

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

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

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

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

1543+{-# INLINE zip #-}

1470

1544

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

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

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

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

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

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

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

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

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

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

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

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

1551+{-# INLINE zipWith #-}

1478

1552

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

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

1480-- representing white space.

1554-- representing white space.

Data/Text/Array.hs+5−4

@@ -20,7 +20,7 @@

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

21--

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

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

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

24-- naming.

25module Data.Text.Array

26 (

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

74#endif

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

76 indexWord16Array#, newByteArray#,

77− unsafeCoerce#, writeWord16Array#)

77+ unsafeFreezeByteArray#, writeWord16Array#)

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

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

80import Prelude hiding (length, read)

@@ -130,8 +130,9 @@ array_size_error = error "Data.Text.Array.new: size overflow"

130

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

132unsafeFreeze :: MArray s -> ST s Array

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

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

134− (# s#, Array (unsafeCoerce# maBA)

134+ case unsafeFreezeByteArray# maBA s1# of

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

135#if defined(ASSERTS)

136#if defined(ASSERTS)

136 maLen

137 maLen

137#endif

138#endif

Data/Text/Encoding.hs+10−21

@@ -55,13 +55,9 @@ module Data.Text.Encoding

55 , encodeUtf32LE

56 , encodeUtf32BE

57

58−#if MIN_VERSION_bytestring(0,10,4)

59 -- * Encoding Text using ByteString Builders

58 -- * Encoding Text using ByteString Builders

60− -- | /Note/ that these functions are only available if built against

61− -- @bytestring >= 0.10.4.0@.

62 , encodeUtf8Builder

59 , encodeUtf8Builder

63 , encodeUtf8BuilderEscaped

60 , encodeUtf8BuilderEscaped

64−#endif

65 ) where

61 ) where

66

62

67#if __GLASGOW_HASKELL__ >= 702

63#if __GLASGOW_HASKELL__ >= 702

@@ -70,26 +66,17 @@ import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)

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

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

71#endif

67#endif

72

68

73−#if MIN_VERSION_bytestring(0,10,4)

74−import Data.Bits ((.&.))

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

76−import qualified Data.ByteString.Builder as B

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

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

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

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

81−#endif

82−

83import Control.Exception (evaluate, try)

69import Control.Exception (evaluate, try)

84import Control.Monad.ST (runST)

70import Control.Monad.ST (runST)

71+import Data.Bits ((.&.))

85import Data.ByteString as B

72import Data.ByteString as B

86import Data.ByteString.Internal as B hiding (c2w)

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

87−import Data.Text ()

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

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

89import Data.Text.Internal (Text(..), safe, text)

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

90import Data.Text.Internal.Private (runText)

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

91−import Data.Text.Internal.Unsafe.Char (unsafeWrite)

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

92import Data.Text.Internal.Unsafe.Shift (shiftR)

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

79+import Data.Text.Show ()

93import Data.Text.Unsafe (unsafeDupablePerformIO)

80import Data.Text.Unsafe (unsafeDupablePerformIO)

94import Data.Word (Word8, Word32)

81import Data.Word (Word8, Word32)

95import Foreign.C.Types (CSize(..))

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

@@ -98,8 +85,13 @@ import Foreign.Marshal.Utils (with)

98import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)

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

99import Foreign.Storable (Storable, peek, poke)

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

100import GHC.Base (ByteArray#, MutableByteArray#)

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

101import qualified Data.Text.Array as A

92import qualified Data.Text.Array as A

102import qualified Data.Text.Internal.Encoding.Fusion as E

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

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

103import qualified Data.Text.Internal.Fusion as F

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

104

96

105#include "text_cbits.h"

97#include "text_cbits.h"

@@ -267,6 +259,7 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0

267 UTF8_REJECT -> do

259 UTF8_REJECT -> do

268 -- We encountered an encoding error

260 -- We encountered an encoding error

269 x <- peek curPtr'

261 x <- peek curPtr'

262+ poke statePtr 0

270 case onErr desc (Just x) of

263 case onErr desc (Just x) of

271 Nothing -> loop $ curPtr' `plusPtr` 1

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

272 Just c -> do

265 Just c -> do

@@ -274,7 +267,6 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0

274 w <- unsafeSTToIO $

267 w <- unsafeSTToIO $

275 unsafeWrite dest (fromIntegral destOff) (safe c)

268 unsafeWrite dest (fromIntegral destOff) (safe c)

276 poke destOffPtr (destOff + fromIntegral w)

269 poke destOffPtr (destOff + fromIntegral w)

277− poke statePtr 0

278 loop $ curPtr' `plusPtr` 1

270 loop $ curPtr' `plusPtr` 1

279

271

280 _ -> do

272 _ -> do

@@ -286,7 +278,7 @@ streamDecodeUtf8With onErr = decodeChunk B.empty 0 0

286 return $! text arr 0 (fromIntegral n)

278 return $! text arr 0 (fromIntegral n)

287 lastPtr <- peek curPtrPtr

279 lastPtr <- peek curPtrPtr

288 let left = lastPtr `minusPtr` curPtr

280 let left = lastPtr `minusPtr` curPtr

289− undecoded = case state of

281+ !undecoded = case state of

290 UTF8_ACCEPT -> B.empty

282 UTF8_ACCEPT -> B.empty

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

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

292 return $ Some chunkText undecoded

284 return $ Some chunkText undecoded

@@ -315,8 +307,6 @@ decodeUtf8' :: ByteString -> Either UnicodeException Text

315decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDecode

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

316{-# INLINE decodeUtf8' #-}

308{-# INLINE decodeUtf8' #-}

317

309

318−#if MIN_VERSION_bytestring(0,10,4)

319−

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

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

321encodeUtf8Builder :: Text -> B.Builder

311encodeUtf8Builder :: Text -> B.Builder

322encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)

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

@@ -377,7 +367,6 @@ encodeUtf8BuilderEscaped be =

377 outerLoop i (B.BufferRange op ope)

367 outerLoop i (B.BufferRange op ope)

378 where

368 where

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

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

380−#endif

381

370

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

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

383encodeUtf8 :: Text -> ByteString

372encodeUtf8 :: Text -> ByteString

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

@@ -1,5 +1,7 @@

1{-# LANGUAGE CPP, DeriveDataTypeable #-}

2−#if __GLASGOW_HASKELL__ >= 702

2+#if __GLASGOW_HASKELL__ >= 704

3+{-# LANGUAGE Safe #-}

4+#elif __GLASGOW_HASKELL__ >= 702

3{-# LANGUAGE Trustworthy #-}

5{-# LANGUAGE Trustworthy #-}

4#endif

6#endif

5-- |

7-- |

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

66type OnDecodeError = OnError Word8 Char

68type OnDecodeError = OnError Word8 Char

67

69

68-- | A handler for an encoding error.

70-- | A handler for an encoding error.

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

69type OnEncodeError = OnError Char Word8

72type OnEncodeError = OnError Char Word8

70

73

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

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

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

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

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

79 deriving (Eq, Typeable)

82 deriving (Eq, Typeable)

80

83

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

85+

81showUnicodeException :: UnicodeException -> String

86showUnicodeException :: UnicodeException -> String

82showUnicodeException (DecodeError desc (Just w))

87showUnicodeException (DecodeError desc (Just w))

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

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

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

107lenientDecode _ _ = Just '\xfffd'

112lenientDecode _ _ = Just '\xfffd'

108

113

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

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

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

110strictEncode :: OnEncodeError

116strictEncode :: OnEncodeError

111strictEncode desc c = throw (EncodeError desc c)

117strictEncode desc c = throw (EncodeError desc c)

112

118

Data/Text/Internal.hs+7−1

@@ -36,6 +36,7 @@ module Data.Text.Internal

36 , safe

37 -- * Code that must be here for accessibility

38 , empty

39+ , empty_

39 -- * Utilities

40 -- * Utilities

40 , firstf

41 , firstf

41 -- * Checked multiplication

42 -- * Checked multiplication

@@ -81,6 +82,11 @@ empty :: Text

81empty = Text A.empty 0 0

82empty = Text A.empty 0 0

82{-# INLINE [1] empty #-}

83{-# INLINE [1] empty #-}

83

84

85+-- | A non-inlined version of 'empty'.

86+empty_ :: Text

87+empty_ = Text A.empty 0 0

88+{-# NOINLINE empty_ #-}

89+

84-- | Construct a 'Text' without invisibly pinning its byte array in

90-- | Construct a 'Text' without invisibly pinning its byte array in

85-- memory if its length has dwindled to zero.

91-- memory if its length has dwindled to zero.

86text :: A.Array -> Int -> Int -> Text

92text :: A.Array -> Int -> Int -> Text

@@ -110,7 +116,7 @@ safe :: Char -> Char

110safe c

116safe c

111 | ord c .&. 0x1ff800 /= 0xd800 = c

117 | ord c .&. 0x1ff800 /= 0xd800 = c

112 | otherwise = '\xfffd'

118 | otherwise = '\xfffd'

113−{-# INLINE safe #-}

119+{-# INLINE [0] safe #-}

114

120

115-- | Apply a function to the first element of an optional pair.

121-- | Apply a function to the first element of an optional pair.

116firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)

122firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)

Data/Text/Internal/Builder.hs+19−16

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

6-- Module : Data.Text.Internal.Builder

9−-- License : BSD3-style (see LICENSE)

9+-- License : BSD-style (see LICENSE)

10--

11-- Maintainer : Johan Tibell <johan.tibell@gmail.com>

12-- Stability : experimental

@@ -58,13 +58,14 @@ module Data.Text.Internal.Builder

58 ) where

59

60import Control.Monad.ST (ST, runST)

61−import Data.Bits ((.&.))

62import Data.Monoid (Monoid(..))

61import Data.Monoid (Monoid(..))

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

63+import Data.Semigroup (Semigroup(..))

64+#endif

63import Data.Text.Internal (Text(..))

65import Data.Text.Internal (Text(..))

64import Data.Text.Internal.Lazy (smallChunkSize)

66import Data.Text.Internal.Lazy (smallChunkSize)

65import Data.Text.Unsafe (inlineInterleaveST)

67import Data.Text.Unsafe (inlineInterleaveST)

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

68+import Data.Text.Internal.Unsafe.Char (unsafeWrite)

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

68import Prelude hiding (map, putChar)

69import Prelude hiding (map, putChar)

69

70

70import qualified Data.String as String

71import qualified Data.String as String

@@ -91,12 +92,22 @@ newtype Builder = Builder {

91 -> ST s [S.Text]

92 -> ST s [S.Text]

92 }

93 }

93

94

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

96+instance Semigroup Builder where

97+ (<>) = append

98+ {-# INLINE (<>) #-}

99+#endif

100+

94instance Monoid Builder where

101instance Monoid Builder where

95 mempty = empty

102 mempty = empty

96 {-# INLINE mempty #-}

103 {-# INLINE mempty #-}

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

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

106+#else

97 mappend = append

107 mappend = append

108+#endif

98 {-# INLINE mappend #-}

109 {-# INLINE mappend #-}

99− mconcat = foldr mappend mempty

110+ mconcat = foldr mappend Data.Monoid.mempty

100 {-# INLINE mconcat #-}

111 {-# INLINE mconcat #-}

101

112

102instance String.IsString Builder where

113instance String.IsString Builder where

@@ -127,17 +138,7 @@ empty = Builder (\ k buf -> k buf)

127-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@

138-- * @'toLazyText' ('singleton' c) = 'L.singleton' c@

128--

139--

129singleton :: Char -> Builder

140singleton :: Char -> Builder

130−singleton c = writeAtMost 2 $ \ marr o ->

141+singleton c = writeAtMost 2 $ \ marr o -> unsafeWrite marr o c

131− if n < 0x10000

132− then A.unsafeWrite marr o (fromIntegral n) >> return 1

133− else do

134− A.unsafeWrite marr o lo

135− A.unsafeWrite marr (o+1) hi

136− return 2

137− where n = ord c

138− m = n - 0x10000

139− lo = fromIntegral $ (m `shiftR` 10) + 0xD800

140− hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00

141{-# INLINE singleton #-}

142{-# INLINE singleton #-}

142

143

143------------------------------------------------------------------------

144------------------------------------------------------------------------

@@ -241,6 +242,8 @@ flush = Builder $ \ k buf@(Buffer p o u l) ->

241 !t = Text arr o u

242 !t = Text arr o u

242 ts <- inlineInterleaveST (k b)

243 ts <- inlineInterleaveST (k b)

243 return $! t : ts

244 return $! t : ts

245+{-# INLINE [1] flush #-}

246+-- defer inlining so that flush/flush rule may fire.

244

247

245------------------------------------------------------------------------

248------------------------------------------------------------------------

246

249

Data/Text/Internal/Builder/Functions.hs+2−1

@@ -23,7 +23,8 @@ module Data.Text.Internal.Builder.Functions

23

24import Data.Monoid (mappend)

25import Data.Text.Lazy.Builder (Builder)

26−import GHC.Base

26+import GHC.Base (chr#,ord#,(+#),Int(I#),Char(C#))

27+import Prelude ()

27

28

28-- | Unsafe conversion for decimal digits.

29-- | Unsafe conversion for decimal digits.

29{-# INLINE i2d #-}

30{-# INLINE i2d #-}

Data/Text/Internal/Builder/Int/Digits.hs+1−1

@@ -2,7 +2,7 @@

2

3-- Module: Data.Text.Internal.Builder.Int.Digits

5−-- License: BSD3

5+-- License: BSD-style

6-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>

7-- Stability: experimental

8-- Portability: portable

Data/Text/Internal/Builder/RealFloat/Functions.hs+28

@@ -1,3 +1,5 @@

1+{-# LANGUAGE CPP #-}

2+

1-- |

3-- |

2-- Module: Data.Text.Internal.Builder.RealFloat.Functions

4-- Module: Data.Text.Internal.Builder.RealFloat.Functions

3-- Copyright: (c) The University of Glasgow 1994-2002

5-- Copyright: (c) The University of Glasgow 1994-2002

@@ -13,6 +15,30 @@ module Data.Text.Internal.Builder.RealFloat.Functions

13 ) where

15 ) where

14

16

15roundTo :: Int -> [Int] -> (Int,[Int])

17roundTo :: 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+

16roundTo d is =

42roundTo d is =

17 case f d is of

43 case f d is of

18 x@(0,_) -> x

44 x@(0,_) -> x

@@ -27,3 +53,5 @@ roundTo d is =

27 where

53 where

28 (c,ds) = f (n-1) xs

54 (c,ds) = f (n-1) xs

29 i' = c + i

55 i' = c + i

56+

57+#endif

Data/Text/Internal/Fusion.hs+34−24

@@ -98,25 +98,35 @@ reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `sh

98-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.

99unstream :: Stream Char -> Text

100unstream (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.

101− let mlen = upperBound 4 len

105+ let mlen = upperBound 4 len + 1

102 arr0 <- A.new mlen

106 arr0 <- A.new mlen

103− let outer arr top = loop

107+ let outer !arr !maxi = encode

104 where

108 where

105− loop !s !i =

109+ -- keep the common case loop as small as possible

110+ encode !si !di =

106− case next0 s of

111+ case next0 si of

107− Done -> done arr i

112+ Done -> done arr di

108− Skip s' -> loop s' i

113+ Skip si' -> encode si' di

109− Yield x s'

114+ Yield c si'

110− | j >= top -> {-# SCC "unstream/resize" #-} do

115+ -- simply check for the worst case

111− let top' = (top + 1) `shiftL` 1

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

112− arr' <- A.new top'

125+ arr' <- A.new newlen

113− A.copyM arr' 0 arr 0 top

126+ A.copyM arr' 0 arr 0 di

114− outer arr' top' s i

127+ outer arr' (newlen - 1) si di

115− | otherwise -> do d <- unsafeWrite arr i x

128+

116− loop s' (i+d)

117− where j | ord x < 0x10000 = i

118− | otherwise = i + 1

119− outer arr0 mlen s0 0

129+ outer arr0 (mlen - 1) s0 0

120{-# INLINE [0] unstream #-}

130{-# INLINE [0] unstream #-}

121{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}

131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}

122

132

@@ -166,15 +176,15 @@ reverse (Stream next s len0)

166-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with

176-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with

167-- the input and result reversed.

177-- the input and result reversed.

168reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

178reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

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

170 where

180 where

171 {-# INLINE next #-}

181 {-# INLINE next #-}

172− next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)

182+ next (Scan1 z s) = Yield z (Scan2 z s)

173− next (S2 :*: z :*: s) = case next0 s of

183+ next (Scan2 z s) = case next0 s of

174− Yield x s' -> let !x' = f x z

184+ Yield x s' -> let !x' = f x z

175− in Yield x' (S2 :*: x' :*: s')

185+ in Yield x' (Scan2 x' s')

176− Skip s' -> Skip (S2 :*: z :*: s')

186+ Skip s' -> Skip (Scan2 z s')

177− Done -> Done

187+ Done -> Done

178{-# INLINE reverseScanr #-}

188{-# INLINE reverseScanr #-}

179

189

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

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

Data/Text/Internal/Fusion/CaseMapping.hs+291−19

@@ -1,17 +1,17 @@

1{-# LANGUAGE Rank2Types #-}

2-- AUTOMATICALLY GENERATED - DO NOT EDIT

3−-- Generated by scripts/SpecialCasing.hs

3+-- Generated by scripts/CaseMapping.hs

4−-- CaseFolding-6.3.0.txt

4+-- CaseFolding-8.0.0.txt

5−-- Date: 2012-12-20, 22:14:35 GMT [MD]

5+-- Date: 2015-01-13, 18:16:36 GMT [MD]

6−-- SpecialCasing-6.3.0.txt

6+-- SpecialCasing-8.0.0.txt

7−-- Date: 2013-05-08, 13:54:51 GMT [MD]

7+-- Date: 2014-12-16, 23:08:04 GMT [MD]

8

9module Data.Text.Internal.Fusion.CaseMapping where

10import Data.Char

11import Data.Text.Internal.Fusion.Types

12

13upperMapping :: forall s. Char -> s -> Step (CC s) Char

14−{-# INLINE upperMapping #-}

14+{-# NOINLINE upperMapping #-}

15-- LATIN SMALL LETTER SHARP S

16upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000')

17-- LATIN SMALL LIGATURE FF

@@ -218,12 +218,12 @@ upperMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0399')

218upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399')

219upperMapping c s = Yield (toUpper c) (CC s '\0' '\0')

220lowerMapping :: forall s. Char -> s -> Step (CC s) Char

221−{-# INLINE lowerMapping #-}

221+{-# NOINLINE lowerMapping #-}

222-- LATIN CAPITAL LETTER I WITH DOT ABOVE

223lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000')

224lowerMapping c s = Yield (toLower c) (CC s '\0' '\0')

225titleMapping :: forall s. Char -> s -> Step (CC s) Char

226−{-# INLINE titleMapping #-}

226+{-# NOINLINE titleMapping #-}

227-- LATIN SMALL LETTER SHARP S

228titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000')

229-- LATIN SMALL LIGATURE FF

@@ -322,7 +322,7 @@ titleMapping '\x1fc7' s = Yield '\x0397' (CC s '\x0342' '\x0345')

322titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345')

323titleMapping c s = Yield (toTitle c) (CC s '\0' '\0')

324foldMapping :: forall s. Char -> s -> Step (CC s) Char

325−{-# INLINE foldMapping #-}

325+{-# NOINLINE foldMapping #-}

326-- MICRO SIGN

327foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000')

328-- LATIN SMALL LETTER SHARP S

@@ -359,10 +359,18 @@ foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000')

359foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')

360-- ARMENIAN SMALL LIGATURE ECH YIWN

361foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000')

362−-- GEORGIAN CAPITAL LETTER YN

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

363−foldMapping '\x10c7' s = Yield '\x2d27' (CC s '\x0000' '\x0000')

371+foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')

364−-- GEORGIAN CAPITAL LETTER AEN

372+-- CHEROKEE SMALL LETTER MV

365−foldMapping '\x10cd' s = Yield '\x2d2d' (CC s '\x0000' '\x0000')

373+foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')

366-- LATIN SMALL LETTER H WITH LINE BELOW

374-- LATIN SMALL LETTER H WITH LINE BELOW

367foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')

375foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')

368-- LATIN SMALL LETTER T WITH DIAERESIS

376-- LATIN SMALL LETTER T WITH DIAERESIS

@@ -537,12 +545,174 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')

537foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')

545foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')

538-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

546-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

539foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')

547foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')

540−-- COPTIC CAPITAL LETTER BOHAIRIC KHEI

548+-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL

541−foldMapping '\x2cf2' s = Yield '\x2cf3' (CC s '\x0000' '\x0000')

549+foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')

542−-- LATIN CAPITAL LETTER C WITH BAR

550+-- LATIN CAPITAL LETTER CHI

551+foldMapping '\xa7b3' s = Yield '\xab53' (CC s '\x0000' '\x0000')

552+-- LATIN CAPITAL LETTER BETA

543−foldMapping '\xa792' s = Yield '\xa793' (CC s '\x0000' '\x0000')

553+foldMapping '\xa7b4' s = Yield '\xa7b5' (CC s '\x0000' '\x0000')

544−-- LATIN CAPITAL LETTER H WITH HOOK

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

545−foldMapping '\xa7aa' s = Yield '\x0266' (CC s '\x0000' '\x0000')

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

546-- LATIN SMALL LIGATURE FF

716-- LATIN SMALL LIGATURE FF

547foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')

717foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000')

548-- LATIN SMALL LIGATURE FI

718-- LATIN SMALL LIGATURE FI

@@ -567,4 +737,106 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')

567foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')

737foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')

568-- ARMENIAN SMALL LIGATURE MEN XEH

738-- ARMENIAN SMALL LIGATURE MEN XEH

569foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')

739foldMapping '\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')

570foldMapping c s = Yield (toLower c) (CC s '\0' '\0')

842foldMapping c s = Yield (toLower c) (CC s '\0' '\0')

Data/Text/Internal/Fusion/Common.hs+59−72

@@ -71,9 +71,6 @@ module Data.Text.Internal.Fusion.Common

71 -- ** Scans

72 , scanl

73

74− -- ** Accumulating maps

75− -- , mapAccumL

76−

77 -- ** Generation and unfolding

74 -- ** Generation and unfolding

78 , replicateCharI

75 , replicateCharI

79 , replicateI

76 , replicateI

@@ -123,7 +120,7 @@ singleton :: Char -> Stream Char

123singleton c = Stream next False 1

120singleton c = Stream next False 1

124 where next False = Yield c True

121 where next False = Yield c True

125 next True = Done

122 next True = Done

126−{-# INLINE singleton #-}

123+{-# INLINE [0] singleton #-}

127

124

128streamList :: [a] -> Stream a

125streamList :: [a] -> Stream a

129{-# INLINE [0] streamList #-}

126{-# INLINE [0] streamList #-}

@@ -187,6 +184,9 @@ cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)

187 Yield x s' -> Yield x (C0 s')

184 Yield x s' -> Yield x (C0 s')

188{-# INLINE [0] cons #-}

185{-# INLINE [0] cons #-}

189

186

187+data Snoc a = N

188+ | J !a

189+

190-- | /O(n)/ Adds a character to the end of a stream.

191snoc :: Stream Char -> Char -> Stream Char

192snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)

@@ -473,17 +473,20 @@ toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len

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+

476justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

479justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

477justifyLeftI k c (Stream next0 s0 len) =

480justifyLeftI k c (Stream next0 s0 len) =

478− Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)

481+ Stream next (Just1 0 s0) (larger (fromIntegral k) len)

479 where

482 where

480− next (s :*: S1 :*: n) =

483+ next (Just1 n s) =

481 case next0 s of

484 case next0 s of

482− Done -> next (s :*: S2 :*: n)

485+ Done -> next (Just2 n s)

483− Skip s' -> Skip (s' :*: S1 :*: n)

486+ Skip s' -> Skip (Just1 n s')

484− Yield x s' -> Yield x (s' :*: S1 :*: n+1)

487+ Yield x s' -> Yield x (Just1 (n+1) s')

485− next (s :*: S2 :*: n)

488+ next (Just2 n s)

486− | n < k = Yield c (s :*: S2 :*: n+1)

489+ | n < k = Yield c (Just2 (n+1) s)

487 | otherwise = Done

490 | otherwise = Done

488 {-# INLINE next #-}

491 {-# INLINE next #-}

489{-# INLINE [0] justifyLeftI #-}

492{-# INLINE [0] justifyLeftI #-}

@@ -590,7 +593,7 @@ concatMap f = foldr (append . f) empty

590{-# INLINE [0] concatMap #-}

593{-# INLINE [0] concatMap #-}

591

594

592-- | /O(n)/ any @p @xs determines if any character in the stream

595-- | /O(n)/ any @p @xs determines if any character in the stream

593−-- @xs@ satisifes the predicate @p@.

596+-- @xs@ satisfies the predicate @p@.

594any :: (Char -> Bool) -> Stream Char -> Bool

597any :: (Char -> Bool) -> Stream Char -> Bool

595any p (Stream next0 s0 _len) = loop_any s0

598any p (Stream next0 s0 _len) = loop_any s0

596 where

599 where

@@ -602,7 +605,7 @@ any p (Stream next0 s0 _len) = loop_any s0

602{-# INLINE [0] any #-}

605{-# INLINE [0] any #-}

603

606

604-- | /O(n)/ all @p @xs determines if all characters in the 'Text'

607-- | /O(n)/ all @p @xs determines if all characters in the 'Text'

605−-- @xs@ satisify the predicate @p@.

608+-- @xs@ satisfy the predicate @p@.

606all :: (Char -> Bool) -> Stream Char -> Bool

609all :: (Char -> Bool) -> Stream Char -> Bool

607all p (Stream next0 s0 _len) = loop_all s0

610all p (Stream next0 s0 _len) = loop_all s0

608 where

611 where

@@ -651,50 +654,27 @@ minimum (Stream next0 s0 _len) = loop0_minimum s0

651-- * Building streams

654-- * Building streams

652

655

653scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

656scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char

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

655 where

658 where

656 {-# INLINE next #-}

659 {-# INLINE next #-}

657− next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)

660+ next (Scan1 z s) = Yield z (Scan2 z s)

658− next (S2 :*: z :*: s) = case next0 s of

661+ next (Scan2 z s) = case next0 s of

659− Yield x s' -> let !x' = f z x

662+ Yield x s' -> let !x' = f z x

660− in Yield x' (S2 :*: x' :*: s')

663+ in Yield x' (Scan2 x' s')

661− Skip s' -> Skip (S2 :*: z :*: s')

664+ Skip s' -> Skip (Scan2 z s')

662− Done -> Done

665+ Done -> Done

663{-# INLINE [0] scanl #-}

666{-# INLINE [0] scanl #-}

664

667

665−-- -----------------------------------------------------------------------------

666−-- ** Accumulating maps

667−

668−{-

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

670−-- function to each element of a stream, passing an accumulating

671−-- parameter from left to right, and returns a final stream.

672−--

673−-- /Note/: Unlike the version over lists, this function does not

674−-- return a final value for the accumulator, because the nature of

675−-- streams precludes it.

676−mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b

677−mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f

678− where

679− {-# INLINE next #-}

680− next (s :*: z) = case next0 s of

681− Yield x s' -> let (z',y) = f z x

682− in Yield y (s' :*: z')

683− Skip s' -> Skip (s' :*: z)

684− Done -> Done

685−{-# INLINE [0] mapAccumL #-}

686−-}

687−

688-- -----------------------------------------------------------------------------

668-- -----------------------------------------------------------------------------

689-- ** Generating and unfolding streams

669-- ** Generating and unfolding streams

690

670

691replicateCharI :: Integral a => a -> Char -> Stream Char

671replicateCharI :: Integral a => a -> Char -> Stream Char

692−replicateCharI n c

672+replicateCharI !n !c

693 | n < 0 = empty

673 | n < 0 = empty

694 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low

674 | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low

695 where

675 where

696− next i | i >= n = Done

676+ next !i | i >= n = Done

697− | otherwise = Yield c (i + 1)

677+ | otherwise = Yield c (i + 1)

698{-# INLINE [0] replicateCharI #-}

678{-# INLINE [0] replicateCharI #-}

699

679

700data RI s = RI !s {-# UNPACK #-} !Int64

680data RI s = RI !s {-# UNPACK #-} !Int64

@@ -759,24 +739,27 @@ take n0 (Stream next0 s0 len) =

759 Yield x s' -> Yield x ((n-1) :*: s')

739 Yield x s' -> Yield x ((n-1) :*: s')

760{-# INLINE [0] take #-}

740{-# INLINE [0] take #-}

761

741

742+data Drop a s = NS !s

743+ | JS !a !s

744+

762-- | /O(n)/ drop n, applied to a stream, returns the suffix of the

745-- | /O(n)/ drop n, applied to a stream, returns the suffix of the

763-- stream after the first @n@ characters, or the empty stream if @n@

746-- stream after the first @n@ characters, or the empty stream if @n@

764-- is greater than the length of the stream.

747-- is greater than the length of the stream.

765drop :: Integral a => a -> Stream Char -> Stream Char

748drop :: Integral a => a -> Stream Char -> Stream Char

766drop n0 (Stream next0 s0 len) =

749drop n0 (Stream next0 s0 len) =

767− Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))

750+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))

768 where

751 where

769 {-# INLINE next #-}

752 {-# INLINE next #-}

770− next (J n :*: s)

753+ next (JS n s)

771− | n <= 0 = Skip (N :*: s)

754+ | n <= 0 = Skip (NS s)

772 | otherwise = case next0 s of

755 | otherwise = case next0 s of

773 Done -> Done

756 Done -> Done

774− Skip s' -> Skip (J n :*: s')

757+ Skip s' -> Skip (JS n s')

775− Yield _ s' -> Skip (J (n-1) :*: s')

758+ Yield _ s' -> Skip (JS (n-1) s')

776− next (N :*: s) = case next0 s of

759+ next (NS s) = case next0 s of

777 Done -> Done

760 Done -> Done

778− Skip s' -> Skip (N :*: s')

761+ Skip s' -> Skip (NS s')

779− Yield x s' -> Yield x (N :*: s')

762+ Yield x s' -> Yield x (NS s')

780{-# INLINE [0] drop #-}

763{-# INLINE [0] drop #-}

781

764

782-- | takeWhile, applied to a predicate @p@ and a stream, returns the

765-- | takeWhile, applied to a predicate @p@ and a stream, returns the

@@ -794,18 +777,18 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

794

777

795-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

778-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.

796dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

779dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

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

798 where

781 where

799 {-# INLINE next #-}

782 {-# INLINE next #-}

800− next (S1 :*: s) = case next0 s of

783+ next (L s) = case next0 s of

801 Done -> Done

784 Done -> Done

802− Skip s' -> Skip (S1 :*: s')

785+ Skip s' -> Skip (L s')

803− Yield x s' | p x -> Skip (S1 :*: s')

786+ Yield x s' | p x -> Skip (L s')

804− | otherwise -> Yield x (S2 :*: s')

787+ | otherwise -> Yield x (R s')

805− next (S2 :*: s) = case next0 s of

788+ next (R s) = case next0 s of

806 Done -> Done

789 Done -> Done

807− Skip s' -> Skip (S2 :*: s')

790+ Skip s' -> Skip (R s')

808− Yield x s' -> Yield x (S2 :*: s')

791+ Yield x s' -> Yield x (R s')

809{-# INLINE [0] dropWhile #-}

792{-# INLINE [0] dropWhile #-}

810

793

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

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

@@ -912,21 +895,25 @@ findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0

912-------------------------------------------------------------------------------

895-------------------------------------------------------------------------------

913-- * Zipping

896-- * Zipping

914

897

898+-- | Strict triple.

899+data Zip a b m = Z1 !a !b

900+ | Z2 !a !b !m

901+

915-- | zipWith generalises 'zip' by zipping with the function given as

902-- | zipWith generalises 'zip' by zipping with the function given as

916-- the first argument, instead of a tupling function.

903-- the first argument, instead of a tupling function.

917zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b

904zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b

918zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =

905zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =

919− Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)

906+ Stream next (Z1 sa0 sb0) (smaller len1 len2)

920 where

907 where

921− next (sa :*: sb :*: N) = case next0 sa of

908+ next (Z1 sa sb) = case next0 sa of

922− Done -> Done

909+ Done -> Done

923− Skip sa' -> Skip (sa' :*: sb :*: N)

910+ Skip sa' -> Skip (Z1 sa' sb)

924− Yield a sa' -> Skip (sa' :*: sb :*: J a)

911+ Yield a sa' -> Skip (Z2 sa' sb a)

925−

912+

926− next (sa' :*: sb :*: J a) = case next1 sb of

913+ next (Z2 sa' sb a) = case next1 sb of

927− Done -> Done

914+ Done -> Done

928− Skip sb' -> Skip (sa' :*: sb' :*: J a)

915+ Skip sb' -> Skip (Z2 sa' sb' a)

929− Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)

916+ Yield b sb' -> Yield (f a b) (Z1 sa' sb')

930{-# INLINE [0] zipWith #-}

917{-# INLINE [0] zipWith #-}

931

918

932-- | /O(n)/ The 'countCharI' function returns the number of times the

919-- | /O(n)/ The 'countCharI' function returns the number of times the

Data/Text/Internal/Fusion/Types.hs+8−13

@@ -20,13 +20,11 @@

20module Data.Text.Internal.Fusion.Types

21 (

22 CC(..)

23− , M(..)

24− , M8

25 , PairS(..)

23 , PairS(..)

24+ , Scan(..)

26 , RS(..)

25 , RS(..)

27 , Step(..)

26 , Step(..)

28 , Stream(..)

27 , Stream(..)

29− , Switch(..)

30 , empty

28 , empty

31 ) where

29 ) where

32

30

@@ -36,26 +34,23 @@ import Data.Word (Word8)

36-- | Specialised tuple for case conversion.

34-- | Specialised tuple for case conversion.

37data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

35data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char

38

36

39−-- | Specialised, strict Maybe-like type.

40−data M a = N

41− | J !a

42−

43−type M8 = M Word8

44−

45−-- Restreaming state.

37+-- | Restreaming state.

46data RS s

38data RS s

47 = RS0 !s

39 = RS0 !s

48 | RS1 !s {-# UNPACK #-} !Word8

40 | RS1 !s {-# UNPACK #-} !Word8

49 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

41 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

50 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

42 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

51

43

52−infixl 2 :*:

44+-- | Strict pair.

53data PairS a b = !a :*: !b

45data PairS a b = !a :*: !b

54 -- deriving (Eq, Ord, Show)

46 -- deriving (Eq, Ord, Show)

47+infixl 2 :*:

55

48

56−-- | Allow a function over a stream to switch between two states.

49+-- | An intermediate result in a scan.

57−data Switch = S1 | S2

50+data Scan s = Scan1 {-# UNPACK #-} !Char !s

51+ | Scan2 {-# UNPACK #-} !Char !s

58

52

53+-- | Intermediate result in a processing pipeline.

59data Step s a = Done

54data Step s a = Done

60 | Skip !s

55 | Skip !s

61 | Yield !a !s

56 | Yield !a !s

Data/Text/Internal/Read.hs+3−3

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

7-- Stability : experimental

8-- Portability : GHC

9--

10−-- Common internal functiopns for reading textual data.

10+-- Common internal functions for reading textual data.

11module Data.Text.Internal.Read

12 (

13 IReader

@@ -18,7 +18,7 @@ module Data.Text.Internal.Read

18 , perhaps

19 ) where

20

21−import Control.Applicative (Applicative(..))

21+import Control.Applicative as App (Applicative(..))

22import Control.Arrow (first)

23import Control.Monad (ap)

24import Data.Char (ord)

@@ -38,7 +38,7 @@ instance Applicative (IParser t) where

38 (<*>) = ap

39

40instance Monad (IParser t) where

41− return = pure

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'

Data/Text/Lazy.hs+161−21

@@ -3,6 +3,10 @@

3#if __GLASGOW_HASKELL__ >= 702

4{-# LANGUAGE Trustworthy #-}

5#endif

6+#if __GLASGOW_HASKELL__ >= 708

7+{-# LANGUAGE TypeFamilies #-}

8+#endif

9+

6-- |

10-- |

7-- Module : Data.Text.Lazy

11-- Module : Data.Text.Lazy

@@ -121,7 +125,10 @@ module Data.Text.Lazy

121 , mapAccumR

125 , mapAccumR

122

126

123 -- ** Generation and unfolding

127 -- ** Generation and unfolding

128+ , repeat

124 , replicate

129 , replicate

130+ , cycle

131+ , iterate

125 , unfoldr

132 , unfoldr

126 , unfoldrN

133 , unfoldrN

127

134

@@ -133,6 +140,7 @@ module Data.Text.Lazy

133 , drop

140 , drop

134 , dropEnd

141 , dropEnd

135 , takeWhile

142 , takeWhile

143+ , takeWhileEnd

136 , dropWhile

144 , dropWhile

137 , dropWhileEnd

145 , dropWhileEnd

138 , dropAround

146 , dropAround

@@ -203,9 +211,13 @@ import Control.DeepSeq (NFData(..))

203import Data.Int (Int64)

211import Data.Int (Int64)

204import qualified Data.List as L

212import qualified Data.List as L

205import Data.Char (isSpace)

213import Data.Char (isSpace)

206−import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))

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

207−import Data.Data (mkNoRepType)

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

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

208import Data.Monoid (Monoid(..))

217import Data.Monoid (Monoid(..))

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

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

220+#endif

209import Data.String (IsString(..))

221import Data.String (IsString(..))

210import qualified Data.Text as T

222import qualified Data.Text as T

211import qualified Data.Text.Internal as T

223import qualified Data.Text.Internal as T

@@ -214,8 +226,10 @@ import qualified Data.Text.Unsafe as T

214import qualified Data.Text.Internal.Lazy.Fusion as S

226import qualified Data.Text.Internal.Lazy.Fusion as S

215import Data.Text.Internal.Fusion.Types (PairS(..))

227import Data.Text.Internal.Fusion.Types (PairS(..))

216import Data.Text.Internal.Lazy.Fusion (stream, unstream)

228import Data.Text.Internal.Lazy.Fusion (stream, unstream)

217−import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks, foldrChunks)

229+import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,

230+ foldrChunks, smallChunkSize)

218import Data.Text.Internal (firstf, safe, text)

231import Data.Text.Internal (firstf, safe, text)

232+import Data.Text.Lazy.Encoding (decodeUtf8', encodeUtf8)

219import qualified Data.Text.Internal.Functions as F

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

220import Data.Text.Internal.Lazy.Search (indices)

234import Data.Text.Internal.Lazy.Search (indices)

221#if __GLASGOW_HASKELL__ >= 702

235#if __GLASGOW_HASKELL__ >= 702

@@ -223,7 +237,13 @@ import qualified GHC.CString as GHC

223#else

237#else

224import qualified GHC.Base as GHC

238import qualified GHC.Base as GHC

225#endif

239#endif

240+#if __GLASGOW_HASKELL__ >= 708

241+import qualified GHC.Exts as Exts

242+#endif

226import GHC.Prim (Addr#)

243import GHC.Prim (Addr#)

244+#if MIN_VERSION_base(4,7,0)

245+import Text.Printf (PrintfArg, formatArg, formatString)

246+#endif

227

247

228-- $fusion

248-- $fusion

229--

249--

@@ -321,25 +341,71 @@ instance Show Text where

321instance Read Text where

341instance Read Text where

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

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

323

343

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+

324instance Monoid Text where

352instance Monoid Text where

325 mempty = empty

353 mempty = empty

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

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

356+#else

326 mappend = append

357 mappend = append

358+#endif

327 mconcat = concat

359 mconcat = concat

328

360

329instance IsString Text where

361instance IsString Text where

330 fromString = pack

362 fromString = pack

331

363

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+

332#if defined(HAVE_DEEPSEQ)

371#if defined(HAVE_DEEPSEQ)

333instance NFData Text where

372instance NFData Text where

334 rnf Empty = ()

373 rnf Empty = ()

335 rnf (Chunk _ ts) = rnf ts

374 rnf (Chunk _ ts) = rnf ts

336#endif

375#endif

337

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'

338instance Data Text where

390instance Data Text where

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

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

340− toConstr _ = error "Data.Text.Lazy.Text.toConstr"

392+ toConstr _ = packConstr

393+ gunfold k z c = case constrIndex c of

394+ 1 -> k (z pack)

341− gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"

395+ _ -> error "Data.Text.Lazy.Text.gunfold"

342− dataTypeOf _ = mkNoRepType "Data.Text.Lazy.Text"

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]

343

409

344-- | /O(n)/ Convert a 'String' into a 'Text'.

410-- | /O(n)/ Convert a 'String' into a 'Text'.

345--

411--

@@ -367,6 +433,14 @@ unpackCString# addr# = unstream (S.streamCString# addr#)

367 unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))

433 unstream (S.streamList (L.map safe (GHC.unpackCStringUtf8# a)))

368 = unpackCString# a #-}

434 = unpackCString# a #-}

369

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+

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

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

371-- Performs replacement on invalid scalar values.

445-- Performs replacement on invalid scalar values.

372singleton :: Char -> Text

446singleton :: Char -> Text

@@ -471,7 +545,7 @@ tail Empty = emptyError "tail"

471 unstream (S.tail (stream t)) = tail t

545 unstream (S.tail (stream t)) = tail t

472 #-}

546 #-}

473

547

474−-- | /O(1)/ Returns all but the last character of a 'Text', which must

548+-- | /O(n\/c)/ Returns all but the last character of a 'Text', which must

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

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

476init :: Text -> Text

550init :: Text -> Text

477init (Chunk t0 ts0) = go t0 ts0

551init (Chunk t0 ts0) = go t0 ts0

@@ -507,7 +581,7 @@ isSingleton :: Text -> Bool

507isSingleton = S.isSingleton . stream

581isSingleton = S.isSingleton . stream

508{-# INLINE isSingleton #-}

582{-# INLINE isSingleton #-}

509

583

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

584+-- | /O(n\/c)/ Returns the last character of a 'Text', which must be

511-- non-empty. Subject to fusion.

585-- non-empty. Subject to fusion.

512last :: Text -> Char

586last :: Text -> Char

513last Empty = emptyError "last"

587last Empty = emptyError "last"

@@ -641,13 +715,36 @@ reverse = rev Empty

641 where rev a Empty = a

715 where rev a Empty = a

642 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts

716 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts

643

717

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

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"

645--

738--

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

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

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

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

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

741+replace :: Text

649− -> Text -- ^ Replacement text

742+ -- ^ @needle@ to search for. If this string is empty, an

743+ -- error will occur.

744+ -> Text

745+ -- ^ @replacement@ to replace @needle@ with.

650− -> Text -- ^ Input text

746+ -> Text

747+ -- ^ @haystack@ in which to search.

651 -> Text

748 -> Text

652replace s d = intercalate d . splitOn s

749replace s d = intercalate d . splitOn s

653{-# INLINE replace #-}

750{-# INLINE replace #-}

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

784{-# INLINE concatMap #-}

881{-# INLINE concatMap #-}

785

882

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

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

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

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

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

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

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

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

790{-# INLINE any #-}

887{-# INLINE any #-}

791

888

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

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

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

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

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

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

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

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

796{-# INLINE all #-}

893{-# INLINE all #-}

@@ -873,6 +970,12 @@ mapAccumR f = go

873 go z Empty = (z, Empty)

970 go z Empty = (z, Empty)

874{-# INLINE mapAccumR #-}

971{-# INLINE mapAccumR #-}

875

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

978+

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

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

877-- @t@ repeated @n@ times.

980-- @t@ repeated @n@ times.

878replicate :: Int64 -> Text -> Text

981replicate :: Int64 -> Text -> Text

@@ -884,6 +987,21 @@ replicate n t

884 | otherwise = t : rep (i+1)

987 | otherwise = t : rep (i+1)

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

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

886

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

1004+

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

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

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

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

889replicateChar :: Int64 -> Char -> Text

1007replicateChar :: Int64 -> Char -> Text

@@ -1026,6 +1144,20 @@ takeWhile p t0 = takeWhile' t0

1026"LAZY TEXT takeWhile -> unfused" [1] forall p t.

1144"LAZY TEXT takeWhile -> unfused" [1] forall p t.

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

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

1028 #-}

1146 #-}

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

1029

1161

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

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

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

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

@@ -1044,9 +1176,11 @@ dropWhile p t0 = dropWhile' t0

1044"LAZY TEXT dropWhile -> unfused" [1] forall p t.

1176"LAZY TEXT dropWhile -> unfused" [1] forall p t.

1045 unstream (S.dropWhile p (stream t)) = dropWhile p t

1177 unstream (S.dropWhile p (stream t)) = dropWhile p t

1046 #-}

1178 #-}

1179+

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

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

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

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

1049-- @t@.

1182-- @t@.

1183+--

1050-- Examples:

1184-- Examples:

1051--

1185--

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

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

@@ -1063,7 +1197,7 @@ dropWhileEnd p = go

1063{-# INLINE dropWhileEnd #-}

1197{-# INLINE dropWhileEnd #-}

1064

1198

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

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

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

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

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

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

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

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

1069dropAround p = dropWhile p . dropWhileEnd p

1203dropAround p = dropWhile p . dropWhileEnd p

@@ -1258,9 +1392,10 @@ tails ts@(Chunk t ts')

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

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

1259-- are slices of the original.

1393-- are slices of the original.

1260

1394

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

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

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

1396+-- argument (which cannot be an empty string), consuming the

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

1397+-- delimiter. An empty delimiter is invalid, and will cause an error

1398+-- to be raised.

1264--

1399--

1265-- Examples:

1400-- Examples:

1266--

1401--

@@ -1273,13 +1408,18 @@ tails ts@(Chunk t ts')

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

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

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

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

1275--

1410--

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

1412+--

1276-- This function is strict in its first argument, and lazy in its

1413-- This function is strict in its first argument, and lazy in its

1277-- second.

1414-- second.

1278--

1415--

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

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

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

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

1281−splitOn :: Text -- ^ Text to split on

1418+splitOn :: Text

1419+ -- ^ String to split on. If this string is empty, an error

1420+ -- will occur.

1421+ -> Text

1282− -> Text -- ^ Input text

1422+ -- ^ Input text.

1283 -> [Text]

1423 -> [Text]

1284splitOn pat src

1424splitOn pat src

1285 | null pat = emptyError "splitOn"

1425 | null pat = emptyError "splitOn"

Data/Text/Lazy/Builder.hs+1−1

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

8-- Module : Data.Text.Lazy.Builder

11−-- License : BSD3-style (see LICENSE)

11+-- License : BSD-style (see LICENSE)

12--

13-- Maintainer : Johan Tibell <johan.tibell@gmail.com>

14-- Stability : experimental

Data/Text/Lazy/Builder/Int.hs+19−14

@@ -1,4 +1,5 @@

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

1+{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,

2+ UnboxedTuples #-}

2#if __GLASGOW_HASKELL__ >= 702

3#if __GLASGOW_HASKELL__ >= 702

3{-# LANGUAGE Trustworthy #-}

4{-# LANGUAGE Trustworthy #-}

4#endif

5#endif

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

6-- Module: Data.Text.Lazy.Builder.Int

7-- Module: Data.Text.Lazy.Builder.Int

9−-- License: BSD3

10+-- License: BSD-style

10-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>

11-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>

11-- Stability: experimental

12-- Stability: experimental

12-- Portability: portable

13-- Portability: portable

@@ -34,7 +35,7 @@ import Control.Monad.ST

34

35

35#ifdef __GLASGOW_HASKELL__

36#ifdef __GLASGOW_HASKELL__

36# if defined(INTEGER_GMP)

37# if defined(INTEGER_GMP)

37−import GHC.Integer.GMP.Internals

38+import GHC.Integer.GMP.Internals (Integer(S#))

38# elif defined(INTEGER_SIMPLE)

39# elif defined(INTEGER_SIMPLE)

39import GHC.Integer

40import GHC.Integer

40# else

41# else

@@ -54,7 +55,7 @@ decimal :: Integral a => a -> Builder

54{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}

55{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}

55{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}

56{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}

56{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}

57{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}

57−{-# RULES "decimal/Word" decimal = positive :: Word -> Builder #-}

58+{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}

58{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}

59{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}

59{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}

60{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}

60{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}

61{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}

@@ -133,8 +134,15 @@ i2w v = zero + fromIntegral v

133

134

134countDigits :: (Integral a) => a -> Int

135countDigits :: (Integral a) => a -> Int

135{-# INLINE countDigits #-}

136{-# INLINE countDigits #-}

136−countDigits v0 = go 1 (fromIntegral v0 :: Word64)

137+countDigits v0

137− where go !k v

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)

138 | v < 10 = k

146 | v < 10 = k

139 | v < 100 = k + 1

147 | v < 100 = k + 1

140 | v < 1000 = k + 2

148 | v < 1000 = k + 2

@@ -186,19 +194,12 @@ hexDigit n

186 | otherwise = singleton $! toEnum (fromIntegral n + 87)

194 | otherwise = singleton $! toEnum (fromIntegral n + 87)

187{-# INLINE hexDigit #-}

195{-# INLINE hexDigit #-}

188

196

189−int :: Int -> Builder

190−int = decimal

191−{-# INLINE int #-}

192−

193data T = T !Integer !Int

197data T = T !Integer !Int

194

198

195integer :: Int -> Integer -> Builder

199integer :: Int -> Integer -> Builder

196#ifdef INTEGER_GMP

200#ifdef INTEGER_GMP

197integer 10 (S# i#) = decimal (I# i#)

201integer 10 (S# i#) = decimal (I# i#)

198integer 16 (S# i#) = hexadecimal (I# i#)

202integer 16 (S# i#) = hexadecimal (I# i#)

199−#else

200−integer 10 i = decimal i

201−integer 16 i = hexadecimal i

202#endif

203#endif

203integer base i

204integer base i

204 | i < 0 = singleton '-' <> go (-i)

205 | i < 0 = singleton '-' <> go (-i)

@@ -246,7 +247,11 @@ integer base i

246 PAIR(x,y) -> pblock q <> pblock r <> putB ns

247 PAIR(x,y) -> pblock q <> pblock r <> putB ns

247 where q = fromInteger x

248 where q = fromInteger x

248 r = fromInteger y

249 r = fromInteger y

249− putB _ = mempty

250+ putB _ = Data.Monoid.mempty

251+

252+ int :: Int -> Builder

253+ int x | base == 10 = decimal x

254+ | otherwise = hexadecimal x

250

255

251 pblock = loop maxDigits

256 pblock = loop maxDigits

252 where

257 where

Data/Text/Lazy/Encoding.hs+9−21

@@ -46,30 +46,25 @@ module Data.Text.Lazy.Encoding

46 , encodeUtf32LE

47 , encodeUtf32BE

48

49−#if MIN_VERSION_bytestring(0,10,4)

50 -- * Encoding Text using ByteString Builders

49 -- * Encoding Text using ByteString Builders

51 , encodeUtf8Builder

50 , encodeUtf8Builder

52 , encodeUtf8BuilderEscaped

51 , encodeUtf8BuilderEscaped

53−#endif

54 ) where

52 ) where

55

53

56import Control.Exception (evaluate, try)

54import Control.Exception (evaluate, try)

55+import Data.Monoid (Monoid(..))

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

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

58import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)

57import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldrChunks)

59−import qualified Data.ByteString as S

60−import qualified Data.ByteString.Lazy as B

61−import qualified Data.ByteString.Lazy.Internal as B

62−import qualified Data.ByteString.Unsafe as B

63−#if MIN_VERSION_bytestring(0,10,4)

64import Data.Word (Word8)

58import Data.Word (Word8)

65−import Data.Monoid (mempty, (<>))

59+import qualified Data.ByteString as S

66import qualified Data.ByteString.Builder as B

60import qualified Data.ByteString.Builder as B

67import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)

61import qualified Data.ByteString.Builder.Extra as B (safeStrategy, toLazyByteStringWith)

68import qualified Data.ByteString.Builder.Prim as BP

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

69import qualified Data.Text as T

66import qualified Data.Text as T

70−#endif

71import qualified Data.Text.Encoding as TE

67import qualified Data.Text.Encoding as TE

72−import qualified Data.Text.Lazy as L

73import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E

68import qualified Data.Text.Internal.Lazy.Encoding.Fusion as E

74import qualified Data.Text.Internal.Lazy.Fusion as F

69import qualified Data.Text.Internal.Lazy.Fusion as F

75import Data.Text.Unsafe (unsafeDupablePerformIO)

70import Data.Text.Unsafe (unsafeDupablePerformIO)

@@ -89,8 +84,6 @@ import Data.Text.Unsafe (unsafeDupablePerformIO)

89

84

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

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

91-- encoded text.

86-- encoded text.

92−--

93−-- This function is deprecated. Use 'decodeLatin1' instead.

94decodeASCII :: B.ByteString -> Text

87decodeASCII :: B.ByteString -> Text

95decodeASCII = decodeUtf8

88decodeASCII = decodeUtf8

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

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

@@ -112,7 +105,7 @@ decodeUtf8With onErr (B.Chunk b0 bs0) =

112 | S.null l = empty

105 | S.null l = empty

113 | otherwise = case onErr desc (Just (B.unsafeHead l)) of

106 | otherwise = case onErr desc (Just (B.unsafeHead l)) of

114 Nothing -> empty

107 Nothing -> empty

115− Just c -> L.singleton c

108+ Just c -> Chunk (T.singleton c) Empty

116 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"

109 desc = "Data.Text.Lazy.Encoding.decodeUtf8With: Invalid UTF-8 stream"

117decodeUtf8With _ _ = empty

110decodeUtf8With _ _ = empty

118

111

@@ -149,7 +142,6 @@ decodeUtf8' bs = unsafeDupablePerformIO $ do

149{-# INLINE decodeUtf8' #-}

142{-# INLINE decodeUtf8' #-}

150

143

151encodeUtf8 :: Text -> B.ByteString

144encodeUtf8 :: Text -> B.ByteString

152−#if MIN_VERSION_bytestring(0,10,4)

153encodeUtf8 Empty = B.empty

145encodeUtf8 Empty = B.empty

154encodeUtf8 lt@(Chunk t _) =

146encodeUtf8 lt@(Chunk t _) =

155 B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt

147 B.toLazyByteStringWith strategy B.empty $ encodeUtf8Builder lt

@@ -163,17 +155,13 @@ encodeUtf8 lt@(Chunk t _) =

163 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize

155 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize

164

156

165encodeUtf8Builder :: Text -> B.Builder

157encodeUtf8Builder :: Text -> B.Builder

158+encodeUtf8Builder =

166−encodeUtf8Builder = foldrChunks (\c b -> TE.encodeUtf8Builder c <> b) mempty

159+ foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty

167

160

168{-# INLINE encodeUtf8BuilderEscaped #-}

161{-# INLINE encodeUtf8BuilderEscaped #-}

169encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder

162encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder

170encodeUtf8BuilderEscaped prim =

163encodeUtf8BuilderEscaped prim =

171− foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c <> b) mempty

164+ foldrChunks (\c b -> TE.encodeUtf8BuilderEscaped prim c `mappend` b) mempty

172−

173−#else

174−encodeUtf8 (Chunk c cs) = B.Chunk (TE.encodeUtf8 c) (encodeUtf8 cs)

175−encodeUtf8 Empty = B.Empty

176−#endif

177

165

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

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

179decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text

167decodeUtf16LEWith :: OnDecodeError -> B.ByteString -> Text

Data/Text/Lazy/Read.hs+4−2

@@ -1,5 +1,7 @@

1{-# LANGUAGE OverloadedStrings, CPP #-}

2−#if __GLASGOW_HASKELL__ >= 702

2+#if __GLASGOW_HASKELL__ >= 704

3+{-# LANGUAGE Safe #-}

4+#elif __GLASGOW_HASKELL__ >= 702

3{-# LANGUAGE Trustworthy #-}

5{-# LANGUAGE Trustworthy #-}

4#endif

6#endif

5

7

@@ -54,7 +56,7 @@ decimal :: Integral a => Reader a

54{-# SPECIALIZE decimal :: Reader Int32 #-}

56{-# SPECIALIZE decimal :: Reader Int32 #-}

55{-# SPECIALIZE decimal :: Reader Int64 #-}

57{-# SPECIALIZE decimal :: Reader Int64 #-}

56{-# SPECIALIZE decimal :: Reader Integer #-}

58{-# SPECIALIZE decimal :: Reader Integer #-}

57−{-# SPECIALIZE decimal :: Reader Word #-}

59+{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}

58{-# SPECIALIZE decimal :: Reader Word8 #-}

60{-# SPECIALIZE decimal :: Reader Word8 #-}

59{-# SPECIALIZE decimal :: Reader Word16 #-}

61{-# SPECIALIZE decimal :: Reader Word16 #-}

60{-# SPECIALIZE decimal :: Reader Word32 #-}

62{-# SPECIALIZE decimal :: Reader Word32 #-}

Data/Text/Read.hs+1−1

@@ -55,7 +55,7 @@ decimal :: Integral a => Reader a

55{-# SPECIALIZE decimal :: Reader Int32 #-}

56{-# SPECIALIZE decimal :: Reader Int64 #-}

57{-# SPECIALIZE decimal :: Reader Integer #-}

58−{-# SPECIALIZE decimal :: Reader Word #-}

58+{-# SPECIALIZE decimal :: Reader Data.Word.Word #-}

59{-# SPECIALIZE decimal :: Reader Word8 #-}

60{-# SPECIALIZE decimal :: Reader Word16 #-}

61{-# SPECIALIZE decimal :: Reader Word32 #-}

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

benchmarks/haskell/Benchmarks.hs+1−1

@@ -53,7 +53,7 @@ benchmarks = do

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

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

benchmarks/haskell/Benchmarks/DecodeUtf8.hs+2−2

@@ -25,7 +25,7 @@ import Foreign.Ptr (Ptr, plusPtr)

25import Foreign.ForeignPtr (withForeignPtr)

26import Data.Word (Word8)

27import qualified Criterion as C

28−import Criterion (Benchmark, bgroup, nf)

28+import Criterion (Benchmark, bgroup, nf, whnfIO)

29import qualified Codec.Binary.UTF8.Generic as U8

30import qualified Data.ByteString as B

31import qualified Data.ByteString.Lazy as BL

@@ -48,7 +48,7 @@ benchmark kind fp = do

48 return $ bgroup "DecodeUtf8"

49 [ bench "Strict" $ nf T.decodeUtf8 bs

50 , bench "Stream" $ nf decodeStream lbs

51− , bench "IConv" $ iconv bs

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

benchmarks/haskell/Benchmarks/FileRead.hs+11−11

@@ -8,8 +8,8 @@ module Benchmarks.FileRead

8 ( benchmark

9 ) where

10

11−import Control.Exception (evaluate)

11+import Control.Applicative ((<$>))

12−import Criterion (Benchmark, bgroup, bench)

12+import Criterion (Benchmark, bgroup, bench, whnfIO)

13import qualified Data.ByteString as SB

14import qualified Data.ByteString.Lazy as LB

15import qualified Data.Text as T

@@ -21,13 +21,13 @@ import qualified Data.Text.Lazy.IO as LT

21

22benchmark :: FilePath -> IO Benchmark

23benchmark p = return $ bgroup "FileRead"

24− [ bench "String" $ readFile p >>= evaluate . length

24+ [ bench "String" $ whnfIO $ length <$> readFile p

25− , bench "ByteString" $ SB.readFile p >>= evaluate . SB.length

25+ , bench "ByteString" $ whnfIO $ SB.length <$> SB.readFile p

26− , bench "LazyByteString" $ LB.readFile p >>= evaluate . LB.length

26+ , bench "LazyByteString" $ whnfIO $ LB.length <$> LB.readFile p

27− , bench "Text" $ T.readFile p >>= evaluate . T.length

27+ , bench "Text" $ whnfIO $ T.length <$> T.readFile p

28− , bench "LazyText" $ LT.readFile p >>= evaluate . LT.length

28+ , bench "LazyText" $ whnfIO $ LT.length <$> LT.readFile p

29− , bench "TextByteString" $

29+ , bench "TextByteString" $ whnfIO $

30− SB.readFile p >>= evaluate . T.length . T.decodeUtf8

30+ (T.length . T.decodeUtf8) <$> SB.readFile p

31− , bench "LazyTextByteString" $

31+ , bench "LazyTextByteString" $ whnfIO $

32− LB.readFile p >>= evaluate . LT.length . LT.decodeUtf8

32+ (LT.length . LT.decodeUtf8) <$> LB.readFile p

33 ]

benchmarks/haskell/Benchmarks/FoldLines.hs+2−2

@@ -10,7 +10,7 @@ module Benchmarks.FoldLines

10 ( benchmark

11 ) where

12

13−import Criterion (Benchmark, bgroup, bench)

13+import Criterion (Benchmark, bgroup, bench, whnfIO)

14import System.IO

15import qualified Data.ByteString as B

16import qualified Data.Text as T

@@ -22,7 +22,7 @@ benchmark fp = return $ bgroup "ReadLines"

22 , bench "ByteString" $ withHandle $ foldLinesB (\n _ -> n + 1) (0 :: Int)

23 ]

24 where

25− withHandle f = do

25+ withHandle f = whnfIO $ do

26 h <- openFile fp ReadMode

27 hSetBuffering h (BlockBuffering (Just 16384))

28 x <- f h

benchmarks/haskell/Benchmarks/Programs/BigTable.hs+2−2

@@ -11,7 +11,7 @@ module Benchmarks.Programs.BigTable

11 ( benchmark

12 ) where

13

14−import Criterion (Benchmark, bench)

14+import Criterion (Benchmark, bench, whnfIO)

15import Data.Monoid (mappend, mconcat)

16import Data.Text.Lazy.Builder (Builder, fromText, toLazyText)

17import Data.Text.Lazy.IO (hPutStr)

@@ -19,7 +19,7 @@ import System.IO (Handle)

19import qualified Data.Text as T

20

21benchmark :: Handle -> IO Benchmark

22−benchmark sink = return $ bench "BigTable" $ do

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

benchmarks/haskell/Benchmarks/Programs/Cut.hs+2−2

@@ -16,7 +16,7 @@ module Benchmarks.Programs.Cut

16 ( benchmark

17 ) where

18

19−import Criterion (Benchmark, bgroup, bench)

19+import Criterion (Benchmark, bgroup, bench, whnfIO)

20import System.IO (Handle, hPutStr)

21import qualified Data.ByteString as B

22import qualified Data.ByteString.Char8 as BC

@@ -40,7 +40,7 @@ benchmark p sink from to = return $ bgroup "Cut"

40 , bench' "LazyTextByteString" lazyTextByteString

41 ]

42 where

43− bench' n s = bench n (s p sink from to)

43+ bench' n s = bench n $ whnfIO (s p sink from to)

44

45string :: FilePath -> Handle -> Int -> Int -> IO ()

46string fp sink from to = do

benchmarks/haskell/Benchmarks/Programs/Fold.hs+2−2

@@ -21,7 +21,7 @@ import Data.List (foldl')

21import Data.List (intersperse)

22import Data.Monoid (mempty, mappend, mconcat)

23import System.IO (Handle)

24−import Criterion (Benchmark, bench)

24+import Criterion (Benchmark, bench, whnfIO)

25import qualified Data.Text as T

26import qualified Data.Text.IO as T

27import qualified Data.Text.Lazy.Builder as TLB

@@ -30,7 +30,7 @@ import qualified Data.Text.Lazy.IO as TL

30

31benchmark :: FilePath -> Handle -> IO Benchmark

32benchmark i o = return $

33− bench "Fold" $ T.readFile i >>= TL.hPutStr o . fold 80

33+ bench "Fold" $ whnfIO $ T.readFile i >>= TL.hPutStr o . fold 80

34

35-- | We represent a paragraph by a word list

36--

benchmarks/haskell/Benchmarks/Programs/Sort.hs+10−9

@@ -17,7 +17,7 @@ module Benchmarks.Programs.Sort

17 ( benchmark

18 ) where

19

20−import Criterion (Benchmark, bgroup, bench)

20+import Criterion (Benchmark, bgroup, bench, whnfIO)

21import Data.Monoid (mconcat)

22import System.IO (Handle, hPutStr)

23import qualified Data.ByteString as B

@@ -35,16 +35,17 @@ import qualified Data.Text.Lazy.IO as TL

35

36benchmark :: FilePath -> Handle -> IO Benchmark

37benchmark i o = return $ bgroup "Sort"

38− [ bench "String" $ readFile i >>= hPutStr o . string

38+ [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string

39− , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString

39+ , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString

40+ , bench "LazyByteString" $ whnfIO $

40− , bench "LazyByteString" $ BL.readFile i >>= BL.hPutStr o . lazyByteString

41+ BL.readFile i >>= BL.hPutStr o . lazyByteString

41− , bench "Text" $ T.readFile i >>= T.hPutStr o . text

42+ , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text

42− , bench "LazyText" $ TL.readFile i >>= TL.hPutStr o . lazyText

43+ , bench "LazyText" $ whnfIO $ TL.readFile i >>= TL.hPutStr o . lazyText

43− , bench "TextByteString" $ B.readFile i >>=

44+ , bench "TextByteString" $ whnfIO $ B.readFile i >>=

44 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

45 B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

45− , bench "LazyTextByteString" $ BL.readFile i >>=

46+ , bench "LazyTextByteString" $ whnfIO $ BL.readFile i >>=

46 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8

47 BL.hPutStr o . TL.encodeUtf8 . lazyText . TL.decodeUtf8

47− , bench "TextBuilder" $ B.readFile i >>=

48+ , bench "TextBuilder" $ whnfIO $ B.readFile i >>=

48 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8

49 BL.hPutStr o . TL.encodeUtf8 . textBuilder . T.decodeUtf8

49 ]

50 ]

50

51

benchmarks/haskell/Benchmarks/Programs/StripTags.hs+5−5

@@ -15,7 +15,7 @@ module Benchmarks.Programs.StripTags

15 ( benchmark

16 ) where

17

18−import Criterion (Benchmark, bgroup, bench)

18+import Criterion (Benchmark, bgroup, bench, whnfIO)

19import Data.List (mapAccumL)

20import System.IO (Handle, hPutStr)

21import qualified Data.ByteString as B

@@ -26,10 +26,10 @@ import qualified Data.Text.IO as T

26

27benchmark :: FilePath -> Handle -> IO Benchmark

28benchmark i o = return $ bgroup "StripTags"

29− [ bench "String" $ readFile i >>= hPutStr o . string

29+ [ bench "String" $ whnfIO $ readFile i >>= hPutStr o . string

30− , bench "ByteString" $ B.readFile i >>= B.hPutStr o . byteString

30+ , bench "ByteString" $ whnfIO $ B.readFile i >>= B.hPutStr o . byteString

31− , bench "Text" $ T.readFile i >>= T.hPutStr o . text

31+ , bench "Text" $ whnfIO $ T.readFile i >>= T.hPutStr o . text

32− , bench "TextByteString" $

32+ , bench "TextByteString" $ whnfIO $

33 B.readFile i >>= B.hPutStr o . T.encodeUtf8 . text . T.decodeUtf8

34 ]

35

benchmarks/haskell/Benchmarks/Programs/Throughput.hs+8−8

@@ -18,7 +18,7 @@ module Benchmarks.Programs.Throughput

18 ( benchmark

19 ) where

20

21−import Criterion (Benchmark, bgroup, bench)

21+import Criterion (Benchmark, bgroup, bench, whnfIO)

22import System.IO (Handle, hPutStr)

23import qualified Data.ByteString as B

24import qualified Data.ByteString.Lazy as BL

@@ -29,13 +29,13 @@ import qualified Data.Text.Lazy.IO as TL

29

30benchmark :: FilePath -> Handle -> IO Benchmark

31benchmark fp sink = return $ bgroup "Throughput"

32− [ bench "String" $ readFile fp >>= hPutStr sink

32+ [ bench "String" $ whnfIO $ readFile fp >>= hPutStr sink

33− , bench "ByteString" $ B.readFile fp >>= B.hPutStr sink

33+ , bench "ByteString" $ whnfIO $ B.readFile fp >>= B.hPutStr sink

34− , bench "LazyByteString" $ BL.readFile fp >>= BL.hPutStr sink

34+ , bench "LazyByteString" $ whnfIO $ BL.readFile fp >>= BL.hPutStr sink

35− , bench "Text" $ T.readFile fp >>= T.hPutStr sink

35+ , bench "Text" $ whnfIO $ T.readFile fp >>= T.hPutStr sink

36− , bench "LazyText" $ TL.readFile fp >>= TL.hPutStr sink

36+ , bench "LazyText" $ whnfIO $ TL.readFile fp >>= TL.hPutStr sink

37− , bench "TextByteString" $

37+ , bench "TextByteString" $ whnfIO $

38 B.readFile fp >>= B.hPutStr sink . T.encodeUtf8 . T.decodeUtf8

39− , bench "LazyTextByteString" $

39+ , bench "LazyTextByteString" $ whnfIO $

40 BL.readFile fp >>= BL.hPutStr sink . TL.encodeUtf8 . TL.decodeUtf8

41 ]

benchmarks/haskell/Benchmarks/Pure.hs+7

@@ -262,6 +262,13 @@ benchmark kind fp = do

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

265 , bgroup "words"

272 , bgroup "words"

266 [ benchT $ nf T.words ta

273 [ benchT $ nf T.words ta

267 , benchTL $ nf TL.words tla

274 , benchTL $ nf TL.words tla

benchmarks/haskell/Benchmarks/ReadNumbers.hs+2−5

@@ -25,8 +25,7 @@ import Data.List (foldl')

25import Numeric (readDec, readFloat, readHex)

26import qualified Data.ByteString.Char8 as B

27import qualified Data.ByteString.Lazy.Char8 as BL

28−import qualified Data.ByteString.Lex.Double as B

28+import qualified Data.ByteString.Lex.Fractional as B

29−import qualified Data.ByteString.Lex.Lazy.Double as BL

30import qualified Data.Text as T

29import qualified Data.Text as T

31import qualified Data.Text.IO as T

30import qualified Data.Text.IO as T

32import qualified Data.Text.Lazy as TL

31import qualified Data.Text.Lazy as TL

@@ -63,12 +62,10 @@ benchmark fp = do

63 whnf (double . text TL.rational) tl

62 whnf (double . text TL.rational) tl

64

63

65 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b

64 , bench "DecimalByteString" $ whnf (int . byteString B.readInt) b

66− , bench "DoubleByteString" $ whnf (double . byteString B.readDouble) b

65+ , bench "DoubleByteString" $ whnf (double . byteString B.readDecimal) b

67

66

68 , bench "DecimalLazyByteString" $

67 , bench "DecimalLazyByteString" $

69 whnf (int . byteString BL.readInt) bl

68 whnf (int . byteString BL.readInt) bl

70− , bench "DoubleLazyByteString" $

71− whnf (double . byteString BL.readDouble) bl

72 ]

69 ]

73 where

70 where

74 -- Used for fixing types

71 -- Used for fixing types

benchmarks/haskell/Benchmarks/Stream.hs+16−5

@@ -18,11 +18,11 @@ import qualified Data.Text.Encoding as T

18import qualified Data.Text.Encoding.Error as E

19import qualified Data.Text.Internal.Encoding.Fusion as T

20import qualified Data.Text.Internal.Encoding.Fusion.Common as F

21−import qualified Data.Text.Internal.Fusion as T

21+import qualified Data.Text.Internal.Fusion as F

22import qualified Data.Text.IO as T

23import qualified Data.Text.Lazy.Encoding as TL

24import qualified Data.Text.Internal.Lazy.Encoding.Fusion as TL

25−import qualified Data.Text.Internal.Lazy.Fusion as TL

25+import qualified Data.Text.Internal.Lazy.Fusion as FL

26import qualified Data.Text.Lazy.IO as TL

27

28instance NFData a => NFData (Stream a) where

@@ -53,14 +53,25 @@ benchmark fp = do

53 !utf32beL = TL.encodeUtf32BE tl

54

55 -- For the functions which operate on streams

56− let !s = T.stream t

56+ let !s = F.stream t

57

58 return $ bgroup "Stream"

59

60 -- Fusion

61 [ bgroup "stream" $

62− [ bench "Text" $ nf T.stream t

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

63− , bench "LazyText" $ nf TL.stream tl

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

64 ]

75 ]

65

76

66 -- Encoding.Fusion

77 -- Encoding.Fusion

benchmarks/text-benchmarks.cabal+14−4

@@ -3,7 +3,7 @@ version: 0.0.0.0

3synopsis: Benchmarks for the text package

4description: Benchmarks for the text package

5homepage: https://bitbucket.org/bos/text

6−license: BSD3

6+license: BSD2

7license-file: ../LICENSE

8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

9 Bryan O'Sullivan <bos@serpentine.com>,

@@ -15,6 +15,11 @@ build-type: Simple

15

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

18flag llvm

23flag llvm

19 description: use LLVM

24 description: use LLVM

20 default: False

25 default: False

@@ -33,10 +38,9 @@ executable text-benchmarks

33 build-depends: base == 4.*,

38 build-depends: base == 4.*,

34 binary,

39 binary,

35 blaze-builder,

40 blaze-builder,

36− bytestring,

41+ bytestring-lexing >= 0.5.0,

37− bytestring-lexing,

38 containers,

42 containers,

39− criterion >= 0.6.0.1,

43+ criterion >= 0.10.0.0,

40 deepseq,

44 deepseq,

41 directory,

45 directory,

42 filepath,

46 filepath,

@@ -46,6 +50,12 @@ executable text-benchmarks

46 utf8-string,

50 utf8-string,

47 vector

51 vector

48

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+

49executable text-multilang

59executable text-multilang

50 hs-source-dirs: haskell

60 hs-source-dirs: haskell

51 main-is: Multilang.hs

61 main-is: Multilang.hs

changelog.md+109

@@ -1,3 +1,112 @@

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+

11.1.1.0

1101.1.1.0

2

111

3* The Data.Data instance now allows gunfold to work, via a virtual

112* The Data.Data instance now allows gunfold to work, via a virtual

scripts/CaseFolding.hs+1−1

@@ -37,7 +37,7 @@ mapCF :: CaseFolding -> [String]

37mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last]

38 where

39 typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"

40− ,"{-# INLINE foldMapping #-}"]

40+ ,"{-# NOINLINE foldMapping #-}"]

41 last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')"

42 nice c = "-- " ++ name c ++ "\n" ++

43 "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"

scripts/CaseMapping.hs+3−3

@@ -8,7 +8,7 @@ import SpecialCasing

8main = do

9 args <- getArgs

10 let oname = case args of

11− [] -> "../Data/Text/Fusion/CaseMapping.hs"

11+ [] -> "../Data/Text/Internal/Fusion/CaseMapping.hs"

12 [o] -> o

13 psc <- parseSC "SpecialCasing.txt"

14 pcf <- parseCF "CaseFolding.txt"

@@ -24,10 +24,10 @@ main = do

24 mapM_ (hPutStrLn h) $

25 ["{-# LANGUAGE Rank2Types #-}"

26 ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"

27− ,"-- Generated by scripts/SpecialCasing.hs"] ++

27+ ,"-- Generated by scripts/CaseMapping.hs"] ++

28 comments ++

29 [""

30− ,"module Data.Text.Fusion.CaseMapping where"

30+ ,"module Data.Text.Internal.Fusion.CaseMapping where"

31 ,"import Data.Char"

32 ,"import Data.Text.Internal.Fusion.Types"

33 ,""]

scripts/SpecialCasing.hs+1−1

@@ -43,7 +43,7 @@ mapSC which access twiddle (SC _ ms) =

43 typ ++ (map nice . filter p $ ms) ++ [last]

44 where

45 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"

46− ,"{-# INLINE " ++ which ++ "Mapping #-}"]

46+ ,"{-# NOINLINE " ++ which ++ "Mapping #-}"]

47 last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (CC s '\\0' '\\0')"

48 nice c = "-- " ++ name c ++ "\n" ++

49 which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"

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+6−1

@@ -1,5 +1,10 @@

1count = 1000

2

3+all: coverage literal-rule-test

4+

5+literal-rule-test:

6+ ./literal-rule-test.sh

7+

3coverage: build coverage/hpc_index.html

8coverage: build coverage/hpc_index.html

4

9

5build: text-test-data

10build: text-test-data

@@ -32,4 +37,4 @@ coverage/hpc_index.html: coverage/coverage.tix

32clean:

37clean:

33 rm -rf dist coverage .hpc

38 rm -rf dist coverage .hpc

34

39

35−.PHONY: build coverage

40+.PHONY: build coverage all literal-rule-test

tests/Tests/Properties.hs+57−9

@@ -1,9 +1,8 @@

1−-- | General quicktest properties for the text library

1+-- | QuickCheck properties for the text library.

2−--

2+

3{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,

4 ScopedTypeVariables, TypeSynonymInstances #-}

5−{-# OPTIONS_GHC -fno-enable-rewrite-rules #-}

5+{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}

6−{-# OPTIONS_GHC -fno-warn-missing-signatures #-}

7module Tests.Properties

6module Tests.Properties

8 (

7 (

9 tests

8 tests

@@ -15,7 +14,7 @@ import Data.Bits ((.&.))

15import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)

14import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)

16import Data.Int (Int8, Int16, Int32, Int64)

15import Data.Int (Int8, Int16, Int32, Int64)

17import Data.Monoid (Monoid(..))

16import Data.Monoid (Monoid(..))

18−import Data.String (fromString)

17+import Data.String (IsString(fromString))

19import Data.Text.Encoding.Error

18import Data.Text.Encoding.Error

20import Data.Text.Foreign

19import Data.Text.Foreign

21import Data.Text.Internal.Encoding.Utf8

20import Data.Text.Internal.Encoding.Utf8

@@ -24,7 +23,7 @@ import Data.Text.Internal.Search (indices)

24import Data.Text.Lazy.Read as TL

23import Data.Text.Lazy.Read as TL

25import Data.Text.Read as T

24import Data.Text.Read as T

26import Data.Word (Word, Word8, Word16, Word32, Word64)

25import Data.Word (Word, Word8, Word16, Word32, Word64)

27−import Numeric (showHex)

26+import Numeric (showEFloat, showFFloat, showGFloat, showHex)

28import Prelude hiding (replicate)

27import Prelude hiding (replicate)

29import Test.Framework (Test, testGroup)

28import Test.Framework (Test, testGroup)

30import Test.Framework.Providers.QuickCheck2 (testProperty)

29import Test.Framework.Providers.QuickCheck2 (testProperty)

@@ -441,6 +440,10 @@ t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)

441tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)

440tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)

442 where _types = f :: Int -> Char -> (Int,Char)

441 where _types = f :: Int -> Char -> (Int,Char)

443

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+

444replicate n l = concat (L.replicate n l)

447replicate n l = concat (L.replicate n l)

445

448

446s_replicate n = replicate m `eq`

449s_replicate n = replicate m `eq`

@@ -452,6 +455,14 @@ tl_replicate n = replicate m `eq`

452 (unpackS . TL.replicate (fromIntegral m) . packS)

455 (unpackS . TL.replicate (fromIntegral m) . packS)

453 where m = fromIntegral (n :: Word8)

456 where m = fromIntegral (n :: Word8)

454

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+

455unf :: Int -> Char -> Maybe (Char, Char)

466unf :: Int -> Char -> Maybe (Char, Char)

456unf n c | fromEnum c * 100 > n = Nothing

467unf n c | fromEnum c * 100 > n = Nothing

457 | otherwise = Just (c, succ c)

468 | otherwise = Just (c, succ c)

@@ -505,6 +516,10 @@ sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`

505 (unpackS . S.takeWhile p . S.filter q)

516 (unpackS . S.takeWhile p . S.filter q)

506t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)

517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)

507tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)

518tl_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)

508s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)

509s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)

524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)

510sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`

525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`

@@ -741,6 +756,7 @@ tb_decimal :: (Integral a, Show a) => a -> Bool

741tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)

756tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show)

742

757

743tb_decimal_integer (a::Integer) = tb_decimal a

758tb_decimal_integer (a::Integer) = tb_decimal a

759+tb_decimal_integer_big (Big a) = tb_decimal a

744tb_decimal_int (a::Int) = tb_decimal a

760tb_decimal_int (a::Int) = tb_decimal a

745tb_decimal_int8 (a::Int8) = tb_decimal a

761tb_decimal_int8 (a::Int8) = tb_decimal a

746tb_decimal_int16 (a::Int16) = tb_decimal a

762tb_decimal_int16 (a::Int16) = tb_decimal a

@@ -752,6 +768,11 @@ tb_decimal_word16 (a::Word16) = tb_decimal a

752tb_decimal_word32 (a::Word32) = tb_decimal a

768tb_decimal_word32 (a::Word32) = tb_decimal a

753tb_decimal_word64 (a::Word64) = tb_decimal a

769tb_decimal_word64 (a::Word64) = tb_decimal a

754

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+

755tb_hex :: (Integral a, Show a) => a -> Bool

776tb_hex :: (Integral a, Show a) => a -> Bool

756tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")

777tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "")

757

778

@@ -773,6 +794,21 @@ tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show)

773tb_realfloat_float (a::Float) = tb_realfloat a

794tb_realfloat_float (a::Float) = tb_realfloat a

774tb_realfloat_double (a::Double) = tb_realfloat a

795tb_realfloat_double (a::Double) = tb_realfloat a

775

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+

776-- Reading.

812-- Reading.

777

813

778t_decimal (n::Int) s =

814t_decimal (n::Int) s =

@@ -792,7 +828,7 @@ tl_hexadecimal m s ox =

792 p = if ox then "0x" else ""

828 p = if ox then "0x" else ""

793 n = getPositive m :: Int

829 n = getPositive m :: Int

794

830

795−isFloaty c = c `elem` "+-.0123456789eE"

831+isFloaty c = c `elem` ("+-.0123456789eE" :: String)

796

832

797t_read_rational p tol (n::Double) s =

833t_read_rational p tol (n::Double) s =

798 case p (T.pack (show n) `T.append` t) of

834 case p (T.pack (show n) `T.append` t) of

@@ -1074,9 +1110,12 @@ tests =

1074 ],

1110 ],

1075

1111

1076 testGroup "unfolds" [

1112 testGroup "unfolds" [

1113+ testProperty "tl_repeat" tl_repeat,

1077 testProperty "s_replicate" s_replicate,

1114 testProperty "s_replicate" s_replicate,

1078 testProperty "t_replicate" t_replicate,

1115 testProperty "t_replicate" t_replicate,

1079 testProperty "tl_replicate" tl_replicate,

1116 testProperty "tl_replicate" tl_replicate,

1117+ testProperty "tl_cycle" tl_cycle,

1118+ testProperty "tl_iterate" tl_iterate,

1080 testProperty "t_unfoldr" t_unfoldr,

1119 testProperty "t_unfoldr" t_unfoldr,

1081 testProperty "tl_unfoldr" tl_unfoldr,

1120 testProperty "tl_unfoldr" tl_unfoldr,

1082 testProperty "t_unfoldrN" t_unfoldrN,

1121 testProperty "t_unfoldrN" t_unfoldrN,

@@ -1107,6 +1146,8 @@ tests =

1107 testProperty "sf_takeWhile" sf_takeWhile,

1146 testProperty "sf_takeWhile" sf_takeWhile,

1108 testProperty "t_takeWhile" t_takeWhile,

1147 testProperty "t_takeWhile" t_takeWhile,

1109 testProperty "tl_takeWhile" tl_takeWhile,

1148 testProperty "tl_takeWhile" tl_takeWhile,

1149+ testProperty "t_takeWhileEnd" t_takeWhileEnd,

1150+ testProperty "tl_takeWhileEnd" tl_takeWhileEnd,

1110 testProperty "sf_dropWhile" sf_dropWhile,

1151 testProperty "sf_dropWhile" sf_dropWhile,

1111 testProperty "s_dropWhile" s_dropWhile,

1152 testProperty "s_dropWhile" s_dropWhile,

1112 testProperty "s_dropWhile_s" s_dropWhile_s,

1153 testProperty "s_dropWhile_s" s_dropWhile_s,

@@ -1252,11 +1293,16 @@ tests =

1252 testProperty "tb_decimal_int32" tb_decimal_int32,

1293 testProperty "tb_decimal_int32" tb_decimal_int32,

1253 testProperty "tb_decimal_int64" tb_decimal_int64,

1294 testProperty "tb_decimal_int64" tb_decimal_int64,

1254 testProperty "tb_decimal_integer" tb_decimal_integer,

1295 testProperty "tb_decimal_integer" tb_decimal_integer,

1296+ testProperty "tb_decimal_integer_big" tb_decimal_integer_big,

1255 testProperty "tb_decimal_word" tb_decimal_word,

1297 testProperty "tb_decimal_word" tb_decimal_word,

1256 testProperty "tb_decimal_word8" tb_decimal_word8,

1298 testProperty "tb_decimal_word8" tb_decimal_word8,

1257 testProperty "tb_decimal_word16" tb_decimal_word16,

1299 testProperty "tb_decimal_word16" tb_decimal_word16,

1258 testProperty "tb_decimal_word32" tb_decimal_word32,

1300 testProperty "tb_decimal_word32" tb_decimal_word32,

1259− testProperty "tb_decimal_word64" tb_decimal_word64

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

1260 ],

1306 ],

1261 testGroup "hexadecimal" [

1307 testGroup "hexadecimal" [

1262 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,

1308 testProperty "tb_hexadecimal_int" tb_hexadecimal_int,

@@ -1273,7 +1319,9 @@ tests =

1273 ],

1319 ],

1274 testGroup "realfloat" [

1320 testGroup "realfloat" [

1275 testProperty "tb_realfloat_double" tb_realfloat_double,

1321 testProperty "tb_realfloat_double" tb_realfloat_double,

1276− testProperty "tb_realfloat_float" tb_realfloat_float

1322+ testProperty "tb_realfloat_float" tb_realfloat_float,

1323+ testProperty "tb_formatRealFloat_float" tb_formatRealFloat_float,

1324+ testProperty "tb_formatRealFloat_double" tb_formatRealFloat_double

1277 ],

1325 ],

1278 testProperty "tb_fromText" tb_fromText,

1326 testProperty "tb_fromText" tb_fromText,

1279 testProperty "tb_singleton" tb_singleton

1327 testProperty "tb_singleton" tb_singleton

tests/Tests/QuickCheckUtils.hs+73−82

@@ -7,48 +7,46 @@

7module Tests.QuickCheckUtils

8 (

9 genUnicode

10− , genUnicodeWith

11− , ascii

12− , plane0

13− , plane1

14− , plane2

15− , plane14

16− , planes

17−

18 , unsquare

10 , unsquare

19 , smallArbitrary

11 , smallArbitrary

20

12

13+ , BigBounded(..)

14+ , BigInt(..)

21− , NotEmpty (..)

15+ , NotEmpty(..)

22

16

23− , Small (..)

17+ , Small(..)

24 , small

18 , small

25

19

20+ , Precision(..)

21+ , precision

22+

26 , integralRandomR

23 , integralRandomR

27

24

28− , DecodeErr (..)

25+ , DecodeErr(..)

29 , genDecodeErr

26 , genDecodeErr

30

27

31− , Stringy (..)

28+ , Stringy(..)

32 , eq

29 , eq

33 , eqP

30 , eqP

34

31

35− , Encoding (..)

32+ , Encoding(..)

36

33

37 , write_read

34 , write_read

38 ) where

35 ) where

39

36

37+import Control.Applicative ((<$>))

40import Control.Arrow (first, (***))

38import Control.Arrow (first, (***))

41import Control.DeepSeq (NFData (..), deepseq)

39import Control.DeepSeq (NFData (..), deepseq)

42import Control.Exception (bracket)

40import Control.Exception (bracket)

43−import Data.Bits ((.&.))

44−import Data.Char (chr)

45import Data.String (IsString, fromString)

41import Data.String (IsString, fromString)

46import Data.Text.Foreign (I16)

42import Data.Text.Foreign (I16)

43+import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))

47import Data.Word (Word8, Word16)

44import Data.Word (Word8, Word16)

48import Debug.Trace (trace)

45import Debug.Trace (trace)

49−import System.Random (Random (..), RandomGen)

46+import System.Random (Random(..), RandomGen)

50−import Test.QuickCheck hiding (Small (..), (.&.))

47+import Test.QuickCheck hiding (Fixed(..), Small (..), (.&.))

51import Test.QuickCheck.Monadic (assert, monadicIO, run)

48import Test.QuickCheck.Monadic (assert, monadicIO, run)

49+import Test.QuickCheck.Unicode (string)

52import Tests.Utils

50import Tests.Utils

53import qualified Data.ByteString as B

51import qualified Data.ByteString as B

54import qualified Data.Text as T

52import qualified Data.Text as T

@@ -60,6 +58,14 @@ import qualified Data.Text.Internal.Lazy.Fusion as TLF

60import qualified Data.Text.Lazy as TL

58import qualified Data.Text.Lazy as TL

61import qualified System.IO as IO

59import qualified System.IO as IO

62

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+

63instance Random I16 where

69instance Random I16 where

64 randomR = integralRandomR

70 randomR = integralRandomR

65 random = randomR (minBound,maxBound)

71 random = randomR (minBound,maxBound)

@@ -73,75 +79,22 @@ instance Arbitrary B.ByteString where

73 shrink = map B.pack . shrink . B.unpack

79 shrink = map B.pack . shrink . B.unpack

74

80

75#if !MIN_VERSION_base(4,4,0)

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+

76instance Random Word8 where

90instance Random Word8 where

77 randomR = integralRandomR

91 randomR = integralRandomR

78 random = randomR (minBound,maxBound)

92 random = randomR (minBound,maxBound)

79−#endif

80

93

81−genUnicode :: IsString a => Gen a

94+instance Random Word64 where

82−genUnicode = genUnicodeWith planes

95+ randomR = integralRandomR

83−

96+ random = randomR (minBound,maxBound)

84−genUnicodeWith :: IsString a => [Gen Int] -> Gen a

97+#endif

85−genUnicodeWith gens = fmap fromString string

86− where

87− string = sized $ \n ->

88− do k <- choose (0,n)

89− sequence [ char | _ <- [1..k] ]

90−

91− excluding :: [a -> Bool] -> Gen a -> Gen a

92− excluding bad gen = loop

93− where

94− loop = do

95− x <- gen

96− if or (map ($ x) bad)

97− then loop

98− else return x

99−

100− reserved = [lowSurrogate, highSurrogate, noncharacter]

101− lowSurrogate c = c >= 0xDC00 && c <= 0xDFFF

102− highSurrogate c = c >= 0xD800 && c <= 0xDBFF

103− noncharacter c = masked == 0xFFFE || masked == 0xFFFF

104− where

105− masked = c .&. 0xFFFF

106−

107− char = chr `fmap` excluding reserved (oneof gens)

108−

109−ascii :: Gen Int

110−ascii = choose (0,0x7F)

111−

112−plane0 :: Gen Int

113−plane0 = choose (0xF0, 0xFFFF)

114−

115−plane1 :: Gen Int

116−plane1 = oneof [ choose (0x10000, 0x10FFF)

117− , choose (0x11000, 0x11FFF)

118− , choose (0x12000, 0x12FFF)

119− , choose (0x13000, 0x13FFF)

120− , choose (0x1D000, 0x1DFFF)

121− , choose (0x1F000, 0x1FFFF)

122− ]

123−

124−plane2 :: Gen Int

125−plane2 = oneof [ choose (0x20000, 0x20FFF)

126− , choose (0x21000, 0x21FFF)

127− , choose (0x22000, 0x22FFF)

128− , choose (0x23000, 0x23FFF)

129− , choose (0x24000, 0x24FFF)

130− , choose (0x25000, 0x25FFF)

131− , choose (0x26000, 0x26FFF)

132− , choose (0x27000, 0x27FFF)

133− , choose (0x28000, 0x28FFF)

134− , choose (0x29000, 0x29FFF)

135− , choose (0x2A000, 0x2AFFF)

136− , choose (0x2B000, 0x2BFFF)

137− , choose (0x2F000, 0x2FFFF)

138− ]

139−

140−plane14 :: Gen Int

141−plane14 = choose (0xE0000, 0xE0FFF)

142−

143−planes :: [Gen Int]

144−planes = [ascii, plane0, plane1, plane2, plane14]

145

98

146-- For tests that have O(n^2) running times or input sizes, resize

99-- For tests that have O(n^2) running times or input sizes, resize

147-- their inputs to the square root of the originals.

100-- their inputs to the square root of the originals.

@@ -160,6 +113,20 @@ instance Arbitrary TL.Text where

160 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary

113 arbitrary = (TL.fromChunks . map notEmpty) `fmap` smallArbitrary

161 shrink = map TL.pack . shrink . TL.unpack

114 shrink = map TL.pack . shrink . TL.unpack

162

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+

163newtype NotEmpty a = NotEmpty { notEmpty :: a }

130newtype NotEmpty a = NotEmpty { notEmpty :: a }

164 deriving (Eq, Ord)

131 deriving (Eq, Ord)

165

132

@@ -300,6 +267,30 @@ eqP f g s w = eql "orig" (f s) (g t) &&

300 | a =^= b = True

267 | a =^= b = True

301 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False

268 | otherwise = trace (d ++ ": " ++ show a ++ " /= " ++ show b) False

302

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+

303-- Work around lack of Show instance for TextEncoding.

294-- Work around lack of Show instance for TextEncoding.

304data Encoding = E String IO.TextEncoding

295data Encoding = E String IO.TextEncoding

305

296

tests/cabal.config−1

@@ -1,7 +1,6 @@

1-- These flags help to speed up building the test suite.

2

3documentation: False

4−executable-profiling: False

5executable-stripping: False

4executable-stripping: False

6flags: developer

5flags: developer

7library-profiling: False

6library-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/text-tests.cabal+4−1

@@ -3,7 +3,7 @@ version: 0.0.0.0

3synopsis: Functional tests for the text package

4description: Functional tests for the text package

5homepage: https://github.com/bos/text

6−license: BSD3

6+license: BSD2

7license-file: ../LICENSE

8author: Jasper Van der Jeugt <jaspervdj@gmail.com>,

9 Bryan O'Sullivan <bos@serpentine.com>,

@@ -51,6 +51,7 @@ executable text-tests

51 bytestring,

52 deepseq,

53 directory,

54+ quickcheck-unicode,

54 random,

55 random,

55 test-framework >= 0.4,

56 test-framework >= 0.4,

56 test-framework-hunit >= 0.2,

57 test-framework-hunit >= 0.2,

@@ -113,6 +114,7 @@ library

113 Data.Text.Internal.Lazy.Search

114 Data.Text.Internal.Lazy.Search

114 Data.Text.Internal.Private

115 Data.Text.Internal.Private

115 Data.Text.Read

116 Data.Text.Read

117+ Data.Text.Show

116 Data.Text.Internal.Read

118 Data.Text.Internal.Read

117 Data.Text.Internal.Search

119 Data.Text.Internal.Search

118 Data.Text.Unsafe

120 Data.Text.Unsafe

@@ -134,6 +136,7 @@ library

134 build-depends:

136 build-depends:

135 array,

137 array,

136 base == 4.*,

138 base == 4.*,

139+ binary,

137 bytestring,

140 bytestring,

138 deepseq,

141 deepseq,

139 ghc-prim,

142 ghc-prim,

text.cabal+24−6

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

1name: text

2−version: 1.1.1.3

2+version: 1.2.2.1

3homepage: https://github.com/bos/text

4bug-reports: https://github.com/bos/text/issues

5synopsis: An efficient packed Unicode text type.

@@ -31,7 +31,7 @@ description:

31 the @text-icu@ package:

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

33

34−license: BSD3

34+license: BSD2

35license-file: LICENSE

36author: Bryan O'Sullivan <bos@serpentine.com>

37maintainer: Bryan O'Sullivan <bos@serpentine.com>

@@ -64,6 +64,11 @@ extra-source-files:

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

71+

67flag developer

72flag developer

68 description: operate in developer mode

73 description: operate in developer mode

69 default: False

74 default: False

@@ -72,6 +77,7 @@ flag developer

72flag integer-simple

77flag integer-simple

73 description: Use the simple integer library instead of GMP

78 description: Use the simple integer library instead of GMP

74 default: False

79 default: False

80+ manual: False

75

81

76library

82library

77 c-sources: cbits/cbits.c

83 c-sources: cbits/cbits.c

@@ -122,16 +128,21 @@ library

122 Data.Text.Read

128 Data.Text.Read

123 Data.Text.Unsafe

129 Data.Text.Unsafe

124

130

131+ other-modules:

132+ Data.Text.Show

133+

125 build-depends:

134 build-depends:

126 array >= 0.3,

135 array >= 0.3,

127 base >= 4.2 && < 5,

136 base >= 4.2 && < 5,

137+ binary,

128 deepseq >= 1.1.0.0,

138 deepseq >= 1.1.0.0,

129 ghc-prim >= 0.2

139 ghc-prim >= 0.2

130

140

131− if impl(ghc >= 7.7)

141+ if flag(bytestring-builder)

132− build-depends: bytestring >= 0.10.4.0

142+ build-depends: bytestring >= 0.9 && < 0.10.4,

143+ bytestring-builder >= 0.10.4

133 else

144 else

134− build-depends: bytestring >= 0.9

145+ build-depends: bytestring >= 0.10.4

135

146

136 cpp-options: -DHAVE_DEEPSEQ

147 cpp-options: -DHAVE_DEEPSEQ

137 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

148 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2

@@ -165,15 +176,22 @@ test-suite tests

165 QuickCheck >= 2.7,

176 QuickCheck >= 2.7,

166 array,

177 array,

167 base,

178 base,

168− bytestring,

179+ binary,

169 deepseq,

180 deepseq,

170 directory,

181 directory,

171 ghc-prim,

182 ghc-prim,

183+ quickcheck-unicode,

172 random,

184 random,

173 test-framework >= 0.4,

185 test-framework >= 0.4,

174 test-framework-hunit >= 0.2,

186 test-framework-hunit >= 0.2,

175 test-framework-quickcheck2 >= 0.2

187 test-framework-quickcheck2 >= 0.2

176

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+

177 if flag(integer-simple)

195 if flag(integer-simple)

178 cpp-options: -DINTEGER_SIMPLE

196 cpp-options: -DINTEGER_SIMPLE

179 build-depends: integer-simple >= 0.1 && < 0.5

197 build-depends: integer-simple >= 0.1 && < 0.5