on 9e39595 help sign in
.gitignore+10−3
since splitsnapshots
unifiedsplit
@@ -1,3 +1,10 @@
1−dist
1+/dist/
2+/dist-boot/
3+/dist-install/
4+/dist-newstyle/
2−cabal-dev
5+/cabal-dev/
3−cabal.sandbox.config
6+/cabal.sandbox.config
7+/ghc.mk
8+/GNUmakefile
9+/.ghc.environment.*
10+/cabal.project.local
.hgtags+1
@@ -64,3 +64,4 @@ f8a60279237c1c28e094868740d9188dd94fcc9e 1.2.0.0
64631fd055e27fa10983e17e9ad36d1b285b85c661 1.2.1.3
64631fd055e27fa10983e17e9ad36d1b285b85c661 1.2.1.3
658221a68ed5ec37028357df9c6c25f52320e54ad9 1.2.2.0
658221a68ed5ec37028357df9c6c25f52320e54ad9 1.2.2.0
66ce1c5ac65eb9f5580114b4e380092b05a485e95d 1.2.2.1
66ce1c5ac65eb9f5580114b4e380092b05a485e95d 1.2.2.1
67+d72c634a91ffe27ec5cd03921dd53efc8129d8f6 1.2.2.2
.travis.ymlnew file+111
@@ -0,0 +1,111 @@
1+# This Travis job script has been generated by a script via
2+#
3+# make_travis_yml_2.hs '-o' '.travis.yml' 'text.cabal'
4+#
5+# For more information, see https://github.com/hvr/multi-ghc-travis
6+#
7+language: c
8+sudo: false
9+
10+# Bryan threatens to turn off Travis-CI if he gets any email :-)
11+notifications:
12+ email: false
13+
14+cache:
15+ directories:
16+ - $HOME/.cabal/packages
17+ - $HOME/.cabal/store
18+
19+before_cache:
20+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
21+ # remove files that are regenerated by 'cabal update'
22+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
23+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
24+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
25+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
26+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
27+
28+matrix:
29+ include:
30+ - compiler: "ghc-7.0.4"
31+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
32+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.0.4], sources: [hvr-ghc]}}
33+ - compiler: "ghc-7.2.2"
34+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
35+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.2.2], sources: [hvr-ghc]}}
36+ - compiler: "ghc-7.4.2"
37+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
38+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.4.2], sources: [hvr-ghc]}}
39+ - compiler: "ghc-7.6.3"
40+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
41+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.6.3], sources: [hvr-ghc]}}
42+ - compiler: "ghc-7.8.4"
43+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
44+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}}
45+ - compiler: "ghc-7.10.3"
46+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
47+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}
48+ - compiler: "ghc-8.0.2"
49+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
50+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
51+ - compiler: "ghc-8.2.2"
52+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
53+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}
54+
55+before_install:
56+ - HC=${CC}
57+ - HCPKG=${HC/ghc/ghc-pkg}
58+ - unset CC
59+ - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH
60+ - PKGNAME='text'
61+
62+install:
63+ - cabal --version
64+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
65+ - BENCH=${BENCH---enable-benchmarks}
66+ - TEST=${TEST---enable-tests}
67+ - HADDOCK=${HADDOCK-true}
68+ - INSTALLED=${INSTALLED-true}
69+ - travis_retry cabal update -v
70+ - sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
71+ - rm -fv cabal.project.local
72+ - "echo 'packages: .' > cabal.project"
73+ - rm -f cabal.project.freeze
74+ - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all
75+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all
76+
77+# Here starts the actual work to be performed for the package under test;
78+# any command which exits with a non-zero exit code causes the build to fail.
79+script:
80+ - if [ -f configure.ac ]; then autoreconf -i; fi
81+ - rm -rf .ghc.environment.* dist/
82+ - cabal sdist # test that a source-distribution can be generated
83+ - cd dist/
84+ - SRCTAR=(${PKGNAME}-*.tar.gz)
85+ - SRC_BASENAME="${SRCTAR/%.tar.gz}"
86+ - tar -xvf "./$SRC_BASENAME.tar.gz"
87+ - cd "$SRC_BASENAME/"
88+## from here on, CWD is inside the extracted source-tarball
89+ - rm -fv cabal.project.local
90+ - "echo 'packages: .' > cabal.project"
91+ # this builds all libraries and executables (without tests/benchmarks)
92+ - rm -f cabal.project.freeze
93+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all
94+ # this builds all libraries and executables (including tests/benchmarks)
95+ # - rm -rf ./dist-newstyle
96+
97+ # Build with installed constraints for packages in global-db
98+ - if $INSTALLED; then
99+ echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh;
100+ else echo "Not building with installed constraints"; fi
101+
102+ # build & run tests, build benchmarks
103+ - cabal new-build -w ${HC} ${TEST} ${BENCH} all
104+ - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi
105+
106+ # haddock
107+ - rm -rf ./dist-newstyle
108+ - if $HADDOCK; then cabal new-haddock -w ${HC} --disable-tests --disable-benchmarks all; else echo "Skipping haddock generation";fi
109+
110+# REGENDATA ["-o",".travis.yml","text.cabal"]
111+# EOF
Data/JSString/Text.hsnew file+64
@@ -0,0 +1,64 @@
1+{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, JavaScriptFFI,
2+ UnboxedTuples, DeriveDataTypeable, GHCForeignImportPrim,
3+ MagicHash, FlexibleInstances, BangPatterns, Rank2Types, CPP #-}
4+
5+{- | Conversion between 'Data.Text.Text' and 'Data.JSString.JSString'
6+
7+ -}
8+
9+-- Moved from ghcjs-base with text-jsstring support.
10+
11+module Data.JSString.Text
12+ ( textToJSString
13+ , textFromJSString
14+ , lazyTextToJSString
15+ , lazyTextFromJSString
16+ , textFromJSVal
17+ , lazyTextFromJSVal
18+ ) where
19+
20+import GHCJS.Prim
21+
22+import GHC.Exts (Any)
23+
24+import Control.DeepSeq
25+
26+import qualified Data.Text as T
27+import qualified Data.Text.Internal as T
28+import qualified Data.Text.Lazy as TL
29+import Data.JSString (JSString)
30+
31+import GHCJS.Marshal.Pure
32+import Unsafe.Coerce
33+
34+textToJSString :: T.Text -> JSString
35+textToJSString (T.Text txt) = txt
36+{-# INLINE textToJSString #-}
37+
38+textFromJSString :: JSString -> T.Text
39+textFromJSString = T.Text
40+{-# INLINE textFromJSString #-}
41+
42+lazyTextToJSString :: TL.Text -> JSString
43+lazyTextToJSString t = rnf t `seq` js_lazyTextToString (unsafeCoerce t)
44+{-# INLINE lazyTextToJSString #-}
45+
46+lazyTextFromJSString :: JSString -> TL.Text
47+lazyTextFromJSString = TL.fromStrict . textFromJSString
48+{-# INLINE lazyTextFromJSString #-}
49+
50+-- | returns the empty Text if not a string
51+textFromJSVal :: JSVal -> T.Text
52+textFromJSVal v = T.Text $ pFromJSVal v -- TODO check if val is a string?
53+{-# INLINE textFromJSVal #-}
54+
55+-- | returns the empty Text if not a string
56+lazyTextFromJSVal :: JSVal -> TL.Text
57+lazyTextFromJSVal = TL.fromStrict . textFromJSVal
58+{-# INLINE lazyTextFromJSVal #-}
59+
60+-- ----------------------------------------------------------------------------
61+
62+foreign import javascript unsafe
63+ "h$lazyTextToString"
64+ js_lazyTextToString :: Any -> JSString
Data/Text.hs+689−391
@@ -6,7 +6,7 @@
6#if __GLASGOW_HASKELL__ >= 708
6#if __GLASGOW_HASKELL__ >= 708
7{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeFamilies #-}
8#endif
8#endif
9−
9+{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, UnliftedFFITypes #-}
10-- |
10-- |
11-- Module : Data.Text
11-- Module : Data.Text
12-- Copyright : (c) 2009, 2010, 2011, 2012 Bryan O'Sullivan,
12-- Copyright : (c) 2009, 2010, 2011, 2012 Bryan O'Sullivan,
@@ -15,7 +15,6 @@
15--
15--
16-- License : BSD-style
16-- License : BSD-style
17-- Maintainer : bos@serpentine.com
17-- Maintainer : bos@serpentine.com
18−-- Stability : experimental
19-- Portability : GHC
18-- Portability : GHC
20--
19--
21-- A time and space-efficient implementation of Unicode text.
20-- A time and space-efficient implementation of Unicode text.
@@ -32,8 +31,9 @@
32--
31--
33-- To use an extended and very rich family of functions for working
32-- To use an extended and very rich family of functions for working
34-- with Unicode text (including normalization, regular expressions,
33-- with Unicode text (including normalization, regular expressions,
35−-- non-standard encodings, text breaking, and locales), see
34+-- non-standard encodings, text breaking, and locales), see the
36−-- <http://hackage.haskell.org/package/text-icu the text-icu package >.
35+-- <http://hackage.haskell.org/package/text-icu text-icu package >.
36+--
37
37
38module Data.Text
38module Data.Text
39 (
39 (
@@ -43,6 +43,9 @@ module Data.Text
43 -- * Acceptable data
43 -- * Acceptable data
44 -- $replacement
44 -- $replacement
45
45
46+ -- * Definition of character
47+ -- $character_definition
48+
46 -- * Fusion
49 -- * Fusion
47 -- $fusion
50 -- $fusion
48
51
@@ -60,6 +63,7 @@ module Data.Text
60 , snoc
63 , snoc
61 , append
64 , append
62 , uncons
65 , uncons
66+ , unsnoc
63 , head
67 , head
64 , last
68 , last
65 , tail
69 , tail
@@ -223,16 +227,17 @@ import qualified Data.Text.Internal.Fusion as S
223import qualified Data.Text.Internal.Fusion.Common as S
227import qualified Data.Text.Internal.Fusion.Common as S
224import Data.Text.Encoding (decodeUtf8', encodeUtf8)
228import Data.Text.Encoding (decodeUtf8', encodeUtf8)
225import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
229import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
226−import Data.Text.Internal.Private (span_)
230+-- import Data.Text.Internal.Private (span_)
227−import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
231+import Data.Text.Internal (Text(..), empty, empty_, firstf, mul, safe, text)
228−import Data.Text.Show (singleton, unpack, unpackCString#)
232+-- import Data.Text.Show (singleton, unpack, unpackCString#)
229import qualified Prelude as P
233import qualified Prelude as P
230import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
234import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
231− reverseIter_, unsafeHead, unsafeTail)
235+ reverseIter_, unsafeHead, unsafeTail,
236+ unsafeDupablePerformIO)
232import Data.Text.Internal.Unsafe.Char (unsafeChr)
237import Data.Text.Internal.Unsafe.Char (unsafeChr)
233import qualified Data.Text.Internal.Functions as F
238import qualified Data.Text.Internal.Functions as F
234import qualified Data.Text.Internal.Encoding.Utf16 as U16
239import qualified Data.Text.Internal.Encoding.Utf16 as U16
235−import Data.Text.Internal.Search (indices)
240+-- import Data.Text.Internal.Search (indices)
236#if defined(__HADDOCK__)
241#if defined(__HADDOCK__)
237import Data.ByteString (ByteString)
242import Data.ByteString (ByteString)
238import qualified Data.Text.Lazy as L
243import qualified Data.Text.Lazy as L
@@ -246,6 +251,68 @@ import qualified GHC.Exts as Exts
246import Text.Printf (PrintfArg, formatArg, formatString)
251import Text.Printf (PrintfArg, formatArg, formatString)
247#endif
252#endif
248
253
254+-- GHCJS ------------------------------------------------------------
255+import Data.JSString.Internal.Type (JSString (..))
256+import qualified Data.JSString as JSS
257+import qualified Data.JSString.Internal.Fusion as SJS
258+import qualified Data.JSString.Internal.Fusion.Common as SJS
259+import Data.Coerce
260+import GHC.Base (build)
261+import qualified GHC.CString as GHC
262+import GHC.Exts (Addr#, ByteArray#)
263+import GHCJS.Prim (JSVal (..), unpackJSString#)
264+
265+unpack :: Text -> String
266+unpack = coerce JSS.unpack
267+{-# INLINE [1] unpack #-}
268+
269+singleton :: Char -> Text
270+singleton = coerce JSS.singleton
271+{-# INLINE [1] singleton #-}
272+
273+{-# RULES
274+"JSSTRING singleton -> fused" [~1] forall a.
275+ singleton a = unstream (S.singleton (safe a))
276+"JSSTRING singleton -> unfused" [1] forall a.
277+ unstream (S.singleton (safe a)) = singleton a
278+ #-}
279+
280+{-# RULES "inlineJSString" forall s. pack (GHC.Base.build (GHC.unpackFoldrCString# s)) = Text (JSString (unsafeDupablePerformIO (unpackJSString# s))) #-}
281+
282+-- | /O(n)/ Convert a literal string into a JSString. Subject to fusion.
283+unpackCString# :: Addr# -> Text
284+unpackCString# addr# = Text $ SJS.unstream (SJS.streamCString# addr#)
285+{-# NOINLINE unpackCString# #-}
286+
287+{-# RULES "TEXT literal" forall a.
288+ unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
289+ = unpackCString# a #-}
290+
291+{-# RULES "TEXT literal UTF8" [1] forall a.
292+ unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
293+ = unpackCString# a #-}
294+
295+{-# RULES "TEXT empty literal" [1]
296+ unstream (S.map safe (S.streamList []))
297+ = empty_ #-}
298+
299+{-# RULES "TEXT singleton literal" [1] forall a.
300+ unstream (S.map safe (S.streamList [a]))
301+ = singleton a #-}
302+
303+---------------------------------------------------------------------
304+-- $character_definition
305+--
306+-- This package uses the term /character/ to denote Unicode /code points/.
307+--
308+-- Note that this is not the same thing as a grapheme (e.g. a
309+-- composition of code points that form one visual symbol). For
310+-- instance, consider the grapheme \"&#x00e4;\". This symbol has two
311+-- Unicode representations: a single code-point representation
312+-- @U+00E4@ (the @LATIN SMALL LETTER A WITH DIAERESIS@ code point),
313+-- and a two code point representation @U+0061@ (the \"@A@\" code
314+-- point) and @U+0308@ (the @COMBINING DIAERESIS@ code point).
315+
249-- $strict
316-- $strict
250--
317--
251-- This package provides both strict and lazy 'Text' types. The
318-- This package provides both strict and lazy 'Text' types. The
@@ -321,22 +388,31 @@ import Text.Printf (PrintfArg, formatArg, formatString)
321-- Functions that can be fused by the compiler are documented with the
388-- Functions that can be fused by the compiler are documented with the
322-- phrase \"Subject to fusion\".
389-- phrase \"Subject to fusion\".
323
390
391+-- instance Eq Text where
392+-- Text arrA offA lenA == Text arrB offB lenB
393+-- | lenA == lenB = A.equal arrA offA arrB offB lenA
394+-- | otherwise = False
395+-- {-# INLINE (==) #-}
324instance Eq Text where
396instance Eq Text where
325− Text arrA offA lenA == Text arrB offB lenB
397+ Text x == Text y = x == y
326− | lenA == lenB = A.equal arrA offA arrB offB lenA
398+
327− | otherwise = False
399+-- instance Ord Text where
328− {-# INLINE (==) #-}
400+-- compare = compareText
329
401
330instance Ord Text where
402instance Ord Text where
331− compare = compareText
403+ compare (Text x) (Text y) = compare x y
332
404
333instance Read Text where
405instance Read Text where
334 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
406 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
335
407
336#if MIN_VERSION_base(4,9,0)
408#if MIN_VERSION_base(4,9,0)
409+-- | Non-orphan 'Semigroup' instance only defined for
337−-- Semigroup orphan instances for older GHCs are provided by
410+-- @base-4.9.0.0@ and later; orphan instances for older GHCs are
411+-- provided by
412+-- the [semigroups](http://hackage.haskell.org/package/semigroups)
338−-- 'semigroups` package
413+-- package
339−
414+--
415+-- @since 1.2.2.0
340instance Semigroup Text where
416instance Semigroup Text where
341 (<>) = append
417 (<>) = append
342#endif
418#endif
@@ -354,6 +430,7 @@ instance IsString Text where
354 fromString = pack
430 fromString = pack
355
431
356#if __GLASGOW_HASKELL__ >= 708
432#if __GLASGOW_HASKELL__ >= 708
433+-- | @since 1.2.0.0
357instance Exts.IsList Text where
434instance Exts.IsList Text where
358 type Item Text = Char
435 type Item Text = Char
359 fromList = pack
436 fromList = pack
@@ -364,6 +441,7 @@ instance Exts.IsList Text where
364instance NFData Text where rnf !_ = ()
441instance NFData Text where rnf !_ = ()
365#endif
442#endif
366
443
444+-- | @since 1.2.1.0
367instance Binary Text where
445instance Binary Text where
368 put t = put (encodeUtf8 t)
446 put t = put (encodeUtf8 t)
369 get = do
447 get = do
@@ -397,8 +475,10 @@ instance Data Text where
397
475
398#if MIN_VERSION_base(4,7,0)
476#if MIN_VERSION_base(4,7,0)
399-- | Only defined for @base-4.7.0.0@ and later
477-- | Only defined for @base-4.7.0.0@ and later
478+--
479+-- @since 1.2.2.0
400instance PrintfArg Text where
480instance PrintfArg Text where
401− formatArg txt = formatString $ unpack txt
481+ formatArg t = formatString $ unpack t
402#endif
482#endif
403
483
404packConstr :: Constr
484packConstr :: Constr
@@ -407,19 +487,19 @@ packConstr = mkConstr textDataType "pack" [] Prefix
407textDataType :: DataType
487textDataType :: DataType
408textDataType = mkDataType "Data.Text.Text" [packConstr]
488textDataType = mkDataType "Data.Text.Text" [packConstr]
409
489
410−-- | /O(n)/ Compare two 'Text' values lexicographically.
490+-- -- | /O(n)/ Compare two 'Text' values lexicographically.
411−compareText :: Text -> Text -> Ordering
491+-- compareText :: Text -> Text -> Ordering
412−compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
492+-- compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
413− | lenA == 0 && lenB == 0 = EQ
493+-- | lenA == 0 && lenB == 0 = EQ
414− | otherwise = go 0 0
494+-- | otherwise = go 0 0
415− where
495+-- where
416− go !i !j
496+-- go !i !j
417− | i >= lenA || j >= lenB = compare lenA lenB
497+-- | i >= lenA || j >= lenB = compare lenA lenB
418− | a < b = LT
498+-- | a < b = LT
419− | a > b = GT
499+-- | a > b = GT
420− | otherwise = go (i+di) (j+dj)
500+-- | otherwise = go (i+di) (j+dj)
421− where Iter a di = iter ta i
501+-- where Iter a di = iter ta i
422− Iter b dj = iter tb j
502+-- Iter b dj = iter tb j
423
503
424-- -----------------------------------------------------------------------------
504-- -----------------------------------------------------------------------------
425-- * Conversion to/from 'Text'
505-- * Conversion to/from 'Text'
@@ -427,7 +507,8 @@ compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
427-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
507-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
428-- fusion. Performs replacement on invalid scalar values.
508-- fusion. Performs replacement on invalid scalar values.
429pack :: String -> Text
509pack :: String -> Text
510+pack = coerce JSS.pack
430−pack = unstream . S.map safe . S.streamList
511+-- pack = unstream . S.map safe . S.streamList
431{-# INLINE [1] pack #-}
512{-# INLINE [1] pack #-}
432
513
433-- -----------------------------------------------------------------------------
514-- -----------------------------------------------------------------------------
@@ -438,7 +519,8 @@ pack = unstream . S.map safe . S.streamList
438-- copying a new array. Subject to fusion. Performs replacement on
519-- copying a new array. Subject to fusion. Performs replacement on
439-- invalid scalar values.
520-- invalid scalar values.
440cons :: Char -> Text -> Text
521cons :: Char -> Text -> Text
522+cons = coerce JSS.cons
441−cons c t = unstream (S.cons (safe c) (stream t))
523+-- cons c t = unstream (S.cons (safe c) (stream t))
442{-# INLINE cons #-}
524{-# INLINE cons #-}
443
525
444infixr 5 `cons`
526infixr 5 `cons`
@@ -447,25 +529,27 @@ infixr 5 `cons`
447-- entire array in the process, unless fused. Subject to fusion.
529-- entire array in the process, unless fused. Subject to fusion.
448-- Performs replacement on invalid scalar values.
530-- Performs replacement on invalid scalar values.
449snoc :: Text -> Char -> Text
531snoc :: Text -> Char -> Text
532+snoc = coerce JSS.snoc
450−snoc t c = unstream (S.snoc (stream t) (safe c))
533+-- snoc t c = unstream (S.snoc (stream t) (safe c))
451{-# INLINE snoc #-}
534{-# INLINE snoc #-}
452
535
453-- | /O(n)/ Appends one 'Text' to the other by copying both of them
536-- | /O(n)/ Appends one 'Text' to the other by copying both of them
454-- into a new 'Text'. Subject to fusion.
537-- into a new 'Text'. Subject to fusion.
455append :: Text -> Text -> Text
538append :: Text -> Text -> Text
539+append = coerce JSS.append
456−append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
540+-- append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
457− | len1 == 0 = b
541+-- | len1 == 0 = b
458− | len2 == 0 = a
542+-- | len2 == 0 = a
459− | len > 0 = Text (A.run x) 0 len
543+-- | len > 0 = Text (A.run x) 0 len
460− | otherwise = overflowError "append"
544+-- | otherwise = overflowError "append"
461− where
545+-- where
462− len = len1+len2
546+-- len = len1+len2
463− x :: ST s (A.MArray s)
547+-- x :: ST s (A.MArray s)
464− x = do
548+-- x = do
465− arr <- A.new len
549+-- arr <- A.new len
466− A.copyI arr 0 arr1 off1 len1
550+-- A.copyI arr 0 arr1 off1 len1
467− A.copyI arr len1 arr2 off2 len
551+-- A.copyI arr len1 arr2 off2 len
468− return arr
552+-- return arr
469{-# NOINLINE append #-}
553{-# NOINLINE append #-}
470
554
471{-# RULES
555{-# RULES
@@ -478,16 +562,18 @@ append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
478-- | /O(1)/ Returns the first character of a 'Text', which must be
562-- | /O(1)/ Returns the first character of a 'Text', which must be
479-- non-empty. Subject to fusion.
563-- non-empty. Subject to fusion.
480head :: Text -> Char
564head :: Text -> Char
565+head = coerce JSS.head
481−head t = S.head (stream t)
566+-- head t = S.head (stream t)
482{-# INLINE head #-}
567{-# INLINE head #-}
483
568
484-- | /O(1)/ Returns the first character and rest of a 'Text', or
569-- | /O(1)/ Returns the first character and rest of a 'Text', or
485-- 'Nothing' if empty. Subject to fusion.
570-- 'Nothing' if empty. Subject to fusion.
486uncons :: Text -> Maybe (Char, Text)
571uncons :: Text -> Maybe (Char, Text)
572+uncons = coerce JSS.uncons
487−uncons t@(Text arr off len)
573+-- uncons t@(Text arr off len)
488− | len <= 0 = Nothing
574+-- | len <= 0 = Nothing
489− | otherwise = Just $ let !(Iter c d) = iter t 0
575+-- | otherwise = Just $ let !(Iter c d) = iter t 0
490− in (c, text arr (off+d) (len-d))
576+-- in (c, text arr (off+d) (len-d))
491{-# INLINE [1] uncons #-}
577{-# INLINE [1] uncons #-}
492
578
493-- | Lifted from Control.Arrow and specialized.
579-- | Lifted from Control.Arrow and specialized.
@@ -497,12 +583,13 @@ second f (a, b) = (a, f b)
497-- | /O(1)/ Returns the last character of a 'Text', which must be
583-- | /O(1)/ Returns the last character of a 'Text', which must be
498-- non-empty. Subject to fusion.
584-- non-empty. Subject to fusion.
499last :: Text -> Char
585last :: Text -> Char
586+last = coerce JSS.last
500−last (Text arr off len)
587+-- last (Text arr off len)
501− | len <= 0 = emptyError "last"
588+-- | len <= 0 = emptyError "last"
502− | n < 0xDC00 || n > 0xDFFF = unsafeChr n
589+-- | n < 0xDC00 || n > 0xDFFF = unsafeChr n
503− | otherwise = U16.chr2 n0 n
590+-- | otherwise = U16.chr2 n0 n
504− where n = A.unsafeIndex arr (off+len-1)
591+-- where n = A.unsafeIndex arr (off+len-1)
505− n0 = A.unsafeIndex arr (off+len-2)
592+-- n0 = A.unsafeIndex arr (off+len-2)
506{-# INLINE [1] last #-}
593{-# INLINE [1] last #-}
507
594
508{-# RULES
595{-# RULES
@@ -515,10 +602,11 @@ last (Text arr off len)
515-- | /O(1)/ Returns all characters after the head of a 'Text', which
602-- | /O(1)/ Returns all characters after the head of a 'Text', which
516-- must be non-empty. Subject to fusion.
603-- must be non-empty. Subject to fusion.
517tail :: Text -> Text
604tail :: Text -> Text
605+tail = coerce JSS.tail
518−tail t@(Text arr off len)
606+-- tail t@(Text arr off len)
519− | len <= 0 = emptyError "tail"
607+-- | len <= 0 = emptyError "tail"
520− | otherwise = text arr (off+d) (len-d)
608+-- | otherwise = text arr (off+d) (len-d)
521− where d = iter_ t 0
609+-- where d = iter_ t 0
522{-# INLINE [1] tail #-}
610{-# INLINE [1] tail #-}
523
611
524{-# RULES
612{-# RULES
@@ -531,11 +619,12 @@ tail t@(Text arr off len)
531-- | /O(1)/ Returns all but the last character of a 'Text', which must
619-- | /O(1)/ Returns all but the last character of a 'Text', which must
532-- be non-empty. Subject to fusion.
620-- be non-empty. Subject to fusion.
533init :: Text -> Text
621init :: Text -> Text
622+init = coerce JSS.init
534−init (Text arr off len) | len <= 0 = emptyError "init"
623+-- init (Text arr off len) | len <= 0 = emptyError "init"
535− | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
624+-- | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
536− | otherwise = text arr off (len-1)
625+-- | otherwise = text arr off (len-1)
537− where
626+-- where
538− n = A.unsafeIndex arr (off+len-1)
627+-- n = A.unsafeIndex arr (off+len-1)
539{-# INLINE [1] init #-}
628{-# INLINE [1] init #-}
540
629
541{-# RULES
630{-# RULES
@@ -545,14 +634,28 @@ init (Text arr off len) | len <= 0 = emptyError "init"
545 unstream (S.init (stream t)) = init t
634 unstream (S.init (stream t)) = init t
546 #-}
635 #-}
547
636
637+-- | /O(1)/ Returns all but the last character and the last character of a
638+-- 'Text', or 'Nothing' if empty.
639+--
640+-- @since 1.2.3.0
641+unsnoc :: Text -> Maybe (Text, Char)
642+unsnoc (Text arr off len)
643+ | len <= 0 = Nothing
644+ | n < 0xDC00 || n > 0xDFFF = Just (text arr off (len-1), unsafeChr n)
645+ | otherwise = Just (text arr off (len-2), U16.chr2 n0 n)
646+ where n = A.unsafeIndex arr (off+len-1)
647+ n0 = A.unsafeIndex arr (off+len-2)
648+{-# INLINE [1] unsnoc #-}
649+
548-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
650-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
549-- fusion.
651-- fusion.
550null :: Text -> Bool
652null :: Text -> Bool
653+null = coerce JSS.null
551−null (Text _arr _off len) =
654+-- null (Text _arr _off len) =
552−#if defined(ASSERTS)
655+-- #if defined(ASSERTS)
553− assert (len >= 0) $
656+-- assert (len >= 0) $
554−#endif
657+-- #endif
555− len <= 0
658+-- len <= 0
556{-# INLINE [1] null #-}
659{-# INLINE [1] null #-}
557
660
558{-# RULES
661{-# RULES
@@ -564,14 +667,15 @@ null (Text _arr _off len) =
564
667
565-- | /O(1)/ Tests whether a 'Text' contains exactly one character.
668-- | /O(1)/ Tests whether a 'Text' contains exactly one character.
566-- Subject to fusion.
669-- Subject to fusion.
567−isSingleton :: Text -> Bool
670+-- isSingleton :: Text -> Bool
568−isSingleton = S.isSingleton . stream
671+-- isSingleton = S.isSingleton . stream
569−{-# INLINE isSingleton #-}
672+-- {-# INLINE isSingleton #-}
570
673
571-- | /O(n)/ Returns the number of characters in a 'Text'.
674-- | /O(n)/ Returns the number of characters in a 'Text'.
572-- Subject to fusion.
675-- Subject to fusion.
573length :: Text -> Int
676length :: Text -> Int
677+length = coerce JSS.length
574−length t = S.length (stream t)
678+-- length t = S.length (stream t)
575{-# INLINE [0] length #-}
679{-# INLINE [0] length #-}
576-- length needs to be phased after the compareN/length rules otherwise
680-- length needs to be phased after the compareN/length rules otherwise
577-- it may inline before the rules have an opportunity to fire.
681-- it may inline before the rules have an opportunity to fire.
@@ -624,29 +728,58 @@ compareLength t n = S.compareLengthI (stream t) n
624-- -----------------------------------------------------------------------------
728-- -----------------------------------------------------------------------------
625-- * Transformations
729-- * Transformations
626-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
730-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
731+-- each element of @t@.
732+--
733+-- Example:
734+--
735+-- >>> let message = pack "I am not angry. Not at all."
736+-- >>> T.map (\c -> if c == '.' then '!' else c) message
737+-- "I am not angry! Not at all!"
738+--
627−-- each element of @t@. Subject to fusion. Performs replacement on
739+-- Subject to fusion. Performs replacement on invalid scalar values.
628−-- invalid scalar values.
629map :: (Char -> Char) -> Text -> Text
740map :: (Char -> Char) -> Text -> Text
741+map = coerce JSS.map
630−map f t = unstream (S.map (safe . f) (stream t))
742+-- map f t = unstream (S.map (safe . f) (stream t))
631{-# INLINE [1] map #-}
743{-# INLINE [1] map #-}
632
744
633-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
745-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
634-- 'Text's and concatenates the list after interspersing the first
746-- 'Text's and concatenates the list after interspersing the first
635-- argument between each element of the list.
747-- argument between each element of the list.
748+--
749+-- Example:
750+--
751+-- >>> T.intercalate "NI!" ["We", "seek", "the", "Holy", "Grail"]
752+-- "WeNI!seekNI!theNI!HolyNI!Grail"
636intercalate :: Text -> [Text] -> Text
753intercalate :: Text -> [Text] -> Text
754+intercalate = coerce JSS.intercalate
637−intercalate t = concat . (F.intersperse t)
755+-- intercalate t = concat . (F.intersperse t)
638{-# INLINE intercalate #-}
756{-# INLINE intercalate #-}
639
757
640-- | /O(n)/ The 'intersperse' function takes a character and places it
758-- | /O(n)/ The 'intersperse' function takes a character and places it
641−-- between the characters of a 'Text'. Subject to fusion. Performs
759+-- between the characters of a 'Text'.
760+--
761+-- Example:
762+--
763+-- >>> T.intersperse '.' "SHIELD"
764+-- "S.H.I.E.L.D"
765+--
642−-- replacement on invalid scalar values.
766+-- Subject to fusion. Performs replacement on invalid scalar values.
643intersperse :: Char -> Text -> Text
767intersperse :: Char -> Text -> Text
768+intersperse = coerce JSS.intersperse
644−intersperse c t = unstream (S.intersperse (safe c) (stream t))
769+-- intersperse c t = unstream (S.intersperse (safe c) (stream t))
645{-# INLINE intersperse #-}
770{-# INLINE intersperse #-}
646
771
647−-- | /O(n)/ Reverse the characters of a string. Subject to fusion.
772+-- | /O(n)/ Reverse the characters of a string.
773+--
774+-- Example:
775+--
776+-- >>> T.reverse "desrever"
777+-- "reversed"
778+--
779+-- Subject to fusion.
648reverse :: Text -> Text
780reverse :: Text -> Text
781+reverse = coerce JSS.reverse
649−reverse t = S.reverse (stream t)
782+-- reverse t = S.reverse (stream t)
650{-# INLINE reverse #-}
783{-# INLINE reverse #-}
651
784
652-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
785-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
@@ -663,12 +796,14 @@ reverse t = S.reverse (stream t)
663-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
796-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
664-- be replaced recursively:
797-- be replaced recursively:
665--
798--
666−-- > replace "oo" "foo" "oo" == "foo"
799+-- >>> replace "oo" "foo" "oo"
800+-- "foo"
667--
801--
668-- In cases where several instances of @needle@ overlap, only the
802-- In cases where several instances of @needle@ overlap, only the
669-- first one will be replaced:
803-- first one will be replaced:
670--
804--
671−-- > replace "ofo" "bar" "ofofo" == "barfo"
805+-- >>> replace "ofo" "bar" "ofofo"
806+-- "barfo"
672--
807--
673-- In (unlikely) bad cases, this function's time complexity degrades
808-- In (unlikely) bad cases, this function's time complexity degrades
674-- towards /O(n*m)/.
809-- towards /O(n*m)/.
@@ -680,28 +815,29 @@ replace :: Text
680 -> Text
815 -> Text
681 -- ^ @haystack@ in which to search.
816 -- ^ @haystack@ in which to search.
682 -> Text
817 -> Text
818+replace = coerce JSS.replace
683−replace needle@(Text _ _ neeLen)
819+-- replace needle@(Text _ _ neeLen)
684− (Text repArr repOff repLen)
820+-- (Text repArr repOff repLen)
685− haystack@(Text hayArr hayOff hayLen)
821+-- haystack@(Text hayArr hayOff hayLen)
686− | neeLen == 0 = emptyError "replace"
822+-- | neeLen == 0 = emptyError "replace"
687− | L.null ixs = haystack
823+-- | L.null ixs = haystack
688− | len > 0 = Text (A.run x) 0 len
824+-- | len > 0 = Text (A.run x) 0 len
689− | otherwise = empty
825+-- | otherwise = empty
690− where
826+-- where
691− ixs = indices needle haystack
827+-- ixs = indices needle haystack
692− len = hayLen - (neeLen - repLen) `mul` L.length ixs
828+-- len = hayLen - (neeLen - repLen) `mul` L.length ixs
693− x :: ST s (A.MArray s)
829+-- x :: ST s (A.MArray s)
694− x = do
830+-- x = do
695− marr <- A.new len
831+-- marr <- A.new len
696− let loop (i:is) o d = do
832+-- let loop (i:is) o d = do
697− let d0 = d + i - o
833+-- let d0 = d + i - o
698− d1 = d0 + repLen
834+-- d1 = d0 + repLen
699− A.copyI marr d hayArr (hayOff+o) d0
835+-- A.copyI marr d hayArr (hayOff+o) d0
700− A.copyI marr d0 repArr repOff d1
836+-- A.copyI marr d0 repArr repOff d1
701− loop is (i + neeLen) d1
837+-- loop is (i + neeLen) d1
702− loop [] o d = A.copyI marr d hayArr (hayOff+o) len
838+-- loop [] o d = A.copyI marr d hayArr (hayOff+o) len
703− loop ixs 0 0
839+-- loop ixs 0 0
704− return marr
840+-- return marr
705
841
706-- ----------------------------------------------------------------------------
842-- ----------------------------------------------------------------------------
707-- ** Case conversions (folds)
843-- ** Case conversions (folds)
@@ -740,7 +876,8 @@ replace needle@(Text _ _ neeLen)
740-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)
876-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)
741-- instead of itself.
877-- instead of itself.
742toCaseFold :: Text -> Text
878toCaseFold :: Text -> Text
743−toCaseFold t = unstream (S.toCaseFold (stream t))
879+-- toCaseFold t = unstream (S.toCaseFold (stream t))
880+toCaseFold = coerce JSS.toCaseFold
744{-# INLINE toCaseFold #-}
881{-# INLINE toCaseFold #-}
745
882
746-- | /O(n)/ Convert a string to lower case, using simple case
883-- | /O(n)/ Convert a string to lower case, using simple case
@@ -751,7 +888,8 @@ toCaseFold t = unstream (S.toCaseFold (stream t))
751-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
888-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
752-- followed by \" &#x307;\" (combining dot above, U+0307).
889-- followed by \" &#x307;\" (combining dot above, U+0307).
753toLower :: Text -> Text
890toLower :: Text -> Text
754−toLower t = unstream (S.toLower (stream t))
891+-- toLower t = unstream (S.toLower (stream t))
892+toLower = coerce JSS.toLower
755{-# INLINE toLower #-}
893{-# INLINE toLower #-}
756
894
757-- | /O(n)/ Convert a string to upper case, using simple case
895-- | /O(n)/ Convert a string to upper case, using simple case
@@ -761,7 +899,8 @@ toLower t = unstream (S.toLower (stream t))
761-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
899-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
762-- two-letter sequence \"SS\".
900-- two-letter sequence \"SS\".
763toUpper :: Text -> Text
901toUpper :: Text -> Text
764−toUpper t = unstream (S.toUpper (stream t))
902+-- toUpper t = unstream (S.toUpper (stream t))
903+toUpper = coerce JSS.toUpper
765{-# INLINE toUpper #-}
904{-# INLINE toUpper #-}
766
905
767-- | /O(n)/ Convert a string to title case, using simple case
906-- | /O(n)/ Convert a string to title case, using simple case
@@ -782,8 +921,11 @@ toUpper t = unstream (S.toUpper (stream t))
782-- guides disagree on whether the book name \"The Hill of the Red
921-- guides disagree on whether the book name \"The Hill of the Red
783-- Fox\" is correctly title cased&#x2014;but this function will
922-- Fox\" is correctly title cased&#x2014;but this function will
784-- capitalize /every/ word.
923-- capitalize /every/ word.
924+--
925+-- @since 1.0.0.0
785toTitle :: Text -> Text
926toTitle :: Text -> Text
927+toTitle = coerce JSS.toTitle
786−toTitle t = unstream (S.toTitle (stream t))
928+-- toTitle t = unstream (S.toTitle (stream t))
787{-# INLINE toTitle #-}
929{-# INLINE toTitle #-}
788
930
789-- | /O(n)/ Left-justify a string to the given length, using the
931-- | /O(n)/ Left-justify a string to the given length, using the
@@ -792,13 +934,17 @@ toTitle t = unstream (S.toTitle (stream t))
792--
934--
793-- Examples:
935-- Examples:
794--
936--
795−-- > justifyLeft 7 'x' "foo" == "fooxxxx"
937+-- >>> justifyLeft 7 'x' "foo"
938+-- "fooxxxx"
939+--
796−-- > justifyLeft 3 'x' "foobar" == "foobar"
940+-- >>> justifyLeft 3 'x' "foobar"
941+-- "foobar"
797justifyLeft :: Int -> Char -> Text -> Text
942justifyLeft :: Int -> Char -> Text -> Text
798−justifyLeft k c t
943+justifyLeft = coerce JSS.justifyLeft
944+-- justifyLeft k c t
799− | len >= k = t
945+-- | len >= k = t
800− | otherwise = t `append` replicateChar (k-len) c
946+-- | otherwise = t `append` replicateChar (k-len) c
801− where len = length t
947+-- where len = length t
802{-# INLINE [1] justifyLeft #-}
948{-# INLINE [1] justifyLeft #-}
803
949
804{-# RULES
950{-# RULES
@@ -814,13 +960,17 @@ justifyLeft k c t
814--
960--
815-- Examples:
961-- Examples:
816--
962--
817−-- > justifyRight 7 'x' "bar" == "xxxxbar"
963+-- >>> justifyRight 7 'x' "bar"
964+-- "xxxxbar"
965+--
818−-- > justifyRight 3 'x' "foobar" == "foobar"
966+-- >>> justifyRight 3 'x' "foobar"
967+-- "foobar"
819justifyRight :: Int -> Char -> Text -> Text
968justifyRight :: Int -> Char -> Text -> Text
820−justifyRight k c t
969+justifyRight = coerce JSS.justifyRight
970+-- justifyRight k c t
821− | len >= k = t
971+-- | len >= k = t
822− | otherwise = replicateChar (k-len) c `append` t
972+-- | otherwise = replicateChar (k-len) c `append` t
823− where len = length t
973+-- where len = length t
824{-# INLINE justifyRight #-}
974{-# INLINE justifyRight #-}
825
975
826-- | /O(n)/ Center a string to the given length, using the specified
976-- | /O(n)/ Center a string to the given length, using the specified
@@ -829,23 +979,34 @@ justifyRight k c t
829--
979--
830-- Examples:
980-- Examples:
831--
981--
832−-- > center 8 'x' "HS" = "xxxHSxxx"
982+-- >>> center 8 'x' "HS"
983+-- "xxxHSxxx"
833center :: Int -> Char -> Text -> Text
984center :: Int -> Char -> Text -> Text
834−center k c t
985+center = coerce JSS.center
986+-- center k c t
835− | len >= k = t
987+-- | len >= k = t
836− | otherwise = replicateChar l c `append` t `append` replicateChar r c
988+-- | otherwise = replicateChar l c `append` t `append` replicateChar r c
837− where len = length t
989+-- where len = length t
838− d = k - len
990+-- d = k - len
839− r = d `quot` 2
991+-- r = d `quot` 2
840− l = d - r
992+-- l = d - r
841{-# INLINE center #-}
993{-# INLINE center #-}
842
994
843-- | /O(n)/ The 'transpose' function transposes the rows and columns
995-- | /O(n)/ The 'transpose' function transposes the rows and columns
844-- of its 'Text' argument. Note that this function uses 'pack',
996-- of its 'Text' argument. Note that this function uses 'pack',
845-- 'unpack', and the list version of transpose, and is thus not very
997-- 'unpack', and the list version of transpose, and is thus not very
846-- efficient.
998-- efficient.
999+--
1000+-- Examples:
1001+--
1002+-- >>> transpose ["green","orange"]
1003+-- ["go","rr","ea","en","ng","e"]
1004+--
1005+-- >>> transpose ["blue","red"]
1006+-- ["br","le","ud","e"]
847transpose :: [Text] -> [Text]
1007transpose :: [Text] -> [Text]
1008+transpose = coerce JSS.transpose
848−transpose ts = P.map pack (L.transpose (P.map unpack ts))
1009+-- transpose ts = P.map pack (L.transpose (P.map unpack ts))
849
1010
850-- -----------------------------------------------------------------------------
1011-- -----------------------------------------------------------------------------
851-- * Reducing 'Text's (folds)
1012-- * Reducing 'Text's (folds)
@@ -855,23 +1016,27 @@ transpose ts = P.map pack (L.transpose (P.map unpack ts))
855-- reduces the 'Text' using the binary operator, from left to right.
1016-- reduces the 'Text' using the binary operator, from left to right.
856-- Subject to fusion.
1017-- Subject to fusion.
857foldl :: (a -> Char -> a) -> a -> Text -> a
1018foldl :: (a -> Char -> a) -> a -> Text -> a
1019+foldl f a0 (Text t) = JSS.foldl f a0 t
858−foldl f z t = S.foldl f z (stream t)
1020+-- foldl f z t = S.foldl f z (stream t)
859{-# INLINE foldl #-}
1021{-# INLINE foldl #-}
860
1022
861-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.
1023-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.
862foldl' :: (a -> Char -> a) -> a -> Text -> a
1024foldl' :: (a -> Char -> a) -> a -> Text -> a
1025+foldl' f a0 (Text t) = JSS.foldl' f a0 t
863−foldl' f z t = S.foldl' f z (stream t)
1026+-- foldl' f z t = S.foldl' f z (stream t)
864{-# INLINE foldl' #-}
1027{-# INLINE foldl' #-}
865
1028
866-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
1029-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
867-- and thus must be applied to a non-empty 'Text'. Subject to fusion.
1030-- and thus must be applied to a non-empty 'Text'. Subject to fusion.
868foldl1 :: (Char -> Char -> Char) -> Text -> Char
1031foldl1 :: (Char -> Char -> Char) -> Text -> Char
1032+foldl1 = coerce JSS.foldl1
869−foldl1 f t = S.foldl1 f (stream t)
1033+-- foldl1 f t = S.foldl1 f (stream t)
870{-# INLINE foldl1 #-}
1034{-# INLINE foldl1 #-}
871
1035
872-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.
1036-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.
873foldl1' :: (Char -> Char -> Char) -> Text -> Char
1037foldl1' :: (Char -> Char -> Char) -> Text -> Char
1038+foldl1' = coerce JSS.foldl1'
874−foldl1' f t = S.foldl1' f (stream t)
1039+-- foldl1' f t = S.foldl1' f (stream t)
875{-# INLINE foldl1' #-}
1040{-# INLINE foldl1' #-}
876
1041
877-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
1042-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
@@ -879,14 +1044,16 @@ foldl1' f t = S.foldl1' f (stream t)
879-- reduces the 'Text' using the binary operator, from right to left.
1044-- reduces the 'Text' using the binary operator, from right to left.
880-- Subject to fusion.
1045-- Subject to fusion.
881foldr :: (Char -> a -> a) -> a -> Text -> a
1046foldr :: (Char -> a -> a) -> a -> Text -> a
1047+foldr f a0 (Text t) = JSS.foldr f a0 t
882−foldr f z t = S.foldr f z (stream t)
1048+-- foldr f z t = S.foldr f z (stream t)
883{-# INLINE foldr #-}
1049{-# INLINE foldr #-}
884
1050
885-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
1051-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
886-- and thus must be applied to a non-empty 'Text'. Subject to
1052-- and thus must be applied to a non-empty 'Text'. Subject to
887-- fusion.
1053-- fusion.
888foldr1 :: (Char -> Char -> Char) -> Text -> Char
1054foldr1 :: (Char -> Char -> Char) -> Text -> Char
1055+foldr1 = coerce JSS.foldr1
889−foldr1 f t = S.foldr1 f (stream t)
1056+-- foldr1 f t = S.foldr1 f (stream t)
890{-# INLINE foldr1 #-}
1057{-# INLINE foldr1 #-}
891
1058
892-- -----------------------------------------------------------------------------
1059-- -----------------------------------------------------------------------------
@@ -894,48 +1061,54 @@ foldr1 f t = S.foldr1 f (stream t)
894
1061
895-- | /O(n)/ Concatenate a list of 'Text's.
1062-- | /O(n)/ Concatenate a list of 'Text's.
896concat :: [Text] -> Text
1063concat :: [Text] -> Text
1064+concat = coerce JSS.concat
897−concat ts = case ts' of
1065+-- concat ts = case ts' of
898− [] -> empty
1066+-- [] -> empty
899− [t] -> t
1067+-- [t] -> t
900− _ -> Text (A.run go) 0 len
1068+-- _ -> Text (A.run go) 0 len
901− where
1069+-- where
902− ts' = L.filter (not . null) ts
1070+-- ts' = L.filter (not . null) ts
903− len = sumP "concat" $ L.map lengthWord16 ts'
1071+-- len = sumP "concat" $ L.map lengthWord16 ts'
904− go :: ST s (A.MArray s)
1072+-- go :: ST s (A.MArray s)
905− go = do
1073+-- go = do
906− arr <- A.new len
1074+-- arr <- A.new len
907− let step i (Text a o l) =
1075+-- let step i (Text a o l) =
908− let !j = i + l in A.copyI arr i a o j >> return j
1076+-- let !j = i + l in A.copyI arr i a o j >> return j
909− foldM step 0 ts' >> return arr
1077+-- foldM step 0 ts' >> return arr
910
1078
911-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
1079-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
912-- concatenate the results.
1080-- concatenate the results.
913concatMap :: (Char -> Text) -> Text -> Text
1081concatMap :: (Char -> Text) -> Text -> Text
1082+concatMap = coerce JSS.concatMap
914−concatMap f = concat . foldr ((:) . f) []
1083+-- concatMap f = concat . foldr ((:) . f) []
915{-# INLINE concatMap #-}
1084{-# INLINE concatMap #-}
916
1085
917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
1086-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
918-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
1087-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
919any :: (Char -> Bool) -> Text -> Bool
1088any :: (Char -> Bool) -> Text -> Bool
1089+any = coerce JSS.any
920−any p t = S.any p (stream t)
1090+-- any p t = S.any p (stream t)
921{-# INLINE any #-}
1091{-# INLINE any #-}
922
1092
923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
1093-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
924-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
1094-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
925all :: (Char -> Bool) -> Text -> Bool
1095all :: (Char -> Bool) -> Text -> Bool
1096+all = coerce JSS.all
926−all p t = S.all p (stream t)
1097+-- all p t = S.all p (stream t)
927{-# INLINE all #-}
1098{-# INLINE all #-}
928
1099
929-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
1100-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
930-- must be non-empty. Subject to fusion.
1101-- must be non-empty. Subject to fusion.
931maximum :: Text -> Char
1102maximum :: Text -> Char
1103+maximum = coerce JSS.maximum
932−maximum t = S.maximum (stream t)
1104+-- maximum t = S.maximum (stream t)
933{-# INLINE maximum #-}
1105{-# INLINE maximum #-}
934
1106
935-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
1107-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
936-- must be non-empty. Subject to fusion.
1108-- must be non-empty. Subject to fusion.
937minimum :: Text -> Char
1109minimum :: Text -> Char
1110+minimum = coerce JSS.minimum
938−minimum t = S.minimum (stream t)
1111+-- minimum t = S.minimum (stream t)
939{-# INLINE minimum #-}
1112{-# INLINE minimum #-}
940
1113
941-- -----------------------------------------------------------------------------
1114-- -----------------------------------------------------------------------------
@@ -951,8 +1124,9 @@ minimum t = S.minimum (stream t)
951--
1124--
952-- > last (scanl f z xs) == foldl f z xs.
1125-- > last (scanl f z xs) == foldl f z xs.
953scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
1126scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
1127+scanl = coerce JSS.scanl
954−scanl f z t = unstream (S.scanl g z (stream t))
1128+-- scanl f z t = unstream (S.scanl g z (stream t))
955− where g a b = safe (f a b)
1129+-- where g a b = safe (f a b)
956{-# INLINE scanl #-}
1130{-# INLINE scanl #-}
957
1131
958-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
1132-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
@@ -961,8 +1135,9 @@ scanl f z t = unstream (S.scanl g z (stream t))
961--
1135--
962-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
1136-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
963scanl1 :: (Char -> Char -> Char) -> Text -> Text
1137scanl1 :: (Char -> Char -> Char) -> Text -> Text
1138+scanl1 = coerce JSS.scanl1
964−scanl1 f t | null t = empty
1139+-- scanl1 f t | null t = empty
965− | otherwise = scanl f (unsafeHead t) (unsafeTail t)
1140+-- | otherwise = scanl f (unsafeHead t) (unsafeTail t)
966{-# INLINE scanl1 #-}
1141{-# INLINE scanl1 #-}
967
1142
968-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
1143-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
@@ -970,16 +1145,18 @@ scanl1 f t | null t = empty
970--
1145--
971-- > scanr f v == reverse . scanl (flip f) v . reverse
1146-- > scanr f v == reverse . scanl (flip f) v . reverse
972scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
1147scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
1148+scanr = coerce JSS.scanr
973−scanr f z = S.reverse . S.reverseScanr g z . reverseStream
1149+-- scanr f z = S.reverse . S.reverseScanr g z . reverseStream
974− where g a b = safe (f a b)
1150+-- where g a b = safe (f a b)
975{-# INLINE scanr #-}
1151{-# INLINE scanr #-}
976
1152
977-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
1153-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
978-- value argument. Subject to fusion. Performs replacement on
1154-- value argument. Subject to fusion. Performs replacement on
979-- invalid scalar values.
1155-- invalid scalar values.
980scanr1 :: (Char -> Char -> Char) -> Text -> Text
1156scanr1 :: (Char -> Char -> Char) -> Text -> Text
1157+scanr1 = coerce JSS.scanr1
981−scanr1 f t | null t = empty
1158+-- scanr1 f t | null t = empty
982− | otherwise = scanr f (last t) (init t)
1159+-- | otherwise = scanr f (last t) (init t)
983{-# INLINE scanr1 #-}
1160{-# INLINE scanr1 #-}
984
1161
985-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
1162-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
@@ -987,8 +1164,11 @@ scanr1 f t | null t = empty
987-- parameter from left to right, and returns a final 'Text'. Performs
1164-- parameter from left to right, and returns a final 'Text'. Performs
988-- replacement on invalid scalar values.
1165-- replacement on invalid scalar values.
989mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1166mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1167+mapAccumL f z0 (Text a) =
1168+ let (a', t) = JSS.mapAccumL f z0 a
1169+ in (a', Text t)
990−mapAccumL f z0 = S.mapAccumL g z0 . stream
1170+-- mapAccumL f z0 = S.mapAccumL g z0 . stream
991− where g a b = second safe (f a b)
1171+-- where g a b = second safe (f a b)
992{-# INLINE mapAccumL #-}
1172{-# INLINE mapAccumL #-}
993
1173
994-- | The 'mapAccumR' function behaves like a combination of 'map' and
1174-- | The 'mapAccumR' function behaves like a combination of 'map' and
@@ -998,8 +1178,11 @@ mapAccumL f z0 = S.mapAccumL g z0 . stream
998-- 'Text'.
1178-- 'Text'.
999-- Performs replacement on invalid scalar values.
1179-- Performs replacement on invalid scalar values.
1000mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1180mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1181+mapAccumR f z0 (Text a) =
1182+ let (a', t) = JSS.mapAccumR f z0 a
1183+ in (a', Text t)
1001−mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1184+-- mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1002− where g a b = second safe (f a b)
1185+-- where g a b = second safe (f a b)
1003{-# INLINE mapAccumR #-}
1186{-# INLINE mapAccumR #-}
1004
1187
1005-- -----------------------------------------------------------------------------
1188-- -----------------------------------------------------------------------------
@@ -1008,20 +1191,21 @@ mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1008-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
1191-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
1009-- @t@ repeated @n@ times.
1192-- @t@ repeated @n@ times.
1010replicate :: Int -> Text -> Text
1193replicate :: Int -> Text -> Text
1194+replicate = coerce JSS.replicate
1011−replicate n t@(Text a o l)
1195+-- replicate n t@(Text a o l)
1012− | n <= 0 || l <= 0 = empty
1196+-- | n <= 0 || l <= 0 = empty
1013− | n == 1 = t
1197+-- | n == 1 = t
1014− | isSingleton t = replicateChar n (unsafeHead t)
1198+-- | isSingleton t = replicateChar n (unsafeHead t)
1015− | otherwise = Text (A.run x) 0 len
1199+-- | otherwise = Text (A.run x) 0 len
1016− where
1200+-- where
1017− len = l `mul` n
1201+-- len = l `mul` n
1018− x :: ST s (A.MArray s)
1202+-- x :: ST s (A.MArray s)
1019− x = do
1203+-- x = do
1020− arr <- A.new len
1204+-- arr <- A.new len
1021− let loop !d !i | i >= n = return arr
1205+-- let loop !d !i | i >= n = return arr
1022− | otherwise = let m = d + l
1206+-- | otherwise = let m = d + l
1023− in A.copyI arr d a o m >> loop m (i+1)
1207+-- in A.copyI arr d a o m >> loop m (i+1)
1024− loop 0 0
1208+-- loop 0 0
1025{-# INLINE [1] replicate #-}
1209{-# INLINE [1] replicate #-}
1026
1210
1027{-# RULES
1211{-# RULES
@@ -1032,8 +1216,19 @@ replicate n t@(Text a o l)
1032-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1216-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1033-- value of every element. Subject to fusion.
1217-- value of every element. Subject to fusion.
1034replicateChar :: Int -> Char -> Text
1218replicateChar :: Int -> Char -> Text
1219+#ifndef __GHCJS__
1035replicateChar n c = unstream (S.replicateCharI n (safe c))
1220replicateChar n c = unstream (S.replicateCharI n (safe c))
1036{-# INLINE replicateChar #-}
1221{-# INLINE replicateChar #-}
1222+#else
1223+replicateChar n c = Text $ js_replicateChar n c
1224+{-# INLINE [1] replicateChar #-}
1225+{-# RULES
1226+"JSSTRING replicateChar -> fused" [~1] forall n c.
1227+ replicateChar n c = unstream (S.replicateCharI n (safe c))
1228+"JSSTRING replicateChar -> unfused" [1] forall n c.
1229+ unstream (S.replicateCharI n (safe c)) = replicateChar n c
1230+ #-}
1231+#endif
1037
1232
1038-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
1233-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
1039-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
1234-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
@@ -1043,7 +1238,8 @@ replicateChar n c = unstream (S.replicateCharI n (safe c))
1043-- string, and @b@ is the seed value for further production. Subject
1238-- string, and @b@ is the seed value for further production. Subject
1044-- to fusion. Performs replacement on invalid scalar values.
1239-- to fusion. Performs replacement on invalid scalar values.
1045unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1240unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1241+unfoldr f a = Text $ JSS.unfoldr f a
1046−unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1242+-- unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1047{-# INLINE unfoldr #-}
1243{-# INLINE unfoldr #-}
1048
1244
1049-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
1245-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
@@ -1053,7 +1249,8 @@ unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1053-- correct, otherwise its performance is similar to 'unfoldr'. Subject
1249-- correct, otherwise its performance is similar to 'unfoldr'. Subject
1054-- to fusion. Performs replacement on invalid scalar values.
1250-- to fusion. Performs replacement on invalid scalar values.
1055unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
1251unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
1252+unfoldrN n f a0 = Text $ JSS.unfoldrN n f a0
1056−unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)
1253+-- unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)
1057{-# INLINE unfoldrN #-}
1254{-# INLINE unfoldrN #-}
1058
1255
1059-- -----------------------------------------------------------------------------
1256-- -----------------------------------------------------------------------------
@@ -1063,18 +1260,19 @@ unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)
1063-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than
1260-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than
1064-- the length of the Text. Subject to fusion.
1261-- the length of the Text. Subject to fusion.
1065take :: Int -> Text -> Text
1262take :: Int -> Text -> Text
1263+take = coerce JSS.take
1066−take n t@(Text arr off len)
1264+-- take n t@(Text arr off len)
1067− | n <= 0 = empty
1265+-- | n <= 0 = empty
1068− | n >= len = t
1266+-- | n >= len = t
1069− | otherwise = text arr off (iterN n t)
1267+-- | otherwise = text arr off (iterN n t)
1070{-# INLINE [1] take #-}
1268{-# INLINE [1] take #-}
1071
1269
1072−iterN :: Int -> Text -> Int
1270+-- iterN :: Int -> Text -> Int
1073−iterN n t@(Text _arr _off len) = loop 0 0
1271+-- iterN n t@(Text _arr _off len) = loop 0 0
1074− where loop !i !cnt
1272+-- where loop !i !cnt
1075− | i >= len || cnt >= n = i
1273+-- | i >= len || cnt >= n = i
1076− | otherwise = loop (i+d) (cnt+1)
1274+-- | otherwise = loop (i+d) (cnt+1)
1077− where d = iter_ t i
1275+-- where d = iter_ t i
1078
1276
1079{-# RULES
1277{-# RULES
1080"TEXT take -> fused" [~1] forall n t.
1278"TEXT take -> fused" [~1] forall n t.
@@ -1088,31 +1286,36 @@ iterN n t@(Text _arr _off len) = loop 0 0
1088--
1286--
1089-- Examples:
1287-- Examples:
1090--
1288--
1091−-- > takeEnd 3 "foobar" == "bar"
1289+-- >>> takeEnd 3 "foobar"
1290+-- "bar"
1291+--
1292+-- @since 1.1.1.0
1092takeEnd :: Int -> Text -> Text
1293takeEnd :: Int -> Text -> Text
1294+takeEnd = coerce JSS.takeEnd
1093−takeEnd n t@(Text arr off len)
1295+-- takeEnd n t@(Text arr off len)
1094− | n <= 0 = empty
1296+-- | n <= 0 = empty
1095− | n >= len = t
1297+-- | n >= len = t
1096− | otherwise = text arr (off+i) (len-i)
1298+-- | otherwise = text arr (off+i) (len-i)
1097− where i = iterNEnd n t
1299+-- where i = iterNEnd n t
1098−
1300+
1099−iterNEnd :: Int -> Text -> Int
1301+-- iterNEnd :: Int -> Text -> Int
1100−iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1302+-- iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1101− where loop i !m
1303+-- where loop i !m
1102− | i <= 0 = 0
1304+-- | i <= 0 = 0
1103− | m <= 1 = i
1305+-- | m <= 1 = i
1104− | otherwise = loop (i+d) (m-1)
1306+-- | otherwise = loop (i+d) (m-1)
1105− where d = reverseIter_ t i
1307+-- where d = reverseIter_ t i
1106
1308
1107-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1309-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1108-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1310-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1109-- is greater than the length of the 'Text'. Subject to fusion.
1311-- is greater than the length of the 'Text'. Subject to fusion.
1110drop :: Int -> Text -> Text
1312drop :: Int -> Text -> Text
1313+drop = coerce JSS.drop
1111−drop n t@(Text arr off len)
1314+-- drop n t@(Text arr off len)
1112− | n <= 0 = t
1315+-- | n <= 0 = t
1113− | n >= len = empty
1316+-- | n >= len = empty
1114− | otherwise = text arr (off+i) (len-i)
1317+-- | otherwise = text arr (off+i) (len-i)
1115− where i = iterN n t
1318+-- where i = iterN n t
1116{-# INLINE [1] drop #-}
1319{-# INLINE [1] drop #-}
1117
1320
1118{-# RULES
1321{-# RULES
@@ -1127,22 +1330,27 @@ drop n t@(Text arr off len)
1127--
1330--
1128-- Examples:
1331-- Examples:
1129--
1332--
1130−-- > dropEnd 3 "foobar" == "foo"
1333+-- >>> dropEnd 3 "foobar"
1334+-- "foo"
1335+--
1336+-- @since 1.1.1.0
1131dropEnd :: Int -> Text -> Text
1337dropEnd :: Int -> Text -> Text
1338+dropEnd = coerce JSS.dropEnd
1132−dropEnd n t@(Text arr off len)
1339+-- dropEnd n t@(Text arr off len)
1133− | n <= 0 = t
1340+-- | n <= 0 = t
1134− | n >= len = empty
1341+-- | n >= len = empty
1135− | otherwise = text arr off (iterNEnd n t)
1342+-- | otherwise = text arr off (iterNEnd n t)
1136
1343
1137-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1344-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1138-- returns the longest prefix (possibly empty) of elements that
1345-- returns the longest prefix (possibly empty) of elements that
1139-- satisfy @p@. Subject to fusion.
1346-- satisfy @p@. Subject to fusion.
1140takeWhile :: (Char -> Bool) -> Text -> Text
1347takeWhile :: (Char -> Bool) -> Text -> Text
1348+takeWhile = coerce JSS.takeWhile
1141−takeWhile p t@(Text arr off len) = loop 0
1349+-- takeWhile p t@(Text arr off len) = loop 0
1142− where loop !i | i >= len = t
1350+-- where loop !i | i >= len = t
1143− | p c = loop (i+d)
1351+-- | p c = loop (i+d)
1144− | otherwise = text arr off i
1352+-- | otherwise = text arr off i
1145− where Iter c d = iter t i
1353+-- where Iter c d = iter t i
1146{-# INLINE [1] takeWhile #-}
1354{-# INLINE [1] takeWhile #-}
1147
1355
1148{-# RULES
1356{-# RULES
@@ -1157,13 +1365,25 @@ takeWhile p t@(Text arr off len) = loop 0
1157-- satisfy @p@. Subject to fusion.
1365-- satisfy @p@. Subject to fusion.
1158-- Examples:
1366-- Examples:
1159--
1367--
1160−-- > takeWhileEnd (=='o') "foo" == "oo"
1368+-- >>> takeWhileEnd (=='o') "foo"
1369+-- "oo"
1370+--
1371+-- @since 1.2.2.0
1161takeWhileEnd :: (Char -> Bool) -> Text -> Text
1372takeWhileEnd :: (Char -> Bool) -> Text -> Text
1373+#ifndef __GHCJS__
1162takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1374takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1163 where loop !i !l | l <= 0 = t
1375 where loop !i !l | l <= 0 = t
1164 | p c = loop (i+d) (l+d)
1376 | p c = loop (i+d) (l+d)
1165 | otherwise = text arr (off+l) (len-l)
1377 | otherwise = text arr (off+l) (len-l)
1166 where (c,d) = reverseIter t i
1378 where (c,d) = reverseIter t i
1379+#else
1380+takeWhileEnd p t@(Text jst) = loop (len-1) len
1381+ where loop !i !l | l <= 0 = t
1382+ | p c = loop (i+d) (l+d)
1383+ | otherwise = Text $ js_substr1 l jst
1384+ where (c,d) = reverseIter t i
1385+ len = length t
1386+#endif
1167{-# INLINE [1] takeWhileEnd #-}
1387{-# INLINE [1] takeWhileEnd #-}
1168
1388
1169{-# RULES
1389{-# RULES
@@ -1176,11 +1396,12 @@ takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1176-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1396-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1177-- 'takeWhile' @p@ @t@. Subject to fusion.
1397-- 'takeWhile' @p@ @t@. Subject to fusion.
1178dropWhile :: (Char -> Bool) -> Text -> Text
1398dropWhile :: (Char -> Bool) -> Text -> Text
1399+dropWhile = coerce JSS.dropWhile
1179−dropWhile p t@(Text arr off len) = loop 0 0
1400+-- dropWhile p t@(Text arr off len) = loop 0 0
1180− where loop !i !l | l >= len = empty
1401+-- where loop !i !l | l >= len = empty
1181− | p c = loop (i+d) (l+d)
1402+-- | p c = loop (i+d) (l+d)
1182− | otherwise = Text arr (off+i) (len-l)
1403+-- | otherwise = Text arr (off+i) (len-l)
1183− where Iter c d = iter t i
1404+
1184{-# INLINE [1] dropWhile #-}
1405{-# INLINE [1] dropWhile #-}
1185
1406
1186{-# RULES
1407{-# RULES
@@ -1196,13 +1417,15 @@ dropWhile p t@(Text arr off len) = loop 0 0
1196--
1417--
1197-- Examples:
1418-- Examples:
1198--
1419--
1199−-- > dropWhileEnd (=='.') "foo..." == "foo"
1420+-- >>> dropWhileEnd (=='.') "foo..."
1421+-- "foo"
1200dropWhileEnd :: (Char -> Bool) -> Text -> Text
1422dropWhileEnd :: (Char -> Bool) -> Text -> Text
1423+dropWhileEnd = coerce JSS.dropWhileEnd
1201−dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1424+-- dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1202− where loop !i !l | l <= 0 = empty
1425+-- where loop !i !l | l <= 0 = empty
1203− | p c = loop (i+d) (l+d)
1426+-- | p c = loop (i+d) (l+d)
1204− | otherwise = Text arr off l
1427+-- | otherwise = Text arr off l
1205− where (c,d) = reverseIter t i
1428+-- where (c,d) = reverseIter t i
1206{-# INLINE [1] dropWhileEnd #-}
1429{-# INLINE [1] dropWhileEnd #-}
1207
1430
1208{-# RULES
1431{-# RULES
@@ -1245,45 +1468,49 @@ strip = dropAround isSpace
1245-- prefix of @t@ of length @n@, and whose second is the remainder of
1468-- prefix of @t@ of length @n@, and whose second is the remainder of
1246-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
1469-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
1247splitAt :: Int -> Text -> (Text, Text)
1470splitAt :: Int -> Text -> (Text, Text)
1471+splitAt = coerce JSS.splitAt
1248−splitAt n t@(Text arr off len)
1472+-- splitAt n t@(Text arr off len)
1249− | n <= 0 = (empty, t)
1473+-- | n <= 0 = (empty, t)
1250− | n >= len = (t, empty)
1474+-- | n >= len = (t, empty)
1251− | otherwise = let k = iterN n t
1475+-- | otherwise = let k = iterN n t
1252− in (text arr off k, text arr (off+k) (len-k))
1476+-- in (text arr off k, text arr (off+k) (len-k))
1253
1477
1254-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1478-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1255-- a pair whose first element is the longest prefix (possibly empty)
1479-- a pair whose first element is the longest prefix (possibly empty)
1256-- of @t@ of elements that satisfy @p@, and whose second is the
1480-- of @t@ of elements that satisfy @p@, and whose second is the
1257-- remainder of the list.
1481-- remainder of the list.
1258span :: (Char -> Bool) -> Text -> (Text, Text)
1482span :: (Char -> Bool) -> Text -> (Text, Text)
1483+span = coerce JSS.span
1259−span p t = case span_ p t of
1484+-- span p t = case span_ p t of
1260− (# hd,tl #) -> (hd,tl)
1485+-- (# hd,tl #) -> (hd,tl)
1261{-# INLINE span #-}
1486{-# INLINE span #-}
1262
1487
1263-- | /O(n)/ 'break' is like 'span', but the prefix returned is
1488-- | /O(n)/ 'break' is like 'span', but the prefix returned is
1264-- over elements that fail the predicate @p@.
1489-- over elements that fail the predicate @p@.
1265break :: (Char -> Bool) -> Text -> (Text, Text)
1490break :: (Char -> Bool) -> Text -> (Text, Text)
1491+break = coerce JSS.break
1266−break p = span (not . p)
1492+-- break p = span (not . p)
1267{-# INLINE break #-}
1493{-# INLINE break #-}
1268
1494
1269-- | /O(n)/ Group characters in a string according to a predicate.
1495-- | /O(n)/ Group characters in a string according to a predicate.
1270groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
1496groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
1497+groupBy = coerce JSS.groupBy
1271−groupBy p = loop
1498+-- groupBy p = loop
1272− where
1499+-- where
1273− loop t@(Text arr off len)
1500+-- loop t@(Text arr off len)
1274− | null t = []
1501+-- | null t = []
1275− | otherwise = text arr off n : loop (text arr (off+n) (len-n))
1502+-- | otherwise = text arr off n : loop (text arr (off+n) (len-n))
1276− where Iter c d = iter t 0
1503+-- where Iter c d = iter t 0
1277− n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
1504+-- n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
1278
1505
1279-- | Returns the /array/ index (in units of 'Word16') at which a
1506-- | Returns the /array/ index (in units of 'Word16') at which a
1280-- character may be found. This is /not/ the same as the logical
1507-- character may be found. This is /not/ the same as the logical
1281-- index returned by e.g. 'findIndex'.
1508-- index returned by e.g. 'findIndex'.
1282−findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
1509+-- findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
1283−findAIndexOrEnd q t@(Text _arr _off len) = go 0
1510+-- findAIndexOrEnd q t@(Text _arr _off len) = go 0
1284− where go !i | i >= len || q c = i
1511+-- where go !i | i >= len || q c = i
1285− | otherwise = go (i+d)
1512+-- | otherwise = go (i+d)
1286− where Iter c d = iter t i
1513+-- where Iter c d = iter t i
1287
1514
1288-- | /O(n)/ Group characters in a string by equality.
1515-- | /O(n)/ Group characters in a string by equality.
1289group :: Text -> [Text]
1516group :: Text -> [Text]
@@ -1292,15 +1519,17 @@ group = groupBy (==)
1292-- | /O(n)/ Return all initial segments of the given 'Text', shortest
1519-- | /O(n)/ Return all initial segments of the given 'Text', shortest
1293-- first.
1520-- first.
1294inits :: Text -> [Text]
1521inits :: Text -> [Text]
1522+inits = coerce JSS.inits
1295−inits t@(Text arr off len) = loop 0
1523+-- inits t@(Text arr off len) = loop 0
1296− where loop i | i >= len = [t]
1524+-- where loop i | i >= len = [t]
1297− | otherwise = Text arr off i : loop (i + iter_ t i)
1525+-- | otherwise = Text arr off i : loop (i + iter_ t i)
1298
1526
1299-- | /O(n)/ Return all final segments of the given 'Text', longest
1527-- | /O(n)/ Return all final segments of the given 'Text', longest
1300-- first.
1528-- first.
1301tails :: Text -> [Text]
1529tails :: Text -> [Text]
1530+tails = coerce JSS.tails
1302−tails t | null t = [empty]
1531+-- tails t | null t = [empty]
1303− | otherwise = t : tails (unsafeTail t)
1532+-- | otherwise = t : tails (unsafeTail t)
1304
1533
1305-- $split
1534-- $split
1306--
1535--
@@ -1314,9 +1543,14 @@ tails t | null t = [empty]
1314--
1543--
1315-- Examples:
1544-- Examples:
1316--
1545--
1317−-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
1546+-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne"
1547+-- ["a","b","d","e"]
1548+--
1318−-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
1549+-- >>> splitOn "aaa" "aaaXaaaXaaaXaaa"
1550+-- ["","X","X","X",""]
1551+--
1319−-- > splitOn "x" "x" == ["",""]
1552+-- >>> splitOn "x" "x"
1553+-- ["",""]
1320--
1554--
1321-- and
1555-- and
1322--
1556--
@@ -1333,13 +1567,14 @@ splitOn :: Text
1333 -> Text
1567 -> Text
1334 -- ^ Input text.
1568 -- ^ Input text.
1335 -> [Text]
1569 -> [Text]
1570+splitOn = coerce JSS.splitOn
1336−splitOn pat@(Text _ _ l) src@(Text arr off len)
1571+-- splitOn pat@(Text _ _ l) src@(Text arr off len)
1337− | l <= 0 = emptyError "splitOn"
1572+-- | l <= 0 = emptyError "splitOn"
1338− | isSingleton pat = split (== unsafeHead pat) src
1573+-- | isSingleton pat = split (== unsafeHead pat) src
1339− | otherwise = go 0 (indices pat src)
1574+-- | otherwise = go 0 (indices pat src)
1340− where
1575+-- where
1341− go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1576+-- go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1342− go s _ = [text arr (s+off) (len-s)]
1577+-- go s _ = [text arr (s+off) (len-s)]
1343{-# INLINE [1] splitOn #-}
1578{-# INLINE [1] splitOn #-}
1344
1579
1345{-# RULES
1580{-# RULES
@@ -1352,28 +1587,36 @@ splitOn pat@(Text _ _ l) src@(Text arr off len)
1352-- resulting components do not contain the separators. Two adjacent
1587-- resulting components do not contain the separators. Two adjacent
1353-- separators result in an empty component in the output. eg.
1588-- separators result in an empty component in the output. eg.
1354--
1589--
1355−-- > split (=='a') "aabbaca" == ["","","bb","c",""]
1590+-- >>> split (=='a') "aabbaca"
1591+-- ["","","bb","c",""]
1592+--
1356−-- > split (=='a') "" == [""]
1593+-- >>> split (=='a') ""
1594+-- [""]
1357split :: (Char -> Bool) -> Text -> [Text]
1595split :: (Char -> Bool) -> Text -> [Text]
1596+split = coerce JSS.split
1358−split _ t@(Text _off _arr 0) = [t]
1597+-- split _ t@(Text _off _arr 0) = [t]
1359−split p t = loop t
1598+-- split p t = loop t
1360− where loop s | null s' = [l]
1599+-- where loop s | null s' = [l]
1361− | otherwise = l : loop (unsafeTail s')
1600+-- | otherwise = l : loop (unsafeTail s')
1362− where (# l, s' #) = span_ (not . p) s
1601+-- where (# l, s' #) = span_ (not . p) s
1363{-# INLINE split #-}
1602{-# INLINE split #-}
1364
1603
1365-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1604-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1366-- element may be shorter than the other chunks, depending on the
1605-- element may be shorter than the other chunks, depending on the
1367-- length of the input. Examples:
1606-- length of the input. Examples:
1368--
1607--
1369−-- > chunksOf 3 "foobarbaz" == ["foo","bar","baz"]
1608+-- >>> chunksOf 3 "foobarbaz"
1609+-- ["foo","bar","baz"]
1610+--
1370−-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]
1611+-- >>> chunksOf 4 "haskell.org"
1612+-- ["hask","ell.","org"]
1371chunksOf :: Int -> Text -> [Text]
1613chunksOf :: Int -> Text -> [Text]
1372−chunksOf k = go
1614+chunksOf = coerce JSS.chunksOf
1615+-- chunksOf k = go
1373− where
1616+-- where
1374− go t = case splitAt k t of
1617+-- go t = case splitAt k t of
1375− (a,b) | null a -> []
1618+-- (a,b) | null a -> []
1376− | otherwise -> a : go b
1619+-- | otherwise -> a : go b
1377{-# INLINE chunksOf #-}
1620{-# INLINE chunksOf #-}
1378
1621
1379-- ----------------------------------------------------------------------------
1622-- ----------------------------------------------------------------------------
@@ -1386,7 +1629,8 @@ chunksOf k = go
1386-- returns the first element matching the predicate, or 'Nothing' if
1629-- returns the first element matching the predicate, or 'Nothing' if
1387-- there is no such element.
1630-- there is no such element.
1388find :: (Char -> Bool) -> Text -> Maybe Char
1631find :: (Char -> Bool) -> Text -> Maybe Char
1632+find = coerce JSS.find
1389−find p t = S.findBy p (stream t)
1633+-- find p t = S.findBy p (stream t)
1390{-# INLINE find #-}
1634{-# INLINE find #-}
1391
1635
1392-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
1636-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
@@ -1395,14 +1639,16 @@ find p t = S.findBy p (stream t)
1395--
1639--
1396-- > partition p t == (filter p t, filter (not . p) t)
1640-- > partition p t == (filter p t, filter (not . p) t)
1397partition :: (Char -> Bool) -> Text -> (Text, Text)
1641partition :: (Char -> Bool) -> Text -> (Text, Text)
1642+partition = coerce JSS.partition
1398−partition p t = (filter p t, filter (not . p) t)
1643+-- partition p t = (filter p t, filter (not . p) t)
1399{-# INLINE partition #-}
1644{-# INLINE partition #-}
1400
1645
1401-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1646-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1402-- returns a 'Text' containing those characters that satisfy the
1647-- returns a 'Text' containing those characters that satisfy the
1403-- predicate.
1648-- predicate.
1404filter :: (Char -> Bool) -> Text -> Text
1649filter :: (Char -> Bool) -> Text -> Text
1650+filter = coerce JSS.filter
1405−filter p t = unstream (S.filter p (stream t))
1651+-- filter p t = unstream (S.filter p (stream t))
1406{-# INLINE filter #-}
1652{-# INLINE filter #-}
1407
1653
1408-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1654-- | /O(n+m)/ Find the first instance of @needle@ (which must be
@@ -1412,8 +1658,11 @@ filter p t = unstream (S.filter p (stream t))
1412--
1658--
1413-- Examples:
1659-- Examples:
1414--
1660--
1415−-- > breakOn "::" "a::b::c" ==> ("a", "::b::c")
1661+-- >>> breakOn "::" "a::b::c"
1662+-- ("a","::b::c")
1663+--
1416−-- > breakOn "/" "foobar" ==> ("foobar", "")
1664+-- >>> breakOn "/" "foobar"
1665+-- ("foobar","")
1417--
1666--
1418-- Laws:
1667-- Laws:
1419--
1668--
@@ -1427,11 +1676,12 @@ filter p t = unstream (S.filter p (stream t))
1427-- In (unlikely) bad cases, this function's time complexity degrades
1676-- In (unlikely) bad cases, this function's time complexity degrades
1428-- towards /O(n*m)/.
1677-- towards /O(n*m)/.
1429breakOn :: Text -> Text -> (Text, Text)
1678breakOn :: Text -> Text -> (Text, Text)
1679+breakOn = coerce JSS.breakOn
1430−breakOn pat src@(Text arr off len)
1680+-- breakOn pat src@(Text arr off len)
1431− | null pat = emptyError "breakOn"
1681+-- | null pat = emptyError "breakOn"
1432− | otherwise = case indices pat src of
1682+-- | otherwise = case indices pat src of
1433− [] -> (src, empty)
1683+-- [] -> (src, empty)
1434− (x:_) -> (text arr off x, text arr (off+x) (len-x))
1684+-- (x:_) -> (text arr off x, text arr (off+x) (len-x))
1435{-# INLINE breakOn #-}
1685{-# INLINE breakOn #-}
1436
1686
1437-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
1687-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
@@ -1441,10 +1691,12 @@ breakOn pat src@(Text arr off len)
1441-- up to and including the last match of @needle@. The second is the
1691-- up to and including the last match of @needle@. The second is the
1442-- remainder of @haystack@, following the match.
1692-- remainder of @haystack@, following the match.
1443--
1693--
1444−-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")
1694+-- >>> breakOnEnd "::" "a::b::c"
1695+-- ("a::b::","c")
1445breakOnEnd :: Text -> Text -> (Text, Text)
1696breakOnEnd :: Text -> Text -> (Text, Text)
1697+breakOnEnd = coerce JSS.breakOnEnd
1446−breakOnEnd pat src = (reverse b, reverse a)
1698+-- breakOnEnd pat src = (reverse b, reverse a)
1447− where (a,b) = breakOn (reverse pat) (reverse src)
1699+-- where (a,b) = breakOn (reverse pat) (reverse src)
1448{-# INLINE breakOnEnd #-}
1700{-# INLINE breakOnEnd #-}
1449
1701
1450-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
1702-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
@@ -1456,10 +1708,11 @@ breakOnEnd pat src = (reverse b, reverse a)
1456--
1708--
1457-- Examples:
1709-- Examples:
1458--
1710--
1459−-- > breakOnAll "::" ""
1711+-- >>> breakOnAll "::" ""
1460−-- > ==> []
1712+-- []
1713+--
1461−-- > breakOnAll "/" "a/b/c/"
1714+-- >>> breakOnAll "/" "a/b/c/"
1462−-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
1715+-- [("a","/b/c/"),("a/b","/c/"),("a/b/c","/")]
1463--
1716--
1464-- In (unlikely) bad cases, this function's time complexity degrades
1717-- In (unlikely) bad cases, this function's time complexity degrades
1465-- towards /O(n*m)/.
1718-- towards /O(n*m)/.
@@ -1468,12 +1721,13 @@ breakOnEnd pat src = (reverse b, reverse a)
1468breakOnAll :: Text -- ^ @needle@ to search for
1721breakOnAll :: Text -- ^ @needle@ to search for
1469 -> Text -- ^ @haystack@ in which to search
1722 -> Text -- ^ @haystack@ in which to search
1470 -> [(Text, Text)]
1723 -> [(Text, Text)]
1724+breakOnAll = coerce JSS.breakOnAll
1471−breakOnAll pat src@(Text arr off slen)
1725+-- breakOnAll pat src@(Text arr off slen)
1472− | null pat = emptyError "breakOnAll"
1726+-- | null pat = emptyError "breakOnAll"
1473− | otherwise = L.map step (indices pat src)
1727+-- | otherwise = L.map step (indices pat src)
1474− where
1728+-- where
1475− step x = (chunk 0 x, chunk x (slen-x))
1729+-- step x = (chunk 0 x, chunk x (slen-x))
1476− chunk !n !l = text arr (n+off) l
1730+-- chunk !n !l = text arr (n+off) l
1477{-# INLINE breakOnAll #-}
1731{-# INLINE breakOnAll #-}
1478
1732
1479-------------------------------------------------------------------------------
1733-------------------------------------------------------------------------------
@@ -1497,14 +1751,16 @@ breakOnAll pat src@(Text arr off slen)
1497
1751
1498-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1752-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1499index :: Text -> Int -> Char
1753index :: Text -> Int -> Char
1754+index = coerce JSS.index
1500−index t n = S.index (stream t) n
1755+-- index t n = S.index (stream t) n
1501{-# INLINE index #-}
1756{-# INLINE index #-}
1502
1757
1503-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
1758-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
1504-- and returns the index of the first element in the 'Text' satisfying
1759-- and returns the index of the first element in the 'Text' satisfying
1505-- the predicate. Subject to fusion.
1760-- the predicate. Subject to fusion.
1506findIndex :: (Char -> Bool) -> Text -> Maybe Int
1761findIndex :: (Char -> Bool) -> Text -> Maybe Int
1762+findIndex = coerce JSS.findIndex
1507−findIndex p t = S.findIndex p (stream t)
1763+-- findIndex p t = S.findIndex p (stream t)
1508{-# INLINE findIndex #-}
1764{-# INLINE findIndex #-}
1509
1765
1510-- | /O(n+m)/ The 'count' function returns the number of times the
1766-- | /O(n+m)/ The 'count' function returns the number of times the
@@ -1514,10 +1770,11 @@ findIndex p t = S.findIndex p (stream t)
1514-- In (unlikely) bad cases, this function's time complexity degrades
1770-- In (unlikely) bad cases, this function's time complexity degrades
1515-- towards /O(n*m)/.
1771-- towards /O(n*m)/.
1516count :: Text -> Text -> Int
1772count :: Text -> Text -> Int
1773+count = coerce JSS.count
1517−count pat src
1774+-- count pat src
1518− | null pat = emptyError "count"
1775+-- | null pat = emptyError "count"
1519− | isSingleton pat = countChar (unsafeHead pat) src
1776+-- | isSingleton pat = countChar (unsafeHead pat) src
1520− | otherwise = L.length (indices pat src)
1777+-- | otherwise = L.length (indices pat src)
1521{-# INLINE [1] count #-}
1778{-# INLINE [1] count #-}
1522
1779
1523{-# RULES
1780{-# RULES
@@ -1539,42 +1796,46 @@ countChar c t = S.countChar c (stream t)
1539-- excess elements of the longer 'Text' are discarded. This is
1796-- excess elements of the longer 'Text' are discarded. This is
1540-- equivalent to a pair of 'unpack' operations.
1797-- equivalent to a pair of 'unpack' operations.
1541zip :: Text -> Text -> [(Char,Char)]
1798zip :: Text -> Text -> [(Char,Char)]
1799+zip = coerce JSS.zip
1542−zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1800+-- zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1543{-# INLINE zip #-}
1801{-# INLINE zip #-}
1544
1802
1545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1803-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1546-- given as the first argument, instead of a tupling function.
1804-- given as the first argument, instead of a tupling function.
1547-- Performs replacement on invalid scalar values.
1805-- Performs replacement on invalid scalar values.
1548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1806zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1807+zipWith = coerce JSS.zipWith
1549−zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1808+-- zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1550− where g a b = safe (f a b)
1809+-- where g a b = safe (f a b)
1551{-# INLINE zipWith #-}
1810{-# INLINE zipWith #-}
1552
1811
1553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1812-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1554-- representing white space.
1813-- representing white space.
1555words :: Text -> [Text]
1814words :: Text -> [Text]
1815+words = coerce JSS.words
1556−words t@(Text arr off len) = loop 0 0
1816+-- words t@(Text arr off len) = loop 0 0
1557− where
1817+-- where
1558− loop !start !n
1818+-- loop !start !n
1559− | n >= len = if start == n
1819+-- | n >= len = if start == n
1560− then []
1820+-- then []
1561− else [Text arr (start+off) (n-start)]
1821+-- else [Text arr (start+off) (n-start)]
1562− | isSpace c =
1822+-- | isSpace c =
1563− if start == n
1823+-- if start == n
1564− then loop (start+1) (start+1)
1824+-- then loop (start+1) (start+1)
1565− else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1825+-- else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1566− | otherwise = loop start (n+d)
1826+-- | otherwise = loop start (n+d)
1567− where Iter c d = iter t n
1827+-- where Iter c d = iter t n
1568{-# INLINE words #-}
1828{-# INLINE words #-}
1569
1829
1570-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
1830-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
1571-- newline 'Char's. The resulting strings do not contain newlines.
1831-- newline 'Char's. The resulting strings do not contain newlines.
1572lines :: Text -> [Text]
1832lines :: Text -> [Text]
1833+lines = coerce JSS.lines
1573−lines ps | null ps = []
1834+-- lines ps | null ps = []
1574− | otherwise = h : if null t
1835+-- | otherwise = h : if null t
1575− then []
1836+-- then []
1576− else lines (unsafeTail t)
1837+-- else lines (unsafeTail t)
1577− where (# h,t #) = span_ (/= '\n') ps
1838+-- where (# h,t #) = span_ (/= '\n') ps
1578{-# INLINE lines #-}
1839{-# INLINE lines #-}
1579
1840
1580{-
1841{-
@@ -1602,34 +1863,40 @@ lines' ps | null ps = []
1602-- | /O(n)/ Joins lines, after appending a terminating newline to
1863-- | /O(n)/ Joins lines, after appending a terminating newline to
1603-- each.
1864-- each.
1604unlines :: [Text] -> Text
1865unlines :: [Text] -> Text
1866+unlines = coerce JSS.unlines
1605−unlines = concat . L.map (`snoc` '\n')
1867+-- unlines = concat . L.map (`snoc` '\n')
1606{-# INLINE unlines #-}
1868{-# INLINE unlines #-}
1607
1869
1608-- | /O(n)/ Joins words using single space characters.
1870-- | /O(n)/ Joins words using single space characters.
1609unwords :: [Text] -> Text
1871unwords :: [Text] -> Text
1872+unwords = coerce JSS.unwords
1610−unwords = intercalate (singleton ' ')
1873+-- unwords = intercalate (singleton ' ')
1611{-# INLINE unwords #-}
1874{-# INLINE unwords #-}
1612
1875
1613-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1876-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1614-- 'True' iff the first is a prefix of the second. Subject to fusion.
1877-- 'True' iff the first is a prefix of the second. Subject to fusion.
1615isPrefixOf :: Text -> Text -> Bool
1878isPrefixOf :: Text -> Text -> Bool
1879+isPrefixOf = coerce JSS.isPrefixOf
1616−isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1880+-- isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1617− alen <= blen && S.isPrefixOf (stream a) (stream b)
1881+-- alen <= blen && S.isPrefixOf (stream a) (stream b)
1618{-# INLINE [1] isPrefixOf #-}
1882{-# INLINE [1] isPrefixOf #-}
1619
1883
1620{-# RULES
1884{-# RULES
1621"TEXT isPrefixOf -> fused" [~1] forall s t.
1885"TEXT isPrefixOf -> fused" [~1] forall s t.
1622 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1886 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1887+"JSSTRING isPrefixOf -> unfused" [1] forall x y.
1888+ S.isPrefixOf (stream x) (stream y) = isPrefixOf x y
1623 #-}
1889 #-}
1624
1890
1625-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
1891-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
1626-- 'True' iff the first is a suffix of the second.
1892-- 'True' iff the first is a suffix of the second.
1627isSuffixOf :: Text -> Text -> Bool
1893isSuffixOf :: Text -> Text -> Bool
1894+isSuffixOf = coerce JSS.isSuffixOf
1628−isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1895+-- isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1629− d >= 0 && a == b'
1896+-- d >= 0 && a == b'
1630− where d = blen - alen
1897+-- where d = blen - alen
1631− b' | d == 0 = b
1898+-- b' | d == 0 = b
1632− | otherwise = Text barr (boff+d) alen
1899+-- | otherwise = Text barr (boff+d) alen
1633{-# INLINE isSuffixOf #-}
1900{-# INLINE isSuffixOf #-}
1634
1901
1635-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns
1902-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns
@@ -1639,10 +1906,11 @@ isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1639-- In (unlikely) bad cases, this function's time complexity degrades
1906-- In (unlikely) bad cases, this function's time complexity degrades
1640-- towards /O(n*m)/.
1907-- towards /O(n*m)/.
1641isInfixOf :: Text -> Text -> Bool
1908isInfixOf :: Text -> Text -> Bool
1909+isInfixOf = coerce JSS.isInfixOf
1642−isInfixOf needle haystack
1910+-- isInfixOf needle haystack
1643− | null needle = True
1911+-- | null needle = True
1644− | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack
1912+-- | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack
1645− | otherwise = not . L.null . indices needle $ haystack
1913+-- | otherwise = not . L.null . indices needle $ haystack
1646{-# INLINE [1] isInfixOf #-}
1914{-# INLINE [1] isInfixOf #-}
1647
1915
1648{-# RULES
1916{-# RULES
@@ -1658,9 +1926,14 @@ isInfixOf needle haystack
1658--
1926--
1659-- Examples:
1927-- Examples:
1660--
1928--
1661−-- > stripPrefix "foo" "foobar" == Just "bar"
1929+-- >>> stripPrefix "foo" "foobar"
1930+-- Just "bar"
1931+--
1662−-- > stripPrefix "" "baz" == Just "baz"
1932+-- >>> stripPrefix "" "baz"
1933+-- Just "baz"
1934+--
1663−-- > stripPrefix "foo" "quux" == Nothing
1935+-- >>> stripPrefix "foo" "quux"
1936+-- Nothing
1664--
1937--
1665-- This is particularly useful with the @ViewPatterns@ extension to
1938-- This is particularly useful with the @ViewPatterns@ extension to
1666-- GHC, as follows:
1939-- GHC, as follows:
@@ -1672,9 +1945,10 @@ isInfixOf needle haystack
1672-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
1945-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
1673-- > fnordLength _ = -1
1946-- > fnordLength _ = -1
1674stripPrefix :: Text -> Text -> Maybe Text
1947stripPrefix :: Text -> Text -> Maybe Text
1948+stripPrefix = coerce JSS.stripPrefix
1675−stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1949+-- stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1676− | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1950+-- | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1677− | otherwise = Nothing
1951+-- | otherwise = Nothing
1678
1952
1679-- | /O(n)/ Find the longest non-empty common prefix of two strings
1953-- | /O(n)/ Find the longest non-empty common prefix of two strings
1680-- and return it, along with the suffixes of each string at which they
1954-- and return it, along with the suffixes of each string at which they
@@ -1685,28 +1959,39 @@ stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1685--
1959--
1686-- Examples:
1960-- Examples:
1687--
1961--
1688−-- > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux")
1962+-- >>> commonPrefixes "foobar" "fooquux"
1963+-- Just ("foo","bar","quux")
1964+--
1689−-- > commonPrefixes "veeble" "fetzer" == Nothing
1965+-- >>> commonPrefixes "veeble" "fetzer"
1966+-- Nothing
1967+--
1690−-- > commonPrefixes "" "baz" == Nothing
1968+-- >>> commonPrefixes "" "baz"
1969+-- Nothing
1691commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1970commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1971+commonPrefixes = coerce JSS.commonPrefixes
1692−commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1972+-- commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1693− where
1973+-- where
1694− go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1974+-- go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1695− | i > 0 = Just (Text arr0 off0 i,
1975+-- | i > 0 = Just (Text arr0 off0 i,
1696− text arr0 (off0+i) (len0-i),
1976+-- text arr0 (off0+i) (len0-i),
1697− text arr1 (off1+j) (len1-j))
1977+-- text arr1 (off1+j) (len1-j))
1698− | otherwise = Nothing
1978+-- | otherwise = Nothing
1699− where Iter a d0 = iter t0 i
1979+-- where Iter a d0 = iter t0 i
1700− Iter b d1 = iter t1 j
1980+-- Iter b d1 = iter t1 j
1701
1981
1702-- | /O(n)/ Return the prefix of the second string if its suffix
1982-- | /O(n)/ Return the prefix of the second string if its suffix
1703-- matches the entire first string.
1983-- matches the entire first string.
1704--
1984--
1705-- Examples:
1985-- Examples:
1706--
1986--
1707−-- > stripSuffix "bar" "foobar" == Just "foo"
1987+-- >>> stripSuffix "bar" "foobar"
1988+-- Just "foo"
1989+--
1708−-- > stripSuffix "" "baz" == Just "baz"
1990+-- >>> stripSuffix "" "baz"
1991+-- Just "baz"
1992+--
1709−-- > stripSuffix "foo" "quux" == Nothing
1993+-- >>> stripSuffix "foo" "quux"
1994+-- Nothing
1710--
1995--
1711-- This is particularly useful with the @ViewPatterns@ extension to
1996-- This is particularly useful with the @ViewPatterns@ extension to
1712-- GHC, as follows:
1997-- GHC, as follows:
@@ -1718,21 +2003,22 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1718-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
2003-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
1719-- > quuxLength _ = -1
2004-- > quuxLength _ = -1
1720stripSuffix :: Text -> Text -> Maybe Text
2005stripSuffix :: Text -> Text -> Maybe Text
2006+stripSuffix = coerce JSS.stripSuffix
1721−stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
2007+-- stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1722− | p `isSuffixOf` t = Just $! text arr off (len-plen)
2008+-- | p `isSuffixOf` t = Just $! text arr off (len-plen)
1723− | otherwise = Nothing
2009+-- | otherwise = Nothing
1724−
2010+
1725−-- | Add a list of non-negative numbers. Errors out on overflow.
2011+-- -- | Add a list of non-negative numbers. Errors out on overflow.
1726−sumP :: String -> [Int] -> Int
2012+-- sumP :: String -> [Int] -> Int
1727−sumP fun = go 0
2013+-- sumP fun = go 0
1728− where go !a (x:xs)
2014+-- where go !a (x:xs)
1729− | ax >= 0 = go ax xs
2015+-- | ax >= 0 = go ax xs
1730− | otherwise = overflowError fun
2016+-- | otherwise = overflowError fun
1731− where ax = a + x
2017+-- where ax = a + x
1732− go a _ = a
2018+-- go a _ = a
1733−
2019+
1734−emptyError :: String -> a
2020+-- emptyError :: String -> a
1735−emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
2021+-- emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
1736
2022
1737overflowError :: String -> a
2023overflowError :: String -> a
1738overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
2024overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
@@ -1746,10 +2032,22 @@ overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
1746-- copy \"breaks the link\" to the original array, allowing it to be
2032-- copy \"breaks the link\" to the original array, allowing it to be
1747-- garbage collected if there are no other live references to it.
2033-- garbage collected if there are no other live references to it.
1748copy :: Text -> Text
2034copy :: Text -> Text
2035+copy = P.id -- TODO
1749−copy (Text arr off len) = Text (A.run go) 0 len
2036+-- copy (Text arr off len) = Text (A.run go) 0 len
1750− where
2037+-- where
1751− go :: ST s (A.MArray s)
2038+-- go :: ST s (A.MArray s)
1752− go = do
2039+-- go = do
1753− marr <- A.new len
2040+-- marr <- A.new len
1754− A.copyI marr 0 arr off len
2041+
1755− return marr
2042+foreign import javascript unsafe
2043+ "h$jsstringReplicateChar" js_replicateChar :: Int -> Char -> JSString
2044+foreign import javascript unsafe
2045+ "$2.substr($1)" js_substr1 :: Int -> JSString -> JSString
2046+
2047+-------------------------------------------------
2048+-- NOTE: the named chunk below used by doctest;
2049+-- verify the doctests via `doctest -fobject-code Data/Text.hs`
2050+
2051+-- $setup
2052+-- >>> :set -XOverloadedStrings
2053+-- >>> import qualified Data.Text as T
Data/Text/Array.hs+4−1
@@ -7,7 +7,6 @@
7--
7--
8-- License : BSD-style
8-- License : BSD-style
9-- Maintainer : bos@serpentine.com
9-- Maintainer : bos@serpentine.com
10−-- Stability : experimental
11-- Portability : portable
10-- Portability : portable
12--
11--
13-- Packed, unboxed, heap-resident arrays. Suitable for performance
12-- Packed, unboxed, heap-resident arrays. Suitable for performance
@@ -80,6 +79,8 @@ import GHC.Word (Word16(..))
80import Prelude hiding (length, read)
79import Prelude hiding (length, read)
81
80
82-- | Immutable array type.
81-- | Immutable array type.
82+--
83+-- The 'Array' constructor is exposed since @text-1.1.1.3@
83data Array = Array {
84data Array = Array {
84 aBA :: ByteArray#
85 aBA :: ByteArray#
85#if defined(ASSERTS)
86#if defined(ASSERTS)
@@ -88,6 +89,8 @@ data Array = Array {
88 }
89 }
89
90
90-- | Mutable array type, for use in the ST monad.
91-- | Mutable array type, for use in the ST monad.
92+--
93+-- The 'MArray' constructor is exposed since @text-1.1.1.3@
91data MArray s = MArray {
94data MArray s = MArray {
92 maBA :: MutableByteArray# s
95 maBA :: MutableByteArray# s
93#if defined(ASSERTS)
96#if defined(ASSERTS)
Data/Text/Encoding.hs+95−11
@@ -3,6 +3,7 @@
3#if __GLASGOW_HASKELL__ >= 702
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
4{-# LANGUAGE Trustworthy #-}
5#endif
5#endif
6+{-# LANGUAGE UnboxedTuples #-}
6-- |
7-- |
7-- Module : Data.Text.Encoding
8-- Module : Data.Text.Encoding
8-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
9-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
@@ -11,14 +12,13 @@
11--
12--
12-- License : BSD-style
13-- License : BSD-style
13-- Maintainer : bos@serpentine.com
14-- Maintainer : bos@serpentine.com
14−-- Stability : experimental
15-- Portability : portable
15-- Portability : portable
16--
16--
17-- Functions for converting 'Text' values to and from 'ByteString',
17-- Functions for converting 'Text' values to and from 'ByteString',
18-- using several standard encodings.
18-- using several standard encodings.
19--
19--
20-- To gain access to a much larger family of encodings, use the
20-- To gain access to a much larger family of encodings, use the
21−-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
21+-- <http://hackage.haskell.org/package/text-icu text-icu package>.
22
22
23module Data.Text.Encoding
23module Data.Text.Encoding
24 (
24 (
@@ -66,7 +66,7 @@ import Control.Monad.ST.Unsafe (unsafeIOToST, unsafeSTToIO)
66import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
66import Control.Monad.ST (unsafeIOToST, unsafeSTToIO)
67#endif
67#endif
68
68
69−import Control.Exception (evaluate, try)
69+import Control.Exception (evaluate, try, throwIO, ErrorCall(ErrorCall))
70import Control.Monad.ST (runST)
70import Control.Monad.ST (runST)
71import Data.Bits ((.&.))
71import Data.Bits ((.&.))
72import Data.ByteString as B
72import Data.ByteString as B
@@ -76,10 +76,16 @@ import Data.Text.Internal (Text(..), safe, text)
76import Data.Text.Internal.Private (runText)
76import Data.Text.Internal.Private (runText)
77import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
77import Data.Text.Internal.Unsafe.Char (ord, unsafeWrite)
78import Data.Text.Internal.Unsafe.Shift (shiftR)
78import Data.Text.Internal.Unsafe.Shift (shiftR)
79+#ifndef __GHCJS__
79import Data.Text.Show ()
80import Data.Text.Show ()
81+#endif
80import Data.Text.Unsafe (unsafeDupablePerformIO)
82import Data.Text.Unsafe (unsafeDupablePerformIO)
81import Data.Word (Word8, Word32)
83import Data.Word (Word8, Word32)
84+#if __GLASGOW_HASKELL__ >= 703
82−import Foreign.C.Types (CSize(..))
85+import Foreign.C.Types (CSize(CSize))
86+#else
87+import Foreign.C.Types (CSize)
88+#endif
83import Foreign.ForeignPtr (withForeignPtr)
89import Foreign.ForeignPtr (withForeignPtr)
84import Foreign.Marshal.Utils (with)
90import Foreign.Marshal.Utils (with)
85import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
91import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
@@ -95,6 +101,12 @@ import qualified Data.Text.Internal.Encoding.Utf16 as U16
95import qualified Data.Text.Internal.Fusion as F
101import qualified Data.Text.Internal.Fusion as F
96
102
97#include "text_cbits.h"
103#include "text_cbits.h"
104+#ifdef __GHCJS__
105+import GHC.Exts (Int(..), Int#)
106+import Data.ByteString (ByteString)
107+import GHCJS.Buffer
108+import Data.JSString (JSString)
109+#endif
98
110
99-- $strict
111-- $strict
100--
112--
@@ -128,6 +140,13 @@ decodeLatin1 (PS fp off len) = text a 0 len
128 return dest
140 return dest
129
141
130-- | Decode a 'ByteString' containing UTF-8 encoded text.
142-- | Decode a 'ByteString' containing UTF-8 encoded text.
143+--
144+-- __NOTE__: The replacement character returned by 'OnDecodeError'
145+-- MUST be within the BMP plane; surrogate code points will
146+-- automatically be remapped to the replacement char @U+FFFD@
147+-- (/since 0.11.3.0/), whereas code points beyond the BMP will throw an
148+-- 'error' (/since 1.2.3.1/); For earlier versions of @text@ using
149+-- those unsupported code points would result in undefined behavior.
131decodeUtf8With :: OnDecodeError -> ByteString -> Text
150decodeUtf8With :: OnDecodeError -> ByteString -> Text
132decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
151decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
133 let go dest = withForeignPtr fp $ \ptr ->
152 let go dest = withForeignPtr fp $ \ptr ->
@@ -143,16 +162,52 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
143 x <- peek curPtr'
162 x <- peek curPtr'
144 case onErr desc (Just x) of
163 case onErr desc (Just x) of
145 Nothing -> loop $ curPtr' `plusPtr` 1
164 Nothing -> loop $ curPtr' `plusPtr` 1
146− Just c -> do
165+ Just c
166+ | c > '\xFFFF' -> throwUnsupportedReplChar
167+ | otherwise -> do
147− destOff <- peek destOffPtr
168+ destOff <- peek destOffPtr
148− w <- unsafeSTToIO $
169+ w <- unsafeSTToIO $
149− unsafeWrite dest (fromIntegral destOff) (safe c)
170+ unsafeWrite dest (fromIntegral destOff)
171+ (safe c)
150− poke destOffPtr (destOff + fromIntegral w)
172+ poke destOffPtr (destOff + fromIntegral w)
151− loop $ curPtr' `plusPtr` 1
173+ loop $ curPtr' `plusPtr` 1
152 loop (ptr `plusPtr` off)
174 loop (ptr `plusPtr` off)
153 (unsafeIOToST . go) =<< A.new len
175 (unsafeIOToST . go) =<< A.new len
154 where
176 where
155 desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
177 desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
178+
179+ throwUnsupportedReplChar = throwIO $
180+ ErrorCall "decodeUtf8With: non-BMP replacement characters not supported"
181+ -- TODO: The code currently assumes that the transcoded UTF-16
182+ -- stream is at most twice as long (in bytes) as the input UTF-8
183+ -- stream. To justify this assumption one has to assume that the
184+ -- error handler replacement character also satisfies this
185+ -- invariant, by emitting at most one UTF16 code unit.
186+ --
187+ -- One easy way to support the full range of code-points for
188+ -- replacement characters in the error handler is to simply change
189+ -- the (over-)allocation to `A.new (2*len)` and then shrink back the
190+ -- `ByteArray#` to the real size (recent GHCs have a cheap
191+ -- `ByteArray#` resize-primop for that which allow the GC to reclaim
192+ -- the overallocation). However, this would require 4 times as much
193+ -- (temporary) storage as the original UTF-8 required.
194+ --
195+ -- Another strategy would be to optimistically assume that
196+ -- replacement characters are within the BMP, and if the case of a
197+ -- non-BMP replacement occurs reallocate the target buffer (or throw
198+ -- an exception, and fallback to a pessimistic codepath, like e.g.
199+ -- `decodeUtf8With onErr bs = F.unstream (E.streamUtf8 onErr bs)`)
200+ --
201+ -- Alternatively, `OnDecodeError` could become a datastructure which
202+ -- statically encodes the replacement-character range,
203+ -- e.g. something isomorphic to
204+ --
205+ -- Either (... -> Maybe Word16) (... -> Maybe Char)
206+ --
207+ -- And allow to statically switch between the BMP/non-BMP
208+ -- replacement-character codepaths. There's multiple ways to address
209+ -- this with different tradeoffs; but ideally we should optimise for
210+ -- the optimistic/error-free case.
156{- INLINE[0] decodeUtf8With #-}
211{- INLINE[0] decodeUtf8With #-}
157
212
158-- $stream
213-- $stream
@@ -209,6 +264,8 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
209-- or continuation where it is encountered.
264-- or continuation where it is encountered.
210
265
211-- | A stream oriented decoding result.
266-- | A stream oriented decoding result.
267+--
268+-- @since 1.0.0.0
212data Decoding = Some Text ByteString (ByteString -> Decoding)
269data Decoding = Some Text ByteString (ByteString -> Decoding)
213
270
214instance Show Decoding where
271instance Show Decoding where
@@ -228,11 +285,15 @@ newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
228-- thrown (either by this function or a continuation) that cannot be
285-- thrown (either by this function or a continuation) that cannot be
229-- caught in pure code. For more control over the handling of invalid
286-- caught in pure code. For more control over the handling of invalid
230-- data, use 'streamDecodeUtf8With'.
287-- data, use 'streamDecodeUtf8With'.
288+--
289+-- @since 1.0.0.0
231streamDecodeUtf8 :: ByteString -> Decoding
290streamDecodeUtf8 :: ByteString -> Decoding
232streamDecodeUtf8 = streamDecodeUtf8With strictDecode
291streamDecodeUtf8 = streamDecodeUtf8With strictDecode
233
292
234-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
293-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
235-- encoded text.
294-- encoded text.
295+--
296+-- @since 1.0.0.0
236streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
297streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
237streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
298streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
238 where
299 where
@@ -308,6 +369,8 @@ decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDec
308{-# INLINE decodeUtf8' #-}
369{-# INLINE decodeUtf8' #-}
309
370
310-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
371-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
372+--
373+-- @since 1.1.0.0
311encodeUtf8Builder :: Text -> B.Builder
374encodeUtf8Builder :: Text -> B.Builder
312encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
375encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
313
376
@@ -316,6 +379,8 @@ encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
316--
379--
317-- Use this function is to implement efficient encoders for text-based formats
380-- Use this function is to implement efficient encoders for text-based formats
318-- like JSON or HTML.
381-- like JSON or HTML.
382+--
383+-- @since 1.1.0.0
319{-# INLINE encodeUtf8BuilderEscaped #-}
384{-# INLINE encodeUtf8BuilderEscaped #-}
320-- TODO: Extend documentation with references to source code in @blaze-html@
385-- TODO: Extend documentation with references to source code in @blaze-html@
321-- or @aeson@ that uses this function.
386-- or @aeson@ that uses this function.
@@ -326,9 +391,18 @@ encodeUtf8BuilderEscaped be =
326 where
391 where
327 bound = max 4 $ BP.sizeBound be
392 bound = max 4 $ BP.sizeBound be
328
393
394+#ifndef __GHCJS__
329 mkBuildstep (Text arr off len) !k =
395 mkBuildstep (Text arr off len) !k =
396+#else
397+ mkBuildstep (Text t) !k =
398+#endif
330 outerLoop off
399 outerLoop off
331 where
400 where
401+#ifdef __GHCJS__
402+ off = 0
403+ (arr, len) = let (# ba, len' #) = js_fromString t
404+ in (A.Array ba, I# len')
405+#endif
332 iend = off + len
406 iend = off + len
333
407
334 outerLoop !i0 !br@(B.BufferRange op0 ope)
408 outerLoop !i0 !br@(B.BufferRange op0 ope)
@@ -370,10 +444,11 @@ encodeUtf8BuilderEscaped be =
370
444
371-- | Encode text using UTF-8 encoding.
445-- | Encode text using UTF-8 encoding.
372encodeUtf8 :: Text -> ByteString
446encodeUtf8 :: Text -> ByteString
447+#ifndef __GHCJS__
373encodeUtf8 (Text arr off len)
448encodeUtf8 (Text arr off len)
374 | len == 0 = B.empty
449 | len == 0 = B.empty
375 | otherwise = unsafeDupablePerformIO $ do
450 | otherwise = unsafeDupablePerformIO $ do
376− fp <- mallocByteString (len*4)
451+ fp <- mallocByteString (len*3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough
377 withForeignPtr fp $ \ptr ->
452 withForeignPtr fp $ \ptr ->
378 with ptr $ \destPtr -> do
453 with ptr $ \destPtr -> do
379 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
454 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
@@ -386,6 +461,10 @@ encodeUtf8 (Text arr off len)
386 withForeignPtr fp' $ \ptr' -> do
461 withForeignPtr fp' $ \ptr' -> do
387 memcpy ptr' ptr (fromIntegral utf8len)
462 memcpy ptr' ptr (fromIntegral utf8len)
388 return (PS fp' 0 utf8len)
463 return (PS fp' 0 utf8len)
464+#else
465+encodeUtf8 (Text txt) = toByteString 0 (Just (byteLength buf - 1)) buf
466+ where buf = js_encodeUtf8 txt
467+#endif
389
468
390-- | Decode text from little endian UTF-16 encoding.
469-- | Decode text from little endian UTF-16 encoding.
391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
470decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
@@ -475,5 +554,10 @@ foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_stat
475foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
554foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
476 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
555 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
477
556
557+#ifndef __GHCJS__
478foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
558foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
479 :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
559 :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
560+#else
561+foreign import javascript unsafe "h$textFromString" js_fromString :: JSString -> (# ByteArray#, Int# #)
562+foreign import javascript unsafe "h$encodeUtf8($1)" js_encodeUtf8 :: JSString -> Buffer
563+#endif
Data/Text/Encoding/Error.hs−1
@@ -10,7 +10,6 @@
10--
10--
11-- License : BSD-style
11-- License : BSD-style
12-- Maintainer : bos@serpentine.com
12-- Maintainer : bos@serpentine.com
13−-- Stability : experimental
14-- Portability : GHC
13-- Portability : GHC
15--
14--
16-- Types and functions for dealing with encoding and decoding errors
15-- Types and functions for dealing with encoding and decoding errors
Data/Text/Foreign.hs+5−2
@@ -5,7 +5,6 @@
5--
5--
6-- License : BSD-style
6-- License : BSD-style
7-- Maintainer : bos@serpentine.com
7-- Maintainer : bos@serpentine.com
8−-- Stability : experimental
9-- Portability : GHC
8-- Portability : GHC
10--
9--
11-- Support for using 'Text' data with native code via the Haskell
10-- Support for using 'Text' data with native code via the Haskell
@@ -108,7 +107,7 @@ takeWord16 (I16 n) t@(Text arr off len)
108 | n >= len || m >= len = t
107 | n >= len || m >= len = t
109 | otherwise = Text arr off m
108 | otherwise = Text arr off m
110 where
109 where
111− m | w < 0xDB00 || w > 0xD8FF = n
110+ m | w < 0xD800 || w > 0xDBFF = n
112 | otherwise = n+1
111 | otherwise = n+1
113 w = A.unsafeIndex arr (off+n-1)
112 w = A.unsafeIndex arr (off+n-1)
114
113
@@ -157,6 +156,8 @@ asForeignPtr t@(Text _arr _off len) = do
157-- | /O(n)/ Decode a C string with explicit length, which is assumed
156-- | /O(n)/ Decode a C string with explicit length, which is assumed
158-- to have been encoded as UTF-8. If decoding fails, a
157-- to have been encoded as UTF-8. If decoding fails, a
159-- 'UnicodeException' is thrown.
158-- 'UnicodeException' is thrown.
159+--
160+-- @since 1.0.0.0
160peekCStringLen :: CStringLen -> IO Text
161peekCStringLen :: CStringLen -> IO Text
161peekCStringLen cs = do
162peekCStringLen cs = do
162 bs <- unsafePackCStringLen cs
163 bs <- unsafePackCStringLen cs
@@ -169,5 +170,7 @@ peekCStringLen cs = do
169-- The temporary storage is freed when the subcomputation terminates
170-- The temporary storage is freed when the subcomputation terminates
170-- (either normally or via an exception), so the pointer to the
171-- (either normally or via an exception), so the pointer to the
171-- temporary storage must /not/ be used after this function returns.
172-- temporary storage must /not/ be used after this function returns.
173+--
174+-- @since 1.0.0.0
172withCStringLen :: Text -> (CStringLen -> IO a) -> IO a
175withCStringLen :: Text -> (CStringLen -> IO a) -> IO a
173withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act
176withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act
Data/Text/IO.hs+20−1
@@ -8,7 +8,6 @@
8-- (c) 2009 Simon Marlow
8-- (c) 2009 Simon Marlow
9-- License : BSD-style
9-- License : BSD-style
10-- Maintainer : bos@serpentine.com
10-- Maintainer : bos@serpentine.com
11−-- Stability : experimental
12-- Portability : GHC
11-- Portability : GHC
13--
12--
14-- Efficient locale-sensitive support for text I\/O.
13-- Efficient locale-sensitive support for text I\/O.
@@ -185,7 +184,11 @@ hPutStr h t = do
185 | otherwise -> writeBlocksRaw h buf str
184 | otherwise -> writeBlocksRaw h buf str
186
185
187hPutChars :: Handle -> Stream Char -> IO ()
186hPutChars :: Handle -> Stream Char -> IO ()
187+#ifndef __GHCJS__
188hPutChars h (Stream next0 s0 _len) = loop s0
188hPutChars h (Stream next0 s0 _len) = loop s0
189+#else
190+hPutChars h (Stream next0 s0) = loop s0
191+#endif
189 where
192 where
190 loop !s = case next0 s of
193 loop !s = case next0 s of
191 Done -> return ()
194 Done -> return ()
@@ -203,7 +206,11 @@ hPutChars h (Stream next0 s0 _len) = loop s0
203-- handling gave a few more percent on top.
206-- handling gave a few more percent on top.
204
207
205writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()
208writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()
209+#ifndef __GHCJS__
206writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0
210writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0
211+#else
212+writeLines h nl buf0 (Stream next0 s0) = outer s0 buf0
213+#endif
207 where
214 where
208 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
215 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
209 where
216 where
@@ -223,7 +230,11 @@ writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0
223 commit = commitBuffer h raw len
230 commit = commitBuffer h raw len
224
231
225writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
232writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
233+#ifndef __GHCJS__
226writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
234writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
235+#else
236+writeBlocksCRLF h buf0 (Stream next0 s0) = outer s0 buf0
237+#endif
227 where
238 where
228 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
239 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
229 where
240 where
@@ -239,7 +250,11 @@ writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
239 commit = commitBuffer h raw len
250 commit = commitBuffer h raw len
240
251
241writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
252writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
253+#ifndef __GHCJS__
242writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0
254writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0
255+#else
256+writeBlocksRaw h buf0 (Stream next0 s0) = outer s0 buf0
257+#endif
243 where
258 where
244 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
259 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
245 where
260 where
@@ -336,3 +351,7 @@ putStrLn = hPutStrLn stdout
336-- >
351-- >
337-- > putStr_Utf16LE :: Text -> IO ()
352-- > putStr_Utf16LE :: Text -> IO ()
338-- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)
353-- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)
354+--
355+-- On transcoding errors, an 'IOError' exception is thrown. You can
356+-- use the API in "Data.Text.Encoding" if you need more control over
357+-- error handling or transcoding.
Data/Text/Internal.hs+48−125
@@ -1,127 +1,67 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}
1+{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples, MagicHash,
2−{-# OPTIONS_HADDOCK not-home #-}
2+ BangPatterns, ForeignFunctionInterface, JavaScriptFFI, GeneralizedNewtypeDeriving #-}
3−
3+{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes,
4−-- |
4+ GHCForeignImportPrim, MagicHash, FlexibleInstances #-}
5−-- Module : Data.Text.Internal
6−-- Copyright : (c) 2008, 2009 Tom Harper,
7−-- (c) 2009, 2010 Bryan O'Sullivan,
8−-- (c) 2009 Duncan Coutts
9−--
10−-- License : BSD-style
11−-- Maintainer : bos@serpentine.com
12−-- Stability : experimental
13−-- Portability : GHC
14−--
15−-- A module containing private 'Text' internals. This exposes the
16−-- 'Text' representation and low level construction functions.
17−-- Modules which extend the 'Text' system may need to use this module.
18−--
19−-- You should not use this module unless you are determined to monkey
20−-- with the internals, as the functions here do just about nothing to
21−-- preserve data invariants. You have been warned!
22−
23−#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
24−#include "MachDeps.h"
25−#endif
26−
27module Data.Text.Internal
5module Data.Text.Internal
28− (
6+ ( module Data.Text.Internal
29− -- * Types
30− -- $internals
31− Text(..)
32− -- * Construction
33− , text
34− , textP
35− -- * Safety
36− , safe
7+ , JSS.safe
37− -- * Code that must be here for accessibility
38− , empty
39− , empty_
40− -- * Utilities
41− , firstf
8+ , JSS.firstf
42− -- * Checked multiplication
43− , mul
44− , mul32
45− , mul64
46− -- * Debugging
47− , showText
48− ) where
9+ ) where
10+
11+import Data.String (IsString(..))
12+import Data.Coerce
13+import Data.Data
14+import Data.Maybe
15+import Data.Binary
16+import Control.DeepSeq
17+import Data.Semigroup
18+import Data.Char
19+import qualified Data.JSString as JSS
20+import qualified Data.JSString.Internal as JSSS
21+import qualified Data.JSString.Internal.Type as JSS
22+import Data.JSString hiding (empty)
23+import qualified Data.Text.Array as A
49
24
50−#if defined(ASSERTS)
51−import Control.Exception (assert)
52−#endif
53import Data.Bits
25import Data.Bits
54import Data.Int (Int32, Int64)
26import Data.Int (Int32, Int64)
55−import Data.Text.Internal.Unsafe.Char (ord)
27+-- import Data.Text.Internal.Unsafe.Char (ord)
56import Data.Typeable (Typeable)
28import Data.Typeable (Typeable)
29+import GHC.Exts (ByteArray#, Char(..), ord#, andI#, (/=#), isTrue#, (==#), Int(..), Int#, isTrue#)
57−import qualified Data.Text.Array as A
30+-- import qualified Data.Text.Array as A
31+import GHCJS.Marshal.Pure
32+import GHCJS.Marshal
33+import qualified GHC.CString as GHC
58
34
59−-- | A space efficient, packed, unboxed Unicode text type.
60−data Text = Text
61− {-# UNPACK #-} !A.Array -- payload (Word16 elements)
62− {-# UNPACK #-} !Int -- offset (units of Word16, not Char)
63− {-# UNPACK #-} !Int -- length (units of Word16, not Char)
64− deriving (Typeable)
65
35
66−-- | Smart constructor.
36+newtype Text = Text JSString
67−text_ :: A.Array -> Int -> Int -> Text
37+ deriving (PToJSVal, PFromJSVal, FromJSVal, ToJSVal)
68−text_ arr off len =
38+
69−#if defined(ASSERTS)
39+instance Show Text where
70− let c = A.unsafeIndex arr off
40+ showsPrec p (Text jsstring) r = showsPrec p jsstring r
71− alen = A.length arr
72− in assert (len >= 0) .
73− assert (off >= 0) .
74− assert (alen == 0 || len == 0 || off < alen) .
75− assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
76−#endif
77− Text arr off len
78−{-# INLINE text_ #-}
79
41
80−-- | /O(1)/ The empty 'Text'.
81empty :: Text
42empty :: Text
82−empty = Text A.empty 0 0
43+empty = Text JSS.empty
83{-# INLINE [1] empty #-}
44{-# INLINE [1] empty #-}
84
45
85−-- | A non-inlined version of 'empty'.
86empty_ :: Text
46empty_ :: Text
87−empty_ = Text A.empty 0 0
47+empty_ = Text JSS.empty
88{-# NOINLINE empty_ #-}
48{-# NOINLINE empty_ #-}
89
49
50+foreign import javascript unsafe
51+ "String.fromCharCode.apply(null, $1['u8'])"
52+ js_decodeBytes :: ByteArray# -> JSString
53+
54+foreign import javascript unsafe
55+ "h$textToString"
56+ js_textToString :: ByteArray# -> Int# -> Int# -> JSString
57+
90-- | Construct a 'Text' without invisibly pinning its byte array in
58-- | Construct a 'Text' without invisibly pinning its byte array in
91-- memory if its length has dwindled to zero.
59-- memory if its length has dwindled to zero.
92text :: A.Array -> Int -> Int -> Text
60text :: A.Array -> Int -> Int -> Text
93−text arr off len | len == 0 = empty
61+-- text arr off len | len == 0 = empty
94− | otherwise = text_ arr off len
62+-- | otherwise = text_ arr off len
95−{-# INLINE text #-}
63+text (A.Array ba) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty
96−
64+ | otherwise = Text $ js_textToString ba off# len#
97−textP :: A.Array -> Int -> Int -> Text
98−{-# DEPRECATED textP "Use text instead" #-}
99−textP = text
100−
101−-- | A useful 'show'-like function for debugging purposes.
102−showText :: Text -> String
103−showText (Text arr off len) =
104− "Text " ++ show (A.toList arr off len) ++ ' ' :
105− show off ++ ' ' : show len
106−
107−-- | Map a 'Char' to a 'Text'-safe value.
108−--
109−-- UTF-16 surrogate code points are not included in the set of Unicode
110−-- scalar values, but are unfortunately admitted as valid 'Char'
111−-- values by Haskell. They cannot be represented in a 'Text'. This
112−-- function remaps those code points to the Unicode replacement
113−-- character (U+FFFD, \'&#xfffd;\'), and leaves other code points
114−-- unchanged.
115−safe :: Char -> Char
116−safe c
117− | ord c .&. 0x1ff800 /= 0xd800 = c
118− | otherwise = '\xfffd'
119−{-# INLINE [0] safe #-}
120−
121−-- | Apply a function to the first element of an optional pair.
122−firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
123−firstf f (Just (a, b)) = Just (f a, b)
124−firstf _ Nothing = Nothing
125
65
126-- | Checked multiplication. Calls 'error' if the result would
66-- | Checked multiplication. Calls 'error' if the result would
127-- overflow.
67-- overflow.
@@ -168,21 +108,4 @@ mul32 a b = case fromIntegral a * fromIntegral b of
168{-# INLINE mul32 #-}
108{-# INLINE mul32 #-}
169infixl 7 `mul32`
109infixl 7 `mul32`
170
110
171−-- $internals
111+--------------------------------------
172−--
173−-- Internally, the 'Text' type is represented as an array of 'Word16'
174−-- UTF-16 code units. The offset and length fields in the constructor
175−-- are in these units, /not/ units of 'Char'.
176−--
177−-- Invariants that all functions must maintain:
178−--
179−-- * Since the 'Text' type uses UTF-16 internally, it cannot represent
180−-- characters in the reserved surrogate code point range U+D800 to
181−-- U+DFFF. To maintain this invariant, the 'safe' function maps
182−-- 'Char' values in this range to the replacement character (U+FFFD,
183−-- \'&#xfffd;\').
184−--
185−-- * A leading (or \"high\") surrogate code unit (0xD800–0xDBFF) must
186−-- always be followed by a trailing (or \"low\") surrogate code unit
187−-- (0xDC00-0xDFFF). A trailing surrogate code unit must always be
188−-- preceded by a leading surrogate code unit.
Data/Text/Internal/Builder.hs+47−5
@@ -1,4 +1,6 @@
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2+{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, UnboxedTuples,
3+ MagicHash #-}
2{-# OPTIONS_HADDOCK not-home #-}
4{-# OPTIONS_HADDOCK not-home #-}
3
5
4-----------------------------------------------------------------------------
6-----------------------------------------------------------------------------
@@ -73,6 +75,8 @@ import qualified Data.Text as S
73import qualified Data.Text.Array as A
75import qualified Data.Text.Array as A
74import qualified Data.Text.Lazy as L
76import qualified Data.Text.Lazy as L
75
77
78+import Data.JSString (JSString)
79+import GHC.Exts (ByteArray#, Int#, Int(I#))
76------------------------------------------------------------------------
80------------------------------------------------------------------------
77
81
78-- | A @Builder@ is an efficient way to build lazy @Text@ values.
82-- | A @Builder@ is an efficient way to build lazy @Text@ values.
@@ -164,10 +168,17 @@ copyLimit = 128
164-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
168-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
165--
169--
166fromText :: S.Text -> Builder
170fromText :: S.Text -> Builder
167−fromText t@(Text arr off l)
171+fromText t@(Text t')
168 | S.null t = empty
172 | S.null t = empty
169 | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
173 | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
170 | otherwise = flush `append` mapBuilder (t :)
174 | otherwise = flush `append` mapBuilder (t :)
175+ where
176+ (# ba, len #) = js_fromString t'
177+ (arr, off, l) = (A.Array ba, 0, I# len)
178+-- fromText t@(Text arr off l)
179+-- | S.null t = empty
180+-- | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
181+-- | otherwise = flush `append` mapBuilder (t :)
171{-# INLINE [1] fromText #-}
182{-# INLINE [1] fromText #-}
172
183
173{-# RULES
184{-# RULES
@@ -182,10 +193,10 @@ fromText t@(Text arr off l)
182fromString :: String -> Builder
193fromString :: String -> Builder
183fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
194fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
184 let loop !marr !o !u !l [] = k (Buffer marr o u l)
195 let loop !marr !o !u !l [] = k (Buffer marr o u l)
185− loop marr o u l s@(c:cs)
196+ loop marr o@(I# o#) u@(I# u#) l s@(c:cs)
186 | l <= 1 = do
197 | l <= 1 = do
187 arr <- A.unsafeFreeze marr
198 arr <- A.unsafeFreeze marr
188− let !t = Text arr o u
199+ let !t = Text $ js_toString (A.aBA arr) o# u#
189 marr' <- A.new chunkSize
200 marr' <- A.new chunkSize
190 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
201 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
191 return $ t : ts
202 return $ t : ts
@@ -195,6 +206,21 @@ fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
195 in loop p0 o0 u0 l0 str
206 in loop p0 o0 u0 l0 str
196 where
207 where
197 chunkSize = smallChunkSize
208 chunkSize = smallChunkSize
209+-- fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
210+-- let loop !marr !o !u !l [] = k (Buffer marr o u l)
211+-- loop marr o u l s@(c:cs)
212+-- | l <= 1 = do
213+-- arr <- A.unsafeFreeze marr
214+-- let !t = Text arr o u
215+-- marr' <- A.new chunkSize
216+-- ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
217+-- return $ t : ts
218+-- | otherwise = do
219+-- n <- unsafeWrite marr (o+u) c
220+-- loop marr o (u+n) (l-n) cs
221+-- in loop p0 o0 u0 l0 str
222+-- where
223+-- chunkSize = smallChunkSize
198{-# INLINE fromString #-}
224{-# INLINE fromString #-}
199
225
200-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
226-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
@@ -234,16 +260,24 @@ toLazyTextWith chunkSize m = L.fromChunks (runST $
234-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
260-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
235-- yielding a new chunk in the result lazy @Text@.
261-- yielding a new chunk in the result lazy @Text@.
236flush :: Builder
262flush :: Builder
237−flush = Builder $ \ k buf@(Buffer p o u l) ->
263+flush = Builder $ \ k buf@(Buffer p o@(I# o#) u@(I# u#) l) ->
238 if u == 0
264 if u == 0
239 then k buf
265 then k buf
240 else do arr <- A.unsafeFreeze p
266 else do arr <- A.unsafeFreeze p
241 let !b = Buffer p (o+u) 0 l
267 let !b = Buffer p (o+u) 0 l
242− !t = Text arr o u
268+ !t = Text $ js_toString (A.aBA arr) o# u#
243 ts <- inlineInterleaveST (k b)
269 ts <- inlineInterleaveST (k b)
244 return $! t : ts
270 return $! t : ts
245{-# INLINE [1] flush #-}
271{-# INLINE [1] flush #-}
246-- defer inlining so that flush/flush rule may fire.
272-- defer inlining so that flush/flush rule may fire.
273+-- flush = Builder $ \ k buf@(Buffer p o u l) ->
274+-- if u == 0
275+-- then k buf
276+-- else do arr <- A.unsafeFreeze p
277+-- let !b = Buffer p (o+u) 0 l
278+-- !t = Text arr o u
279+-- ts <- inlineInterleaveST (k b)
280+-- return $! t : ts
247
281
248------------------------------------------------------------------------
282------------------------------------------------------------------------
249
283
@@ -327,3 +361,11 @@ append' (Builder f) (Builder g) = Builder (f . g)
327 append flush flush = flush
361 append flush flush = flush
328
362
329 #-}
363 #-}
364+
365+foreign import javascript unsafe
366+ "h$textFromString"
367+ js_fromString :: JSString -> (# ByteArray#, Int# #)
368+
369+foreign import javascript unsafe
370+ "h$textToString"
371+ js_toString :: ByteArray# -> Int# -> Int# -> JSString
Data/Text/Internal/Encoding/Fusion.hs+10−8
@@ -55,7 +55,7 @@ import qualified Data.Text.Internal.Encoding.Utf32 as U32
55import Data.Text.Unsafe (unsafeDupablePerformIO)
55import Data.Text.Unsafe (unsafeDupablePerformIO)
56
56
57streamASCII :: ByteString -> Stream Char
57streamASCII :: ByteString -> Stream Char
58−streamASCII bs = Stream next 0 (maxSize l)
58+streamASCII bs = Stream next 0 -- (maxSize l)
59 where
59 where
60 l = B.length bs
60 l = B.length bs
61 {-# INLINE next #-}
61 {-# INLINE next #-}
@@ -70,7 +70,7 @@ streamASCII bs = Stream next 0 (maxSize l)
70-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
70-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using UTF-8
71-- encoding.
71-- encoding.
72streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
72streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
73−streamUtf8 onErr bs = Stream next 0 (maxSize l)
73+streamUtf8 onErr bs = Stream next 0 -- (maxSize l)
74 where
74 where
75 l = B.length bs
75 l = B.length bs
76 next i
76 next i
@@ -91,7 +91,7 @@ streamUtf8 onErr bs = Stream next 0 (maxSize l)
91-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
91-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
92-- endian UTF-16 encoding.
92-- endian UTF-16 encoding.
93streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
93streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
94−streamUtf16LE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))
94+streamUtf16LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))
95 where
95 where
96 l = B.length bs
96 l = B.length bs
97 {-# INLINE next #-}
97 {-# INLINE next #-}
@@ -109,7 +109,7 @@ streamUtf16LE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))
109-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
109-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
110-- endian UTF-16 encoding.
110-- endian UTF-16 encoding.
111streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
111streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
112−streamUtf16BE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))
112+streamUtf16BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 1))
113 where
113 where
114 l = B.length bs
114 l = B.length bs
115 {-# INLINE next #-}
115 {-# INLINE next #-}
@@ -127,7 +127,7 @@ streamUtf16BE onErr bs = Stream next 0 (maxSize (l `shiftR` 1))
127-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
127-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
128-- endian UTF-32 encoding.
128-- endian UTF-32 encoding.
129streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
129streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
130−streamUtf32BE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
130+streamUtf32BE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))
131 where
131 where
132 l = B.length bs
132 l = B.length bs
133 {-# INLINE next #-}
133 {-# INLINE next #-}
@@ -147,7 +147,7 @@ streamUtf32BE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
148-- endian UTF-32 encoding.
148-- endian UTF-32 encoding.
149streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
149streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
150−streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
150+streamUtf32LE onErr bs = Stream next 0 -- (maxSize (l `shiftR` 2))
151 where
151 where
152 l = B.length bs
152 l = B.length bs
153 {-# INLINE next #-}
153 {-# INLINE next #-}
@@ -166,8 +166,10 @@ streamUtf32LE onErr bs = Stream next 0 (maxSize (l `shiftR` 2))
166
166
167-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
167-- | /O(n)/ Convert a 'Stream' 'Word8' to a 'ByteString'.
168unstream :: Stream Word8 -> ByteString
168unstream :: Stream Word8 -> ByteString
169−unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
169+-- unstream (Stream next s0 len) = unsafeDupablePerformIO $ do
170+unstream (Stream next s0) = unsafeDupablePerformIO $ do
170− let mlen = upperBound 4 len
171+ -- let mlen = upperBound 4 len
172+ let mlen = 4
171 mallocByteString mlen >>= loop mlen 0 s0
173 mallocByteString mlen >>= loop mlen 0 s0
172 where
174 where
173 loop !n !off !s fp = case next s of
175 loop !n !off !s fp = case next s of
Data/Text/Internal/Encoding/Fusion/Common.hs+8−4
@@ -37,7 +37,8 @@ import Data.Text.Internal.Unsafe.Shift (shiftR)
37import Data.Word (Word8)
37import Data.Word (Word8)
38
38
39restreamUtf16BE :: Stream Char -> Stream Word8
39restreamUtf16BE :: Stream Char -> Stream Word8
40−restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
40+-- restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
41+restreamUtf16BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
41 where
42 where
42 next (RS0 s) = case next0 s of
43 next (RS0 s) = case next0 s of
43 Done -> Done
44 Done -> Done
@@ -61,7 +62,8 @@ restreamUtf16BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
61{-# INLINE restreamUtf16BE #-}
62{-# INLINE restreamUtf16BE #-}
62
63
63restreamUtf16LE :: Stream Char -> Stream Word8
64restreamUtf16LE :: Stream Char -> Stream Word8
64−restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
65+-- restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
66+restreamUtf16LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
65 where
67 where
66 next (RS0 s) = case next0 s of
68 next (RS0 s) = case next0 s of
67 Done -> Done
69 Done -> Done
@@ -85,7 +87,8 @@ restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
85{-# INLINE restreamUtf16LE #-}
87{-# INLINE restreamUtf16LE #-}
86
88
87restreamUtf32BE :: Stream Char -> Stream Word8
89restreamUtf32BE :: Stream Char -> Stream Word8
88−restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
90+restreamUtf32BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
91+-- restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
89 where
92 where
90 next (RS0 s) = case next0 s of
93 next (RS0 s) = case next0 s of
91 Done -> Done
94 Done -> Done
@@ -104,7 +107,8 @@ restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
104{-# INLINE restreamUtf32BE #-}
107{-# INLINE restreamUtf32BE #-}
105
108
106restreamUtf32LE :: Stream Char -> Stream Word8
109restreamUtf32LE :: Stream Char -> Stream Word8
107−restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
110+restreamUtf32LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
111+-- restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
108 where
112 where
109 next (RS0 s) = case next0 s of
113 next (RS0 s) = case next0 s of
110 Done -> Done
114 Done -> Done
Data/Text/Internal/Fusion.hs+40−166
@@ -28,217 +28,91 @@ module Data.Text.Internal.Fusion
28 , unstream
28 , unstream
29 , reverseStream
29 , reverseStream
30
30
31− , length
31+ , Data.Text.Internal.Fusion.length
32
32
33 -- * Transformations
33 -- * Transformations
34− , reverse
34+ , Data.Text.Internal.Fusion.reverse
35
35
36 -- * Construction
36 -- * Construction
37 -- ** Scans
37 -- ** Scans
38 , reverseScanr
38 , reverseScanr
39
39
40 -- ** Accumulating maps
40 -- ** Accumulating maps
41− , mapAccumL
41+ , Data.Text.Internal.Fusion.mapAccumL
42
42
43 -- ** Generation and unfolding
43 -- ** Generation and unfolding
44 , unfoldrN
44 , unfoldrN
45
45
46 -- * Indexing
46 -- * Indexing
47− , index
47+ , Data.Text.Internal.Fusion.index
48− , findIndex
48+ , Data.Text.Internal.Fusion.findIndex
49 , countChar
49 , countChar
50 ) where
50 ) where
51
51
52−import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,
52+import GHC.Exts (Char(..), Int(..), chr#, Int#, isTrue#, (-#), (+#), (>=#))
53− Num(..), Ord(..), ($), (&&),
53+
54− fromIntegral, otherwise)
54+import Prelude hiding (length, reverse)
55−import Data.Bits ((.&.))
55+import Data.Char
56+
56−import Data.Text.Internal (Text(..))
57+import Data.JSString.Internal.Type (JSString(..))
57−import Data.Text.Internal.Private (runText)
58+import qualified Data.JSString.Internal.Type as I
58−import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)
59−import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
59+import Data.JSString.Internal.Fusion.Types
60−import qualified Data.Text.Array as A
61−import qualified Data.Text.Internal.Fusion.Common as S
60+import qualified Data.JSString.Internal.Fusion.Common as S
62−import Data.Text.Internal.Fusion.Types
61+
62+import System.IO.Unsafe
63+
64+import GHCJS.Prim
65+
66+import Data.Coerce
63−import Data.Text.Internal.Fusion.Size
67+import Data.Text.Internal
64−import qualified Data.Text.Internal as I
68+import qualified Data.JSString.Internal.Fusion as JSS
65−import qualified Data.Text.Internal.Encoding.Utf16 as U16
69+import Data.JSString.Internal.Fusion.Types (Stream(..))
66
70
67default(Int)
71default(Int)
68
72
69−-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
70stream :: Text -> Stream Char
73stream :: Text -> Stream Char
71−stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
74+stream = coerce JSS.stream
72− where
73− !end = off+len
74− next !i
75− | i >= end = Done
76− | n >= 0xD800 && n <= 0xDBFF = Yield (U16.chr2 n n2) (i + 2)
77− | otherwise = Yield (unsafeChr n) (i + 1)
78− where
79− n = A.unsafeIndex arr i
80− n2 = A.unsafeIndex arr (i + 1)
81{-# INLINE [0] stream #-}
75{-# INLINE [0] stream #-}
82
76
83−-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
84−-- backwards.
85reverseStream :: Text -> Stream Char
77reverseStream :: Text -> Stream Char
86−reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)
78+reverseStream = coerce JSS.reverseStream
87− where
88− {-# INLINE next #-}
89− next !i
90− | i < off = Done
91− | n >= 0xDC00 && n <= 0xDFFF = Yield (U16.chr2 n2 n) (i - 2)
92− | otherwise = Yield (unsafeChr n) (i - 1)
93− where
94− n = A.unsafeIndex arr i
95− n2 = A.unsafeIndex arr (i - 1)
96{-# INLINE [0] reverseStream #-}
79{-# INLINE [0] reverseStream #-}
97
80
98−-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
99unstream :: Stream Char -> Text
81unstream :: Stream Char -> Text
100−unstream (Stream next0 s0 len) = runText $ \done -> do
82+unstream = coerce JSS.unstream
101− -- Before encoding each char we perform a buffer realloc check assuming
102− -- worst case encoding size of two 16-bit units for the char. Just add an
103− -- extra space to the buffer so that we do not end up reallocating even when
104− -- all the chars are encoded as single unit.
105− let mlen = upperBound 4 len + 1
106− arr0 <- A.new mlen
107− let outer !arr !maxi = encode
108− where
109− -- keep the common case loop as small as possible
110− encode !si !di =
111− case next0 si of
112− Done -> done arr di
113− Skip si' -> encode si' di
114− Yield c si'
115− -- simply check for the worst case
116− | maxi < di + 1 -> realloc si di
117− | otherwise -> do
118− n <- unsafeWrite arr di c
119− encode si' (di + n)
120−
121− -- keep uncommon case separate from the common case code
122− {-# NOINLINE realloc #-}
123− realloc !si !di = do
124− let newlen = (maxi + 1) * 2
125− arr' <- A.new newlen
126− A.copyM arr' 0 arr 0 di
127− outer arr' (newlen - 1) si di
128−
129− outer arr0 (mlen - 1) s0 0
130{-# INLINE [0] unstream #-}
83{-# INLINE [0] unstream #-}
131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
84{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
132
85
133−
134−-- ----------------------------------------------------------------------------
135−-- * Basic stream functions
136−
137length :: Stream Char -> Int
86length :: Stream Char -> Int
138−length = S.lengthI
87+length = JSS.length
139−{-# INLINE[0] length #-}
88+{-# INLINE [0] length #-}
140
89
141−-- | /O(n)/ Reverse the characters of a string.
142reverse :: Stream Char -> Text
90reverse :: Stream Char -> Text
143−reverse (Stream next s len0)
91+reverse = coerce JSS.reverse
144− | isEmpty len0 = I.empty
145− | otherwise = I.text arr off' len'
146− where
147− len0' = upperBound 4 (larger len0 4)
148− (arr, (off', len')) = A.run2 (A.new len0' >>= loop s (len0'-1) len0')
149− loop !s0 !i !len marr =
150− case next s0 of
151− Done -> return (marr, (j, len-j))
152− where j = i + 1
153− Skip s1 -> loop s1 i len marr
154− Yield x s1 | i < least -> {-# SCC "reverse/resize" #-} do
155− let newLen = len `shiftL` 1
156− marr' <- A.new newLen
157− A.copyM marr' (newLen-len) marr 0 len
158− write s1 (len+i) newLen marr'
159− | otherwise -> write s1 i len marr
160− where n = ord x
161− least | n < 0x10000 = 0
162− | otherwise = 1
163− m = n - 0x10000
164− lo = fromIntegral $ (m `shiftR` 10) + 0xD800
165− hi = fromIntegral $ (m .&. 0x3FF) + 0xDC00
166− write t j l mar
167− | n < 0x10000 = do
168− A.unsafeWrite mar j (fromIntegral n)
169− loop t (j-1) l mar
170− | otherwise = do
171− A.unsafeWrite mar (j-1) lo
172− A.unsafeWrite mar j hi
173− loop t (j-2) l mar
174{-# INLINE [0] reverse #-}
92{-# INLINE [0] reverse #-}
175
93
176−-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
177−-- the input and result reversed.
178reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
94reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
179−reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
95+reverseScanr = JSS.reverseScanr
180− where
181− {-# INLINE next #-}
182− next (Scan1 z s) = Yield z (Scan2 z s)
183− next (Scan2 z s) = case next0 s of
184− Yield x s' -> let !x' = f x z
185− in Yield x' (Scan2 x' s')
186− Skip s' -> Skip (Scan2 z s')
187− Done -> Done
188{-# INLINE reverseScanr #-}
96{-# INLINE reverseScanr #-}
189
97
190−-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
98+mapAccumL :: (a -> Char -> (a, Char)) -> a -> Stream Char -> (a, Text)
191−-- value. However, the length of the result is limited by the
99+mapAccumL f z0 st =
192−-- first argument to 'unfoldrN'. This function is more efficient than
100+ let (a, t) = JSS.mapAccumL f z0 st
193−-- 'unfoldr' when the length of the result is known.
101+ in (a, Text t)
102+{-# INLINE [0] mapAccumL #-}
103+
194unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char
104unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char
195−unfoldrN n = S.unfoldrNI n
105+unfoldrN = JSS.unfoldrN
196{-# INLINE [0] unfoldrN #-}
106{-# INLINE [0] unfoldrN #-}
197
107
198−-------------------------------------------------------------------------------
199−-- ** Indexing streams
200−
201−-- | /O(n)/ stream index (subscript) operator, starting from 0.
202index :: Stream Char -> Int -> Char
108index :: Stream Char -> Int -> Char
203−index = S.indexI
109+index = JSS.index
204{-# INLINE [0] index #-}
110{-# INLINE [0] index #-}
205
111
206−-- | The 'findIndex' function takes a predicate and a stream and
207−-- returns the index of the first element in the stream
208−-- satisfying the predicate.
209findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
112findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
210−findIndex = S.findIndexI
113+findIndex = JSS.findIndex
211{-# INLINE [0] findIndex #-}
114{-# INLINE [0] findIndex #-}
212
115
213−-- | /O(n)/ The 'count' function returns the number of times the query
214−-- element appears in the given stream.
215countChar :: Char -> Stream Char -> Int
116countChar :: Char -> Stream Char -> Int
216−countChar = S.countCharI
117+countChar = JSS.countChar
217{-# INLINE [0] countChar #-}
118{-# INLINE [0] countChar #-}
218−
219−-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
220−-- function to each element of a 'Text', passing an accumulating
221−-- parameter from left to right, and returns a final 'Text'.
222−mapAccumL :: (a -> Char -> (a,Char)) -> a -> Stream Char -> (a, Text)
223−mapAccumL f z0 (Stream next0 s0 len) = (nz, I.text na 0 nl)
224− where
225− (na,(nz,nl)) = A.run2 (A.new mlen >>= \arr -> outer arr mlen z0 s0 0)
226− where mlen = upperBound 4 len
227− outer arr top = loop
228− where
229− loop !z !s !i =
230− case next0 s of
231− Done -> return (arr, (z,i))
232− Skip s' -> loop z s' i
233− Yield x s'
234− | j >= top -> {-# SCC "mapAccumL/resize" #-} do
235− let top' = (top + 1) `shiftL` 1
236− arr' <- A.new top'
237− A.copyM arr' 0 arr 0 top
238− outer arr' top' z s i
239− | otherwise -> do d <- unsafeWrite arr i c
240− loop z' s' (i+d)
241− where (z',c) = f z x
242− j | ord c < 0x10000 = i
243− | otherwise = i + 1
244−{-# INLINE [0] mapAccumL #-}
Data/Text/Internal/Fusion/CaseMapping.hs+164−4
@@ -1,10 +1,10 @@
1{-# LANGUAGE Rank2Types #-}
1{-# LANGUAGE Rank2Types #-}
2-- AUTOMATICALLY GENERATED - DO NOT EDIT
2-- AUTOMATICALLY GENERATED - DO NOT EDIT
3-- Generated by scripts/CaseMapping.hs
3-- Generated by scripts/CaseMapping.hs
4−-- CaseFolding-8.0.0.txt
4+-- CaseFolding-9.0.0.txt
5−-- Date: 2015-01-13, 18:16:36 GMT [MD]
5+-- Date: 2016-03-02, 18:54:54 GMT
6−-- SpecialCasing-8.0.0.txt
6+-- SpecialCasing-9.0.0.txt
7−-- Date: 2014-12-16, 23:08:04 GMT [MD]
7+-- Date: 2016-03-02, 18:55:13 GMT
8
8
9module Data.Text.Internal.Fusion.CaseMapping where
9module Data.Text.Internal.Fusion.CaseMapping where
10import Data.Char
10import Data.Char
@@ -371,6 +371,24 @@ foldMapping '\x13fb' s = Yield '\x13f3' (CC s '\x0000' '\x0000')
371foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')
371foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')
372-- CHEROKEE SMALL LETTER MV
372-- CHEROKEE SMALL LETTER MV
373foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')
373foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000')
374+-- CYRILLIC SMALL LETTER ROUNDED VE
375+foldMapping '\x1c80' s = Yield '\x0432' (CC s '\x0000' '\x0000')
376+-- CYRILLIC SMALL LETTER LONG-LEGGED DE
377+foldMapping '\x1c81' s = Yield '\x0434' (CC s '\x0000' '\x0000')
378+-- CYRILLIC SMALL LETTER NARROW O
379+foldMapping '\x1c82' s = Yield '\x043e' (CC s '\x0000' '\x0000')
380+-- CYRILLIC SMALL LETTER WIDE ES
381+foldMapping '\x1c83' s = Yield '\x0441' (CC s '\x0000' '\x0000')
382+-- CYRILLIC SMALL LETTER TALL TE
383+foldMapping '\x1c84' s = Yield '\x0442' (CC s '\x0000' '\x0000')
384+-- CYRILLIC SMALL LETTER THREE-LEGGED TE
385+foldMapping '\x1c85' s = Yield '\x0442' (CC s '\x0000' '\x0000')
386+-- CYRILLIC SMALL LETTER TALL HARD SIGN
387+foldMapping '\x1c86' s = Yield '\x044a' (CC s '\x0000' '\x0000')
388+-- CYRILLIC SMALL LETTER TALL YAT
389+foldMapping '\x1c87' s = Yield '\x0463' (CC s '\x0000' '\x0000')
390+-- CYRILLIC SMALL LETTER UNBLENDED UK
391+foldMapping '\x1c88' s = Yield '\xa64b' (CC s '\x0000' '\x0000')
374-- LATIN SMALL LETTER H WITH LINE BELOW
392-- LATIN SMALL LETTER H WITH LINE BELOW
375foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
393foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
376-- LATIN SMALL LETTER T WITH DIAERESIS
394-- LATIN SMALL LETTER T WITH DIAERESIS
@@ -545,6 +563,8 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')
545foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
563foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
546-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
564-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
547foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')
565foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')
566+-- LATIN CAPITAL LETTER SMALL CAPITAL I
567+foldMapping '\xa7ae' s = Yield '\x026a' (CC s '\x0000' '\x0000')
548-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL
568-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL
549foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')
569foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')
550-- LATIN CAPITAL LETTER CHI
570-- LATIN CAPITAL LETTER CHI
@@ -737,6 +757,78 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')
737foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
757foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
738-- ARMENIAN SMALL LIGATURE MEN XEH
758-- ARMENIAN SMALL LIGATURE MEN XEH
739foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')
759foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')
760+-- OSAGE CAPITAL LETTER A
761+foldMapping '\x104b0' s = Yield '\x104d8' (CC s '\x0000' '\x0000')
762+-- OSAGE CAPITAL LETTER AI
763+foldMapping '\x104b1' s = Yield '\x104d9' (CC s '\x0000' '\x0000')
764+-- OSAGE CAPITAL LETTER AIN
765+foldMapping '\x104b2' s = Yield '\x104da' (CC s '\x0000' '\x0000')
766+-- OSAGE CAPITAL LETTER AH
767+foldMapping '\x104b3' s = Yield '\x104db' (CC s '\x0000' '\x0000')
768+-- OSAGE CAPITAL LETTER BRA
769+foldMapping '\x104b4' s = Yield '\x104dc' (CC s '\x0000' '\x0000')
770+-- OSAGE CAPITAL LETTER CHA
771+foldMapping '\x104b5' s = Yield '\x104dd' (CC s '\x0000' '\x0000')
772+-- OSAGE CAPITAL LETTER EHCHA
773+foldMapping '\x104b6' s = Yield '\x104de' (CC s '\x0000' '\x0000')
774+-- OSAGE CAPITAL LETTER E
775+foldMapping '\x104b7' s = Yield '\x104df' (CC s '\x0000' '\x0000')
776+-- OSAGE CAPITAL LETTER EIN
777+foldMapping '\x104b8' s = Yield '\x104e0' (CC s '\x0000' '\x0000')
778+-- OSAGE CAPITAL LETTER HA
779+foldMapping '\x104b9' s = Yield '\x104e1' (CC s '\x0000' '\x0000')
780+-- OSAGE CAPITAL LETTER HYA
781+foldMapping '\x104ba' s = Yield '\x104e2' (CC s '\x0000' '\x0000')
782+-- OSAGE CAPITAL LETTER I
783+foldMapping '\x104bb' s = Yield '\x104e3' (CC s '\x0000' '\x0000')
784+-- OSAGE CAPITAL LETTER KA
785+foldMapping '\x104bc' s = Yield '\x104e4' (CC s '\x0000' '\x0000')
786+-- OSAGE CAPITAL LETTER EHKA
787+foldMapping '\x104bd' s = Yield '\x104e5' (CC s '\x0000' '\x0000')
788+-- OSAGE CAPITAL LETTER KYA
789+foldMapping '\x104be' s = Yield '\x104e6' (CC s '\x0000' '\x0000')
790+-- OSAGE CAPITAL LETTER LA
791+foldMapping '\x104bf' s = Yield '\x104e7' (CC s '\x0000' '\x0000')
792+-- OSAGE CAPITAL LETTER MA
793+foldMapping '\x104c0' s = Yield '\x104e8' (CC s '\x0000' '\x0000')
794+-- OSAGE CAPITAL LETTER NA
795+foldMapping '\x104c1' s = Yield '\x104e9' (CC s '\x0000' '\x0000')
796+-- OSAGE CAPITAL LETTER O
797+foldMapping '\x104c2' s = Yield '\x104ea' (CC s '\x0000' '\x0000')
798+-- OSAGE CAPITAL LETTER OIN
799+foldMapping '\x104c3' s = Yield '\x104eb' (CC s '\x0000' '\x0000')
800+-- OSAGE CAPITAL LETTER PA
801+foldMapping '\x104c4' s = Yield '\x104ec' (CC s '\x0000' '\x0000')
802+-- OSAGE CAPITAL LETTER EHPA
803+foldMapping '\x104c5' s = Yield '\x104ed' (CC s '\x0000' '\x0000')
804+-- OSAGE CAPITAL LETTER SA
805+foldMapping '\x104c6' s = Yield '\x104ee' (CC s '\x0000' '\x0000')
806+-- OSAGE CAPITAL LETTER SHA
807+foldMapping '\x104c7' s = Yield '\x104ef' (CC s '\x0000' '\x0000')
808+-- OSAGE CAPITAL LETTER TA
809+foldMapping '\x104c8' s = Yield '\x104f0' (CC s '\x0000' '\x0000')
810+-- OSAGE CAPITAL LETTER EHTA
811+foldMapping '\x104c9' s = Yield '\x104f1' (CC s '\x0000' '\x0000')
812+-- OSAGE CAPITAL LETTER TSA
813+foldMapping '\x104ca' s = Yield '\x104f2' (CC s '\x0000' '\x0000')
814+-- OSAGE CAPITAL LETTER EHTSA
815+foldMapping '\x104cb' s = Yield '\x104f3' (CC s '\x0000' '\x0000')
816+-- OSAGE CAPITAL LETTER TSHA
817+foldMapping '\x104cc' s = Yield '\x104f4' (CC s '\x0000' '\x0000')
818+-- OSAGE CAPITAL LETTER DHA
819+foldMapping '\x104cd' s = Yield '\x104f5' (CC s '\x0000' '\x0000')
820+-- OSAGE CAPITAL LETTER U
821+foldMapping '\x104ce' s = Yield '\x104f6' (CC s '\x0000' '\x0000')
822+-- OSAGE CAPITAL LETTER WA
823+foldMapping '\x104cf' s = Yield '\x104f7' (CC s '\x0000' '\x0000')
824+-- OSAGE CAPITAL LETTER KHA
825+foldMapping '\x104d0' s = Yield '\x104f8' (CC s '\x0000' '\x0000')
826+-- OSAGE CAPITAL LETTER GHA
827+foldMapping '\x104d1' s = Yield '\x104f9' (CC s '\x0000' '\x0000')
828+-- OSAGE CAPITAL LETTER ZA
829+foldMapping '\x104d2' s = Yield '\x104fa' (CC s '\x0000' '\x0000')
830+-- OSAGE CAPITAL LETTER ZHA
831+foldMapping '\x104d3' s = Yield '\x104fb' (CC s '\x0000' '\x0000')
740-- OLD HUNGARIAN CAPITAL LETTER A
832-- OLD HUNGARIAN CAPITAL LETTER A
741foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')
833foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')
742-- OLD HUNGARIAN CAPITAL LETTER AA
834-- OLD HUNGARIAN CAPITAL LETTER AA
@@ -839,4 +931,72 @@ foldMapping '\x10cb0' s = Yield '\x10cf0' (CC s '\x0000' '\x0000')
839foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')
931foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')
840-- OLD HUNGARIAN CAPITAL LETTER US
932-- OLD HUNGARIAN CAPITAL LETTER US
841foldMapping '\x10cb2' s = Yield '\x10cf2' (CC s '\x0000' '\x0000')
933foldMapping '\x10cb2' s = Yield '\x10cf2' (CC s '\x0000' '\x0000')
934+-- ADLAM CAPITAL LETTER ALIF
935+foldMapping '\x1e900' s = Yield '\x1e922' (CC s '\x0000' '\x0000')
936+-- ADLAM CAPITAL LETTER DAALI
937+foldMapping '\x1e901' s = Yield '\x1e923' (CC s '\x0000' '\x0000')
938+-- ADLAM CAPITAL LETTER LAAM
939+foldMapping '\x1e902' s = Yield '\x1e924' (CC s '\x0000' '\x0000')
940+-- ADLAM CAPITAL LETTER MIIM
941+foldMapping '\x1e903' s = Yield '\x1e925' (CC s '\x0000' '\x0000')
942+-- ADLAM CAPITAL LETTER BA
943+foldMapping '\x1e904' s = Yield '\x1e926' (CC s '\x0000' '\x0000')
944+-- ADLAM CAPITAL LETTER SINNYIIYHE
945+foldMapping '\x1e905' s = Yield '\x1e927' (CC s '\x0000' '\x0000')
946+-- ADLAM CAPITAL LETTER PE
947+foldMapping '\x1e906' s = Yield '\x1e928' (CC s '\x0000' '\x0000')
948+-- ADLAM CAPITAL LETTER BHE
949+foldMapping '\x1e907' s = Yield '\x1e929' (CC s '\x0000' '\x0000')
950+-- ADLAM CAPITAL LETTER RA
951+foldMapping '\x1e908' s = Yield '\x1e92a' (CC s '\x0000' '\x0000')
952+-- ADLAM CAPITAL LETTER E
953+foldMapping '\x1e909' s = Yield '\x1e92b' (CC s '\x0000' '\x0000')
954+-- ADLAM CAPITAL LETTER FA
955+foldMapping '\x1e90a' s = Yield '\x1e92c' (CC s '\x0000' '\x0000')
956+-- ADLAM CAPITAL LETTER I
957+foldMapping '\x1e90b' s = Yield '\x1e92d' (CC s '\x0000' '\x0000')
958+-- ADLAM CAPITAL LETTER O
959+foldMapping '\x1e90c' s = Yield '\x1e92e' (CC s '\x0000' '\x0000')
960+-- ADLAM CAPITAL LETTER DHA
961+foldMapping '\x1e90d' s = Yield '\x1e92f' (CC s '\x0000' '\x0000')
962+-- ADLAM CAPITAL LETTER YHE
963+foldMapping '\x1e90e' s = Yield '\x1e930' (CC s '\x0000' '\x0000')
964+-- ADLAM CAPITAL LETTER WAW
965+foldMapping '\x1e90f' s = Yield '\x1e931' (CC s '\x0000' '\x0000')
966+-- ADLAM CAPITAL LETTER NUN
967+foldMapping '\x1e910' s = Yield '\x1e932' (CC s '\x0000' '\x0000')
968+-- ADLAM CAPITAL LETTER KAF
969+foldMapping '\x1e911' s = Yield '\x1e933' (CC s '\x0000' '\x0000')
970+-- ADLAM CAPITAL LETTER YA
971+foldMapping '\x1e912' s = Yield '\x1e934' (CC s '\x0000' '\x0000')
972+-- ADLAM CAPITAL LETTER U
973+foldMapping '\x1e913' s = Yield '\x1e935' (CC s '\x0000' '\x0000')
974+-- ADLAM CAPITAL LETTER JIIM
975+foldMapping '\x1e914' s = Yield '\x1e936' (CC s '\x0000' '\x0000')
976+-- ADLAM CAPITAL LETTER CHI
977+foldMapping '\x1e915' s = Yield '\x1e937' (CC s '\x0000' '\x0000')
978+-- ADLAM CAPITAL LETTER HA
979+foldMapping '\x1e916' s = Yield '\x1e938' (CC s '\x0000' '\x0000')
980+-- ADLAM CAPITAL LETTER QAAF
981+foldMapping '\x1e917' s = Yield '\x1e939' (CC s '\x0000' '\x0000')
982+-- ADLAM CAPITAL LETTER GA
983+foldMapping '\x1e918' s = Yield '\x1e93a' (CC s '\x0000' '\x0000')
984+-- ADLAM CAPITAL LETTER NYA
985+foldMapping '\x1e919' s = Yield '\x1e93b' (CC s '\x0000' '\x0000')
986+-- ADLAM CAPITAL LETTER TU
987+foldMapping '\x1e91a' s = Yield '\x1e93c' (CC s '\x0000' '\x0000')
988+-- ADLAM CAPITAL LETTER NHA
989+foldMapping '\x1e91b' s = Yield '\x1e93d' (CC s '\x0000' '\x0000')
990+-- ADLAM CAPITAL LETTER VA
991+foldMapping '\x1e91c' s = Yield '\x1e93e' (CC s '\x0000' '\x0000')
992+-- ADLAM CAPITAL LETTER KHA
993+foldMapping '\x1e91d' s = Yield '\x1e93f' (CC s '\x0000' '\x0000')
994+-- ADLAM CAPITAL LETTER GBE
995+foldMapping '\x1e91e' s = Yield '\x1e940' (CC s '\x0000' '\x0000')
996+-- ADLAM CAPITAL LETTER ZAL
997+foldMapping '\x1e91f' s = Yield '\x1e941' (CC s '\x0000' '\x0000')
998+-- ADLAM CAPITAL LETTER KPO
999+foldMapping '\x1e920' s = Yield '\x1e942' (CC s '\x0000' '\x0000')
1000+-- ADLAM CAPITAL LETTER SHA
1001+foldMapping '\x1e921' s = Yield '\x1e943' (CC s '\x0000' '\x0000')
842foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
1002foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
Data/Text/Internal/Fusion/Common.hs+968−922
@@ -14,925 +14,971 @@
14--
14--
15-- Common stream fusion functionality for text.
15-- Common stream fusion functionality for text.
16
16
17−module Data.Text.Internal.Fusion.Common
17+module Data.Text.Internal.Fusion.Common (module Data.JSString.Internal.Fusion.Common) where
18− (
18+import Data.JSString.Internal.Fusion.Common
19− -- * Creation and elimination
19+-- module Data.Text.Internal.Fusion.Common
20− singleton
20+-- (
21− , streamList
21+-- -- * Creation and elimination
22− , unstreamList
22+-- singleton
23− , streamCString#
23+-- , streamList
24−
24+-- , unstreamList
25− -- * Basic interface
25+-- , streamCString#
26− , cons
26+
27− , snoc
27+-- -- * Basic interface
28− , append
28+-- , cons
29− , head
29+-- , snoc
30− , uncons
30+-- , append
31− , last
31+-- , head
32− , tail
32+-- , uncons
33− , init
33+-- , last
34− , null
34+-- , tail
35− , lengthI
35+-- , init
36− , compareLengthI
36+-- , null
37− , isSingleton
37+-- , lengthI
38−
38+-- , compareLengthI
39− -- * Transformations
39+-- , isSingleton
40− , map
40+
41− , intercalate
41+-- -- * Transformations
42− , intersperse
42+-- , map
43−
43+-- , intercalate
44− -- ** Case conversion
44+-- , intersperse
45− -- $case
45+
46− , toCaseFold
46+-- -- ** Case conversion
47− , toLower
47+-- -- $case
48− , toTitle
48+-- , toCaseFold
49− , toUpper
49+-- , toLower
50−
50+-- , toTitle
51− -- ** Justification
51+-- , toUpper
52− , justifyLeftI
52+
53−
53+-- -- ** Justification
54− -- * Folds
54+-- , justifyLeftI
55− , foldl
55+
56− , foldl'
56+-- -- * Folds
57− , foldl1
57+-- , foldl
58− , foldl1'
58+-- , foldl'
59− , foldr
59+-- , foldl1
60− , foldr1
60+-- , foldl1'
61−
61+-- , foldr
62− -- ** Special folds
62+-- , foldr1
63− , concat
63+
64− , concatMap
64+-- -- ** Special folds
65− , any
65+-- , concat
66− , all
66+-- , concatMap
67− , maximum
67+-- , any
68− , minimum
68+-- , all
69−
69+-- , maximum
70− -- * Construction
70+-- , minimum
71− -- ** Scans
71+
72− , scanl
72+-- -- * Construction
73−
73+-- -- ** Scans
74− -- ** Generation and unfolding
74+-- , scanl
75− , replicateCharI
75+
76− , replicateI
76+-- -- ** Generation and unfolding
77− , unfoldr
77+-- , replicateCharI
78− , unfoldrNI
78+-- , replicateI
79−
79+-- , unfoldr
80− -- * Substrings
80+-- , unfoldrNI
81− -- ** Breaking strings
81+
82− , take
82+-- -- * Substrings
83− , drop
83+-- -- ** Breaking strings
84− , takeWhile
84+-- , take
85− , dropWhile
85+-- , drop
86−
86+-- , takeWhile
87− -- * Predicates
87+-- , dropWhile
88− , isPrefixOf
88+
89−
89+-- -- * Predicates
90− -- * Searching
90+-- , isPrefixOf
91− , elem
91+
92− , filter
92+-- -- * Searching
93−
93+-- , elem
94− -- * Indexing
94+-- , filter
95− , findBy
95+
96− , indexI
96+-- -- * Indexing
97− , findIndexI
97+-- , findBy
98− , countCharI
98+-- , indexI
99−
99+-- , findIndexI
100− -- * Zipping and unzipping
100+-- , countCharI
101− , zipWith
101+
102− ) where
102+-- -- * Zipping and unzipping
103−
103+-- , zipWith
104−import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
104+-- ) where
105− Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
105+
106− (&&), fromIntegral, otherwise)
106+-- import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
107−import qualified Data.List as L
107+-- Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
108−import qualified Prelude as P
108+-- (&&), fromIntegral, otherwise)
109−import Data.Bits (shiftL)
109+-- import qualified Data.List as L
110−import Data.Char (isLetter)
110+-- import qualified Prelude as P
111−import Data.Int (Int64)
111+-- import Data.Bits (shiftL)
112−import Data.Text.Internal.Fusion.Types
112+-- import Data.Char (isLetter)
113−import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
113+-- import Data.Int (Int64)
114− upperMapping)
114+-- import Data.Text.Internal.Fusion.Types
115−import Data.Text.Internal.Fusion.Size
115+-- import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
116−import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
116+-- upperMapping)
117−import GHC.Types (Char(..), Int(..))
117+-- import Data.Text.Internal.Fusion.Size
118−
118+-- import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
119−singleton :: Char -> Stream Char
119+-- import GHC.Types (Char(..), Int(..))
120−singleton c = Stream next False 1
120+
121− where next False = Yield c True
121+-- singleton :: Char -> Stream Char
122− next True = Done
122+-- singleton c = Stream next False -- 1
123−{-# INLINE [0] singleton #-}
123+-- where next False = Yield c True
124−
124+-- next True = Done
125−streamList :: [a] -> Stream a
125+-- {-# INLINE [0] singleton #-}
126−{-# INLINE [0] streamList #-}
126+
127−streamList s = Stream next s unknownSize
127+-- streamList :: [a] -> Stream a
128− where next [] = Done
128+-- {-# INLINE [0] streamList #-}
129− next (x:xs) = Yield x xs
129+-- streamList s = Stream next s -- unknownSize
130−
130+-- where next [] = Done
131−unstreamList :: Stream a -> [a]
131+-- next (x:xs) = Yield x xs
132−unstreamList (Stream next s0 _len) = unfold s0
132+
133− where unfold !s = case next s of
133+-- unstreamList :: Stream a -> [a]
134− Done -> []
134+-- -- unstreamList (Stream next s0 _len) = unfold s0
135− Skip s' -> unfold s'
135+-- unstreamList (Stream next s0) = unfold s0
136− Yield x s' -> x : unfold s'
136+-- where unfold !s = case next s of
137−{-# INLINE [0] unstreamList #-}
137+-- Done -> []
138−
138+-- Skip s' -> unfold s'
139−{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
139+-- Yield x s' -> x : unfold s'
140−
140+-- {-# INLINE [0] unstreamList #-}
141−-- | Stream the UTF-8-like packed encoding used by GHC to represent
141+
142−-- constant strings in generated code.
142+-- {-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
143−--
143+
144−-- This encoding uses the byte sequence "\xc0\x80" to represent NUL,
144+-- -- | Stream the UTF-8-like packed encoding used by GHC to represent
145−-- and the string is NUL-terminated.
145+-- -- constant strings in generated code.
146−streamCString# :: Addr# -> Stream Char
146+-- --
147−streamCString# addr = Stream step 0 unknownSize
147+-- -- This encoding uses the byte sequence "\xc0\x80" to represent NUL,
148− where
148+-- -- and the string is NUL-terminated.
149− step !i
149+-- streamCString# :: Addr# -> Stream Char
150− | b == 0 = Done
150+-- streamCString# addr = Stream step 0 -- unknownSize
151− | b <= 0x7f = Yield (C# b#) (i+1)
151+-- where
152− | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1
152+-- step !i
153− in Yield c (i+2)
153+-- | b == 0 = Done
154− | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +
154+-- | b <= 0x7f = Yield (C# b#) (i+1)
155− (next 1 `shiftL` 6) +
155+-- | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1
156− next 2
156+-- in Yield c (i+2)
157− in Yield c (i+3)
157+-- | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +
158− | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +
158+-- (next 1 `shiftL` 6) +
159− (next 1 `shiftL` 12) +
159+-- next 2
160− (next 2 `shiftL` 6) +
160+-- in Yield c (i+3)
161− next 3
161+-- | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +
162− in Yield c (i+4)
162+-- (next 1 `shiftL` 12) +
163− where b = I# (ord# b#)
163+-- (next 2 `shiftL` 6) +
164− next n = I# (ord# (at# (i+n))) - 0x80
164+-- next 3
165− !b# = at# i
165+-- in Yield c (i+4)
166− at# (I# i#) = indexCharOffAddr# addr i#
166+-- where b = I# (ord# b#)
167− chr (I# i#) = C# (chr# i#)
167+-- next n = I# (ord# (at# (i+n))) - 0x80
168−{-# INLINE [0] streamCString# #-}
168+-- !b# = at# i
169−
169+-- at# (I# i#) = indexCharOffAddr# addr i#
170−-- ----------------------------------------------------------------------------
170+-- chr (I# i#) = C# (chr# i#)
171−-- * Basic stream functions
171+-- {-# INLINE [0] streamCString# #-}
172−
172+
173−data C s = C0 !s
173+-- -- ----------------------------------------------------------------------------
174− | C1 !s
174+-- -- * Basic stream functions
175−
175+
176−-- | /O(n)/ Adds a character to the front of a Stream Char.
176+-- data C s = C0 !s
177−cons :: Char -> Stream Char -> Stream Char
177+-- | C1 !s
178−cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
178+
179− where
179+-- -- | /O(n)/ Adds a character to the front of a Stream Char.
180− next (C1 s) = Yield w (C0 s)
180+-- cons :: Char -> Stream Char -> Stream Char
181− next (C0 s) = case next0 s of
181+-- -- cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
182− Done -> Done
182+-- cons !w (Stream next0 s0) = Stream next (C1 s0) -- (len+1)
183− Skip s' -> Skip (C0 s')
183+-- where
184− Yield x s' -> Yield x (C0 s')
184+-- next (C1 s) = Yield w (C0 s)
185−{-# INLINE [0] cons #-}
185+-- next (C0 s) = case next0 s of
186−
186+-- Done -> Done
187−data Snoc a = N
187+-- Skip s' -> Skip (C0 s')
188− | J !a
188+-- Yield x s' -> Yield x (C0 s')
189−
189+-- {-# INLINE [0] cons #-}
190−-- | /O(n)/ Adds a character to the end of a stream.
190+
191−snoc :: Stream Char -> Char -> Stream Char
191+-- data Snoc a = N
192−snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
192+-- | J !a
193− where
193+
194− next (J xs) = case next0 xs of
194+-- -- | /O(n)/ Adds a character to the end of a stream.
195− Done -> Yield w N
195+-- snoc :: Stream Char -> Char -> Stream Char
196− Skip xs' -> Skip (J xs')
196+-- -- snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
197− Yield x xs' -> Yield x (J xs')
197+-- snoc (Stream next0 xs0) w = Stream next (J xs0) -- (len+1)
198− next N = Done
198+-- where
199−{-# INLINE [0] snoc #-}
199+-- next (J xs) = case next0 xs of
200−
200+-- Done -> Yield w N
201−data E l r = L !l
201+-- Skip xs' -> Skip (J xs')
202− | R !r
202+-- Yield x xs' -> Yield x (J xs')
203−
203+-- next N = Done
204−-- | /O(n)/ Appends one Stream to the other.
204+-- {-# INLINE [0] snoc #-}
205−append :: Stream Char -> Stream Char -> Stream Char
205+
206−append (Stream next0 s01 len1) (Stream next1 s02 len2) =
206+-- data E l r = L !l
207− Stream next (L s01) (len1 + len2)
207+-- | R !r
208− where
208+
209− next (L s1) = case next0 s1 of
209+-- -- | /O(n)/ Appends one Stream to the other.
210− Done -> Skip (R s02)
210+-- append :: Stream Char -> Stream Char -> Stream Char
211− Skip s1' -> Skip (L s1')
211+-- -- append (Stream next0 s01 len1) (Stream next1 s02 len2) =
212− Yield x s1' -> Yield x (L s1')
212+-- -- Stream next (L s01) (len1 + len2)
213− next (R s2) = case next1 s2 of
213+-- append (Stream next0 s01) (Stream next1 s02) =
214− Done -> Done
214+-- Stream next (L s01)
215− Skip s2' -> Skip (R s2')
215+-- where
216− Yield x s2' -> Yield x (R s2')
216+-- next (L s1) = case next0 s1 of
217−{-# INLINE [0] append #-}
217+-- Done -> Skip (R s02)
218−
218+-- Skip s1' -> Skip (L s1')
219−-- | /O(1)/ Returns the first character of a Text, which must be non-empty.
219+-- Yield x s1' -> Yield x (L s1')
220−-- Subject to array fusion.
220+-- next (R s2) = case next1 s2 of
221−head :: Stream Char -> Char
221+-- Done -> Done
222−head (Stream next s0 _len) = loop_head s0
222+-- Skip s2' -> Skip (R s2')
223− where
223+-- Yield x s2' -> Yield x (R s2')
224− loop_head !s = case next s of
224+-- {-# INLINE [0] append #-}
225− Yield x _ -> x
225+
226− Skip s' -> loop_head s'
226+-- -- | /O(1)/ Returns the first character of a Text, which must be non-empty.
227− Done -> head_empty
227+-- -- Subject to array fusion.
228−{-# INLINE [0] head #-}
228+-- head :: Stream Char -> Char
229−
229+-- -- head (Stream next s0 _len) = loop_head s0
230−head_empty :: a
230+-- head (Stream next s0) = loop_head s0
231−head_empty = streamError "head" "Empty stream"
231+-- where
232−{-# NOINLINE head_empty #-}
232+-- loop_head !s = case next s of
233−
233+-- Yield x _ -> x
234−-- | /O(1)/ Returns the first character and remainder of a 'Stream
234+-- Skip s' -> loop_head s'
235−-- Char', or 'Nothing' if empty. Subject to array fusion.
235+-- Done -> head_empty
236−uncons :: Stream Char -> Maybe (Char, Stream Char)
236+-- {-# INLINE [0] head #-}
237−uncons (Stream next s0 len) = loop_uncons s0
237+
238− where
238+-- head_empty :: a
239− loop_uncons !s = case next s of
239+-- head_empty = streamError "head" "Empty stream"
240− Yield x s1 -> Just (x, Stream next s1 (len-1))
240+-- {-# NOINLINE head_empty #-}
241− Skip s' -> loop_uncons s'
241+
242− Done -> Nothing
242+-- -- | /O(1)/ Returns the first character and remainder of a 'Stream
243−{-# INLINE [0] uncons #-}
243+-- -- Char', or 'Nothing' if empty. Subject to array fusion.
244−
244+-- uncons :: Stream Char -> Maybe (Char, Stream Char)
245−-- | /O(n)/ Returns the last character of a 'Stream Char', which must
245+-- -- uncons (Stream next s0 len) = loop_uncons s0
246−-- be non-empty.
246+-- uncons (Stream next s0) = loop_uncons s0
247−last :: Stream Char -> Char
247+-- where
248−last (Stream next s0 _len) = loop0_last s0
248+-- loop_uncons !s = case next s of
249− where
249+-- Yield x s1 -> Just (x, Stream next s1)
250− loop0_last !s = case next s of
250+-- Skip s' -> loop_uncons s'
251− Done -> emptyError "last"
251+-- Done -> Nothing
252− Skip s' -> loop0_last s'
252+-- {-# INLINE [0] uncons #-}
253− Yield x s' -> loop_last x s'
253+
254− loop_last !x !s = case next s of
254+-- -- | /O(n)/ Returns the last character of a 'Stream Char', which must
255− Done -> x
255+-- -- be non-empty.
256− Skip s' -> loop_last x s'
256+-- last :: Stream Char -> Char
257− Yield x' s' -> loop_last x' s'
257+-- -- last (Stream next s0 _len) = loop0_last s0
258−{-# INLINE[0] last #-}
258+-- last (Stream next s0) = loop0_last s0
259−
259+-- where
260−-- | /O(1)/ Returns all characters after the head of a Stream Char, which must
260+-- loop0_last !s = case next s of
261−-- be non-empty.
261+-- Done -> emptyError "last"
262−tail :: Stream Char -> Stream Char
262+-- Skip s' -> loop0_last s'
263−tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
263+-- Yield x s' -> loop_last x s'
264− where
264+-- loop_last !x !s = case next s of
265− next (C0 s) = case next0 s of
265+-- Done -> x
266− Done -> emptyError "tail"
266+-- Skip s' -> loop_last x s'
267− Skip s' -> Skip (C0 s')
267+-- Yield x' s' -> loop_last x' s'
268− Yield _ s' -> Skip (C1 s')
268+-- {-# INLINE[0] last #-}
269− next (C1 s) = case next0 s of
269+
270− Done -> Done
270+-- -- | /O(1)/ Returns all characters after the head of a Stream Char, which must
271− Skip s' -> Skip (C1 s')
271+-- -- be non-empty.
272− Yield x s' -> Yield x (C1 s')
272+-- tail :: Stream Char -> Stream Char
273−{-# INLINE [0] tail #-}
273+-- -- tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
274−
274+-- tail (Stream next0 s0) = Stream next (C0 s0) -- (len-1)
275−data Init s = Init0 !s
275+-- where
276− | Init1 {-# UNPACK #-} !Char !s
276+-- next (C0 s) = case next0 s of
277−
277+-- Done -> emptyError "tail"
278−-- | /O(1)/ Returns all but the last character of a Stream Char, which
278+-- Skip s' -> Skip (C0 s')
279−-- must be non-empty.
279+-- Yield _ s' -> Skip (C1 s')
280−init :: Stream Char -> Stream Char
280+-- next (C1 s) = case next0 s of
281−init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
281+-- Done -> Done
282− where
282+-- Skip s' -> Skip (C1 s')
283− next (Init0 s) = case next0 s of
283+-- Yield x s' -> Yield x (C1 s')
284− Done -> emptyError "init"
284+-- {-# INLINE [0] tail #-}
285− Skip s' -> Skip (Init0 s')
285+
286− Yield x s' -> Skip (Init1 x s')
286+-- data Init s = Init0 !s
287− next (Init1 x s) = case next0 s of
287+-- | Init1 {-# UNPACK #-} !Char !s
288− Done -> Done
288+
289− Skip s' -> Skip (Init1 x s')
289+-- -- | /O(1)/ Returns all but the last character of a Stream Char, which
290− Yield x' s' -> Yield x (Init1 x' s')
290+-- -- must be non-empty.
291−{-# INLINE [0] init #-}
291+-- init :: Stream Char -> Stream Char
292−
292+-- -- init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
293−-- | /O(1)/ Tests whether a Stream Char is empty or not.
293+-- init (Stream next0 s0) = Stream next (Init0 s0) -- (len-1)
294−null :: Stream Char -> Bool
294+-- where
295−null (Stream next s0 _len) = loop_null s0
295+-- next (Init0 s) = case next0 s of
296− where
296+-- Done -> emptyError "init"
297− loop_null !s = case next s of
297+-- Skip s' -> Skip (Init0 s')
298− Done -> True
298+-- Yield x s' -> Skip (Init1 x s')
299− Yield _ _ -> False
299+-- next (Init1 x s) = case next0 s of
300− Skip s' -> loop_null s'
300+-- Done -> Done
301−{-# INLINE[0] null #-}
301+-- Skip s' -> Skip (Init1 x s')
302−
302+-- Yield x' s' -> Yield x (Init1 x' s')
303−-- | /O(n)/ Returns the number of characters in a string.
303+-- {-# INLINE [0] init #-}
304−lengthI :: Integral a => Stream Char -> a
304+
305−lengthI (Stream next s0 _len) = loop_length 0 s0
305+-- -- | /O(1)/ Tests whether a Stream Char is empty or not.
306− where
306+-- null :: Stream Char -> Bool
307− loop_length !z s = case next s of
307+-- -- null (Stream next s0 _len) = loop_null s0
308− Done -> z
308+-- null (Stream next s0) = loop_null s0
309− Skip s' -> loop_length z s'
309+-- where
310− Yield _ s' -> loop_length (z + 1) s'
310+-- loop_null !s = case next s of
311−{-# INLINE[0] lengthI #-}
311+-- Done -> True
312−
312+-- Yield _ _ -> False
313−-- | /O(n)/ Compares the count of characters in a string to a number.
313+-- Skip s' -> loop_null s'
314−-- Subject to fusion.
314+-- {-# INLINE[0] null #-}
315−--
315+
316−-- This function gives the same answer as comparing against the result
316+-- -- | /O(n)/ Returns the number of characters in a string.
317−-- of 'lengthI', but can short circuit if the count of characters is
317+-- lengthI :: Integral a => Stream Char -> a
318−-- greater than the number or if the stream can't possibly be as long
318+-- -- lengthI (Stream next s0 _len) = loop_length 0 s0
319−-- as the number supplied, and hence be more efficient.
319+-- lengthI (Stream next s0) = loop_length 0 s0
320−compareLengthI :: Integral a => Stream Char -> a -> Ordering
320+-- where
321−compareLengthI (Stream next s0 len) n =
321+-- loop_length !z s = case next s of
322− case compareSize len (fromIntegral n) of
322+-- Done -> z
323− Just o -> o
323+-- Skip s' -> loop_length z s'
324− Nothing -> loop_cmp 0 s0
324+-- Yield _ s' -> loop_length (z + 1) s'
325− where
325+-- {-# INLINE[0] lengthI #-}
326− loop_cmp !z s = case next s of
326+
327− Done -> compare z n
327+-- -- | /O(n)/ Compares the count of characters in a string to a number.
328− Skip s' -> loop_cmp z s'
328+-- -- Subject to fusion.
329− Yield _ s' | z > n -> GT
329+-- --
330− | otherwise -> loop_cmp (z + 1) s'
330+-- -- This function gives the same answer as comparing against the result
331−{-# INLINE[0] compareLengthI #-}
331+-- -- of 'lengthI', but can short circuit if the count of characters is
332−
332+-- -- greater than the number or if the stream can't possibly be as long
333−-- | /O(n)/ Indicate whether a string contains exactly one element.
333+-- -- as the number supplied, and hence be more efficient.
334−isSingleton :: Stream Char -> Bool
334+-- compareLengthI :: Integral a => Stream Char -> a -> Ordering
335−isSingleton (Stream next s0 _len) = loop 0 s0
335+-- -- compareLengthI (Stream next s0 len) n =
336− where
336+-- compareLengthI (Stream next s0) n =
337− loop !z s = case next s of
337+-- -- case compareSize len (fromIntegral n) of
338− Done -> z == (1::Int)
338+-- -- Just o -> o
339− Skip s' -> loop z s'
339+-- -- Nothing -> loop_cmp 0 s0
340− Yield _ s'
340+-- loop_cmp 0 s0
341− | z >= 1 -> False
341+-- where
342− | otherwise -> loop (z+1) s'
342+-- loop_cmp !z s = case next s of
343−{-# INLINE[0] isSingleton #-}
343+-- Done -> compare z n
344−
344+-- Skip s' -> loop_cmp z s'
345−-- ----------------------------------------------------------------------------
345+-- Yield _ s' | z > n -> GT
346−-- * Stream transformations
346+-- | otherwise -> loop_cmp (z + 1) s'
347−
347+-- {-# INLINE[0] compareLengthI #-}
348−-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@
348+
349−-- to each element of @xs@.
349+-- -- | /O(n)/ Indicate whether a string contains exactly one element.
350−map :: (Char -> Char) -> Stream Char -> Stream Char
350+-- isSingleton :: Stream Char -> Bool
351−map f (Stream next0 s0 len) = Stream next s0 len
351+-- -- isSingleton (Stream next s0 _len) = loop 0 s0
352− where
352+-- isSingleton (Stream next s0) = loop 0 s0
353− next !s = case next0 s of
353+-- where
354− Done -> Done
354+-- loop !z s = case next s of
355− Skip s' -> Skip s'
355+-- Done -> z == (1::Int)
356− Yield x s' -> Yield (f x) s'
356+-- Skip s' -> loop z s'
357−{-# INLINE [0] map #-}
357+-- Yield _ s'
358−
358+-- | z >= 1 -> False
359−{-#
359+-- | otherwise -> loop (z+1) s'
360− RULES "STREAM map/map fusion" forall f g s.
360+-- {-# INLINE[0] isSingleton #-}
361− map f (map g s) = map (\x -> f (g x)) s
361+
362− #-}
362+-- -- ----------------------------------------------------------------------------
363−
363+-- -- * Stream transformations
364−data I s = I1 !s
364+
365− | I2 !s {-# UNPACK #-} !Char
365+-- -- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@
366− | I3 !s
366+-- -- to each element of @xs@.
367−
367+-- map :: (Char -> Char) -> Stream Char -> Stream Char
368−-- | /O(n)/ Take a character and place it between each of the
368+-- -- map f (Stream next0 s0 len) = Stream next s0 len
369−-- characters of a 'Stream Char'.
369+-- map f (Stream next0 s0) = Stream next s0 -- len
370−intersperse :: Char -> Stream Char -> Stream Char
370+-- where
371−intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
371+-- next !s = case next0 s of
372− where
372+-- Done -> Done
373− next (I1 s) = case next0 s of
373+-- Skip s' -> Skip s'
374− Done -> Done
374+-- Yield x s' -> Yield (f x) s'
375− Skip s' -> Skip (I1 s')
375+-- {-# INLINE [0] map #-}
376− Yield x s' -> Skip (I2 s' x)
376+
377− next (I2 s x) = Yield x (I3 s)
377+-- {-#
378− next (I3 s) = case next0 s of
378+-- RULES "STREAM map/map fusion" forall f g s.
379− Done -> Done
379+-- map f (map g s) = map (\x -> f (g x)) s
380− Skip s' -> Skip (I3 s')
380+-- #-}
381− Yield x s' -> Yield c (I2 s' x)
381+
382−{-# INLINE [0] intersperse #-}
382+-- data I s = I1 !s
383−
383+-- | I2 !s {-# UNPACK #-} !Char
384−-- ----------------------------------------------------------------------------
384+-- | I3 !s
385−-- ** Case conversions (folds)
385+
386−
386+-- -- | /O(n)/ Take a character and place it between each of the
387−-- $case
387+-- -- characters of a 'Stream Char'.
388−--
388+-- intersperse :: Char -> Stream Char -> Stream Char
389−-- With Unicode text, it is incorrect to use combinators like @map
389+-- intersperse c (Stream next0 s0) = Stream next (I1 s0) -- len
390−-- toUpper@ to case convert each character of a string individually.
390+-- -- intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
391−-- Instead, use the whole-string case conversion functions from this
391+-- where
392−-- module. For correctness in different writing systems, these
392+-- next (I1 s) = case next0 s of
393−-- functions may map one input character to two or three output
393+-- Done -> Done
394−-- characters.
394+-- Skip s' -> Skip (I1 s')
395−
395+-- Yield x s' -> Skip (I2 s' x)
396−caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
396+-- next (I2 s x) = Yield x (I3 s)
397− -> Stream Char -> Stream Char
397+-- next (I3 s) = case next0 s of
398−caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
398+-- Done -> Done
399− where
399+-- Skip s' -> Skip (I3 s')
400− next (CC s '\0' _) =
400+-- Yield x s' -> Yield c (I2 s' x)
401− case next0 s of
401+-- {-# INLINE [0] intersperse #-}
402− Done -> Done
402+
403− Skip s' -> Skip (CC s' '\0' '\0')
403+-- -- ----------------------------------------------------------------------------
404− Yield c s' -> remap c s'
404+-- -- ** Case conversions (folds)
405− next (CC s a b) = Yield a (CC s b '\0')
405+
406−
406+-- -- $case
407−-- | /O(n)/ Convert a string to folded case. This function is mainly
407+-- --
408−-- useful for performing caseless (or case insensitive) string
408+-- -- With Unicode text, it is incorrect to use combinators like @map
409−-- comparisons.
409+-- -- toUpper@ to case convert each character of a string individually.
410−--
410+-- -- Instead, use the whole-string case conversion functions from this
411−-- A string @x@ is a caseless match for a string @y@ if and only if:
411+-- -- module. For correctness in different writing systems, these
412−--
412+-- -- functions may map one input character to two or three output
413−-- @toCaseFold x == toCaseFold y@
413+-- -- characters.
414−--
414+
415−-- The result string may be longer than the input string, and may
415+-- caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
416−-- differ from applying 'toLower' to the input string. For instance,
416+-- -> Stream Char -> Stream Char
417−-- the Armenian small ligature men now (U+FB13) is case folded to the
417+-- -- caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
418−-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is
418+-- caseConvert remap (Stream next0 s0) = Stream next (CC s0 '\0' '\0') -- len
419−-- case folded to the Greek small letter letter mu (U+03BC) instead of
419+-- where
420−-- itself.
420+-- next (CC s '\0' _) =
421−toCaseFold :: Stream Char -> Stream Char
421+-- case next0 s of
422−toCaseFold = caseConvert foldMapping
422+-- Done -> Done
423−{-# INLINE [0] toCaseFold #-}
423+-- Skip s' -> Skip (CC s' '\0' '\0')
424−
424+-- Yield c s' -> remap c s'
425−-- | /O(n)/ Convert a string to upper case, using simple case
425+-- next (CC s a b) = Yield a (CC s b '\0')
426−-- conversion. The result string may be longer than the input string.
426+
427−-- For instance, the German eszett (U+00DF) maps to the two-letter
427+-- -- | /O(n)/ Convert a string to folded case. This function is mainly
428−-- sequence SS.
428+-- -- useful for performing caseless (or case insensitive) string
429−toUpper :: Stream Char -> Stream Char
429+-- -- comparisons.
430−toUpper = caseConvert upperMapping
430+-- --
431−{-# INLINE [0] toUpper #-}
431+-- -- A string @x@ is a caseless match for a string @y@ if and only if:
432−
432+-- --
433−-- | /O(n)/ Convert a string to lower case, using simple case
433+-- -- @toCaseFold x == toCaseFold y@
434−-- conversion. The result string may be longer than the input string.
434+-- --
435−-- For instance, the Latin capital letter I with dot above (U+0130)
435+-- -- The result string may be longer than the input string, and may
436−-- maps to the sequence Latin small letter i (U+0069) followed by
436+-- -- differ from applying 'toLower' to the input string. For instance,
437−-- combining dot above (U+0307).
437+-- -- the Armenian small ligature men now (U+FB13) is case folded to the
438−toLower :: Stream Char -> Stream Char
438+-- -- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is
439−toLower = caseConvert lowerMapping
439+-- -- case folded to the Greek small letter letter mu (U+03BC) instead of
440−{-# INLINE [0] toLower #-}
440+-- -- itself.
441−
441+-- toCaseFold :: Stream Char -> Stream Char
442−-- | /O(n)/ Convert a string to title case, using simple case
442+-- toCaseFold = caseConvert foldMapping
443−-- conversion.
443+-- {-# INLINE [0] toCaseFold #-}
444−--
444+
445−-- The first letter of the input is converted to title case, as is
445+-- -- | /O(n)/ Convert a string to upper case, using simple case
446−-- every subsequent letter that immediately follows a non-letter.
446+-- -- conversion. The result string may be longer than the input string.
447−-- Every letter that immediately follows another letter is converted
447+-- -- For instance, the German eszett (U+00DF) maps to the two-letter
448−-- to lower case.
448+-- -- sequence SS.
449−--
449+-- toUpper :: Stream Char -> Stream Char
450−-- The result string may be longer than the input string. For example,
450+-- toUpper = caseConvert upperMapping
451−-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
451+-- {-# INLINE [0] toUpper #-}
452−-- sequence Latin capital letter F (U+0046) followed by Latin small
452+
453−-- letter l (U+006C).
453+-- -- | /O(n)/ Convert a string to lower case, using simple case
454−--
454+-- -- conversion. The result string may be longer than the input string.
455−-- /Note/: this function does not take language or culture specific
455+-- -- For instance, the Latin capital letter I with dot above (U+0130)
456−-- rules into account. For instance, in English, different style
456+-- -- maps to the sequence Latin small letter i (U+0069) followed by
457−-- guides disagree on whether the book name \"The Hill of the Red
457+-- -- combining dot above (U+0307).
458−-- Fox\" is correctly title cased&#x2014;but this function will
458+-- toLower :: Stream Char -> Stream Char
459−-- capitalize /every/ word.
459+-- toLower = caseConvert lowerMapping
460−toTitle :: Stream Char -> Stream Char
460+-- {-# INLINE [0] toLower #-}
461−toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
461+
462− where
462+-- -- | /O(n)/ Convert a string to title case, using simple case
463− next (CC (letter :*: s) '\0' _) =
463+-- -- conversion.
464− case next0 s of
464+-- --
465− Done -> Done
465+-- -- The first letter of the input is converted to title case, as is
466− Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
466+-- -- every subsequent letter that immediately follows a non-letter.
467− Yield c s'
467+-- -- Every letter that immediately follows another letter is converted
468− | letter' -> if letter
468+-- -- to lower case.
469− then lowerMapping c (letter' :*: s')
469+-- --
470− else titleMapping c (letter' :*: s')
470+-- -- The result string may be longer than the input string. For example,
471− | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
471+-- -- the Latin small ligature &#xfb02; (U+FB02) is converted to the
472− where letter' = isLetter c
472+-- -- sequence Latin capital letter F (U+0046) followed by Latin small
473− next (CC s a b) = Yield a (CC s b '\0')
473+-- -- letter l (U+006C).
474−{-# INLINE [0] toTitle #-}
474+-- --
475−
475+-- -- /Note/: this function does not take language or culture specific
476−data Justify i s = Just1 !i !s
476+-- -- rules into account. For instance, in English, different style
477− | Just2 !i !s
477+-- -- guides disagree on whether the book name \"The Hill of the Red
478−
478+-- -- Fox\" is correctly title cased&#x2014;but this function will
479−justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
479+-- -- capitalize /every/ word.
480−justifyLeftI k c (Stream next0 s0 len) =
480+-- toTitle :: Stream Char -> Stream Char
481− Stream next (Just1 0 s0) (larger (fromIntegral k) len)
481+-- -- toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
482− where
482+-- toTitle (Stream next0 s0) = Stream next (CC (False :*: s0) '\0' '\0') -- len
483− next (Just1 n s) =
483+-- where
484− case next0 s of
484+-- next (CC (letter :*: s) '\0' _) =
485− Done -> next (Just2 n s)
485+-- case next0 s of
486− Skip s' -> Skip (Just1 n s')
486+-- Done -> Done
487− Yield x s' -> Yield x (Just1 (n+1) s')
487+-- Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
488− next (Just2 n s)
488+-- Yield c s'
489− | n < k = Yield c (Just2 (n+1) s)
489+-- | letter' -> if letter
490− | otherwise = Done
490+-- then lowerMapping c (letter' :*: s')
491− {-# INLINE next #-}
491+-- else titleMapping c (letter' :*: s')
492−{-# INLINE [0] justifyLeftI #-}
492+-- | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
493−
493+-- where letter' = isLetter c
494−-- ----------------------------------------------------------------------------
494+-- next (CC s a b) = Yield a (CC s b '\0')
495−-- * Reducing Streams (folds)
495+-- {-# INLINE [0] toTitle #-}
496−
496+
497−-- | foldl, applied to a binary operator, a starting value (typically the
497+-- data Justify i s = Just1 !i !s
498−-- left-identity of the operator), and a Stream, reduces the Stream using the
498+-- | Just2 !i !s
499−-- binary operator, from left to right.
499+
500−foldl :: (b -> Char -> b) -> b -> Stream Char -> b
500+-- justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
501−foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0
501+-- -- justifyLeftI k c (Stream next0 s0 len) =
502− where
502+-- justifyLeftI k c (Stream next0 s0) =
503− loop_foldl z !s = case next s of
503+-- Stream next (Just1 0 s0) -- (larger (fromIntegral k) len)
504− Done -> z
504+-- where
505− Skip s' -> loop_foldl z s'
505+-- next (Just1 n s) =
506− Yield x s' -> loop_foldl (f z x) s'
506+-- case next0 s of
507−{-# INLINE [0] foldl #-}
507+-- Done -> next (Just2 n s)
508−
508+-- Skip s' -> Skip (Just1 n s')
509−-- | A strict version of foldl.
509+-- Yield x s' -> Yield x (Just1 (n+1) s')
510−foldl' :: (b -> Char -> b) -> b -> Stream Char -> b
510+-- next (Just2 n s)
511−foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0
511+-- | n < k = Yield c (Just2 (n+1) s)
512− where
512+-- | otherwise = Done
513− loop_foldl' !z !s = case next s of
513+-- {-# INLINE next #-}
514− Done -> z
514+-- {-# INLINE [0] justifyLeftI #-}
515− Skip s' -> loop_foldl' z s'
515+
516− Yield x s' -> loop_foldl' (f z x) s'
516+-- -- ----------------------------------------------------------------------------
517−{-# INLINE [0] foldl' #-}
517+-- -- * Reducing Streams (folds)
518−
518+
519−-- | foldl1 is a variant of foldl that has no starting value argument,
519+-- -- | foldl, applied to a binary operator, a starting value (typically the
520−-- and thus must be applied to non-empty Streams.
520+-- -- left-identity of the operator), and a Stream, reduces the Stream using the
521−foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char
521+-- -- binary operator, from left to right.
522−foldl1 f (Stream next s0 _len) = loop0_foldl1 s0
522+-- foldl :: (b -> Char -> b) -> b -> Stream Char -> b
523− where
523+-- -- foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0
524− loop0_foldl1 !s = case next s of
524+-- foldl f z0 (Stream next s0) = loop_foldl z0 s0
525− Skip s' -> loop0_foldl1 s'
525+-- where
526− Yield x s' -> loop_foldl1 x s'
526+-- loop_foldl z !s = case next s of
527− Done -> emptyError "foldl1"
527+-- Done -> z
528− loop_foldl1 z !s = case next s of
528+-- Skip s' -> loop_foldl z s'
529− Done -> z
529+-- Yield x s' -> loop_foldl (f z x) s'
530− Skip s' -> loop_foldl1 z s'
530+-- {-# INLINE [0] foldl #-}
531− Yield x s' -> loop_foldl1 (f z x) s'
531+
532−{-# INLINE [0] foldl1 #-}
532+-- -- | A strict version of foldl.
533−
533+-- foldl' :: (b -> Char -> b) -> b -> Stream Char -> b
534−-- | A strict version of foldl1.
534+-- -- foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0
535−foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char
535+-- foldl' f z0 (Stream next s0) = loop_foldl' z0 s0
536−foldl1' f (Stream next s0 _len) = loop0_foldl1' s0
536+-- where
537− where
537+-- loop_foldl' !z !s = case next s of
538− loop0_foldl1' !s = case next s of
538+-- Done -> z
539− Skip s' -> loop0_foldl1' s'
539+-- Skip s' -> loop_foldl' z s'
540− Yield x s' -> loop_foldl1' x s'
540+-- Yield x s' -> loop_foldl' (f z x) s'
541− Done -> emptyError "foldl1"
541+-- {-# INLINE [0] foldl' #-}
542− loop_foldl1' !z !s = case next s of
542+
543− Done -> z
543+-- -- | foldl1 is a variant of foldl that has no starting value argument,
544− Skip s' -> loop_foldl1' z s'
544+-- -- and thus must be applied to non-empty Streams.
545− Yield x s' -> loop_foldl1' (f z x) s'
545+-- foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char
546−{-# INLINE [0] foldl1' #-}
546+-- -- foldl1 f (Stream next s0 _len) = loop0_foldl1 s0
547−
547+-- foldl1 f (Stream next s0) = loop0_foldl1 s0
548−-- | 'foldr', applied to a binary operator, a starting value (typically the
548+-- where
549−-- right-identity of the operator), and a stream, reduces the stream using the
549+-- loop0_foldl1 !s = case next s of
550−-- binary operator, from right to left.
550+-- Skip s' -> loop0_foldl1 s'
551−foldr :: (Char -> b -> b) -> b -> Stream Char -> b
551+-- Yield x s' -> loop_foldl1 x s'
552−foldr f z (Stream next s0 _len) = loop_foldr s0
552+-- Done -> emptyError "foldl1"
553− where
553+-- loop_foldl1 z !s = case next s of
554− loop_foldr !s = case next s of
554+-- Done -> z
555− Done -> z
555+-- Skip s' -> loop_foldl1 z s'
556− Skip s' -> loop_foldr s'
556+-- Yield x s' -> loop_foldl1 (f z x) s'
557− Yield x s' -> f x (loop_foldr s')
557+-- {-# INLINE [0] foldl1 #-}
558−{-# INLINE [0] foldr #-}
558+
559−
559+-- -- | A strict version of foldl1.
560−-- | foldr1 is a variant of 'foldr' that has no starting value argument,
560+-- foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char
561−-- and thus must be applied to non-empty streams.
561+-- -- foldl1' f (Stream next s0 _len) = loop0_foldl1' s0
562−-- Subject to array fusion.
562+-- foldl1' f (Stream next s0) = loop0_foldl1' s0
563−foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char
563+-- where
564−foldr1 f (Stream next s0 _len) = loop0_foldr1 s0
564+-- loop0_foldl1' !s = case next s of
565− where
565+-- Skip s' -> loop0_foldl1' s'
566− loop0_foldr1 !s = case next s of
566+-- Yield x s' -> loop_foldl1' x s'
567− Done -> emptyError "foldr1"
567+-- Done -> emptyError "foldl1"
568− Skip s' -> loop0_foldr1 s'
568+-- loop_foldl1' !z !s = case next s of
569− Yield x s' -> loop_foldr1 x s'
569+-- Done -> z
570−
570+-- Skip s' -> loop_foldl1' z s'
571− loop_foldr1 x !s = case next s of
571+-- Yield x s' -> loop_foldl1' (f z x) s'
572− Done -> x
572+-- {-# INLINE [0] foldl1' #-}
573− Skip s' -> loop_foldr1 x s'
573+
574− Yield x' s' -> f x (loop_foldr1 x' s')
574+-- -- | 'foldr', applied to a binary operator, a starting value (typically the
575−{-# INLINE [0] foldr1 #-}
575+-- -- right-identity of the operator), and a stream, reduces the stream using the
576−
576+-- -- binary operator, from right to left.
577−intercalate :: Stream Char -> [Stream Char] -> Stream Char
577+-- foldr :: (Char -> b -> b) -> b -> Stream Char -> b
578−intercalate s = concat . (L.intersperse s)
578+-- -- foldr f z (Stream next s0 _len) = loop_foldr s0
579−{-# INLINE [0] intercalate #-}
579+-- foldr f z (Stream next s0) = loop_foldr s0
580−
580+-- where
581−-- ----------------------------------------------------------------------------
581+-- loop_foldr !s = case next s of
582−-- ** Special folds
582+-- Done -> z
583−
583+-- Skip s' -> loop_foldr s'
584−-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
584+-- Yield x s' -> f x (loop_foldr s')
585−concat :: [Stream Char] -> Stream Char
585+-- {-# INLINE [0] foldr #-}
586−concat = L.foldr append empty
586+
587−{-# INLINE [0] concat #-}
587+-- -- | foldr1 is a variant of 'foldr' that has no starting value argument,
588−
588+-- -- and thus must be applied to non-empty streams.
589−-- | Map a function over a stream that results in a stream and concatenate the
589+-- -- Subject to array fusion.
590−-- results.
590+-- foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char
591−concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
591+-- -- foldr1 f (Stream next s0 _len) = loop0_foldr1 s0
592−concatMap f = foldr (append . f) empty
592+-- foldr1 f (Stream next s0) = loop0_foldr1 s0
593−{-# INLINE [0] concatMap #-}
593+-- where
594−
594+-- loop0_foldr1 !s = case next s of
595−-- | /O(n)/ any @p @xs determines if any character in the stream
595+-- Done -> emptyError "foldr1"
596−-- @xs@ satisfies the predicate @p@.
596+-- Skip s' -> loop0_foldr1 s'
597−any :: (Char -> Bool) -> Stream Char -> Bool
597+-- Yield x s' -> loop_foldr1 x s'
598−any p (Stream next0 s0 _len) = loop_any s0
598+
599− where
599+-- loop_foldr1 x !s = case next s of
600− loop_any !s = case next0 s of
600+-- Done -> x
601− Done -> False
601+-- Skip s' -> loop_foldr1 x s'
602− Skip s' -> loop_any s'
602+-- Yield x' s' -> f x (loop_foldr1 x' s')
603− Yield x s' | p x -> True
603+-- {-# INLINE [0] foldr1 #-}
604− | otherwise -> loop_any s'
604+
605−{-# INLINE [0] any #-}
605+-- intercalate :: Stream Char -> [Stream Char] -> Stream Char
606−
606+-- intercalate s = concat . (L.intersperse s)
607−-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
607+-- {-# INLINE [0] intercalate #-}
608−-- @xs@ satisfy the predicate @p@.
608+
609−all :: (Char -> Bool) -> Stream Char -> Bool
609+-- -- ----------------------------------------------------------------------------
610−all p (Stream next0 s0 _len) = loop_all s0
610+-- -- ** Special folds
611− where
611+
612− loop_all !s = case next0 s of
612+-- -- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
613− Done -> True
613+-- concat :: [Stream Char] -> Stream Char
614− Skip s' -> loop_all s'
614+-- concat = L.foldr append empty
615− Yield x s' | p x -> loop_all s'
615+-- {-# INLINE [0] concat #-}
616− | otherwise -> False
616+
617−{-# INLINE [0] all #-}
617+-- -- | Map a function over a stream that results in a stream and concatenate the
618−
618+-- -- results.
619−-- | /O(n)/ maximum returns the maximum value from a stream, which must be
619+-- concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
620−-- non-empty.
620+-- concatMap f = foldr (append . f) empty
621−maximum :: Stream Char -> Char
621+-- {-# INLINE [0] concatMap #-}
622−maximum (Stream next0 s0 _len) = loop0_maximum s0
622+
623− where
623+-- -- | /O(n)/ any @p @xs determines if any character in the stream
624− loop0_maximum !s = case next0 s of
624+-- -- @xs@ satisfies the predicate @p@.
625− Done -> emptyError "maximum"
625+-- any :: (Char -> Bool) -> Stream Char -> Bool
626− Skip s' -> loop0_maximum s'
626+-- -- any p (Stream next0 s0 _len) = loop_any s0
627− Yield x s' -> loop_maximum x s'
627+-- any p (Stream next0 s0) = loop_any s0
628− loop_maximum !z !s = case next0 s of
628+-- where
629− Done -> z
629+-- loop_any !s = case next0 s of
630− Skip s' -> loop_maximum z s'
630+-- Done -> False
631− Yield x s'
631+-- Skip s' -> loop_any s'
632− | x > z -> loop_maximum x s'
632+-- Yield x s' | p x -> True
633− | otherwise -> loop_maximum z s'
633+-- | otherwise -> loop_any s'
634−{-# INLINE [0] maximum #-}
634+-- {-# INLINE [0] any #-}
635−
635+
636−-- | /O(n)/ minimum returns the minimum value from a 'Text', which must be
636+-- -- | /O(n)/ all @p @xs determines if all characters in the 'Text'
637−-- non-empty.
637+-- -- @xs@ satisfy the predicate @p@.
638−minimum :: Stream Char -> Char
638+-- all :: (Char -> Bool) -> Stream Char -> Bool
639−minimum (Stream next0 s0 _len) = loop0_minimum s0
639+-- -- all p (Stream next0 s0 _len) = loop_all s0
640− where
640+-- all p (Stream next0 s0) = loop_all s0
641− loop0_minimum !s = case next0 s of
641+-- where
642− Done -> emptyError "minimum"
642+-- loop_all !s = case next0 s of
643− Skip s' -> loop0_minimum s'
643+-- Done -> True
644− Yield x s' -> loop_minimum x s'
644+-- Skip s' -> loop_all s'
645− loop_minimum !z !s = case next0 s of
645+-- Yield x s' | p x -> loop_all s'
646− Done -> z
646+-- | otherwise -> False
647− Skip s' -> loop_minimum z s'
647+-- {-# INLINE [0] all #-}
648− Yield x s'
648+
649− | x < z -> loop_minimum x s'
649+-- -- | /O(n)/ maximum returns the maximum value from a stream, which must be
650− | otherwise -> loop_minimum z s'
650+-- -- non-empty.
651−{-# INLINE [0] minimum #-}
651+-- maximum :: Stream Char -> Char
652−
652+-- -- maximum (Stream next0 s0 _len) = loop0_maximum s0
653−-- -----------------------------------------------------------------------------
653+-- maximum (Stream next0 s0) = loop0_maximum s0
654−-- * Building streams
654+-- where
655−
655+-- loop0_maximum !s = case next0 s of
656−scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
656+-- Done -> emptyError "maximum"
657−scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
657+-- Skip s' -> loop0_maximum s'
658− where
658+-- Yield x s' -> loop_maximum x s'
659− {-# INLINE next #-}
659+-- loop_maximum !z !s = case next0 s of
660− next (Scan1 z s) = Yield z (Scan2 z s)
660+-- Done -> z
661− next (Scan2 z s) = case next0 s of
661+-- Skip s' -> loop_maximum z s'
662− Yield x s' -> let !x' = f z x
662+-- Yield x s'
663− in Yield x' (Scan2 x' s')
663+-- | x > z -> loop_maximum x s'
664− Skip s' -> Skip (Scan2 z s')
664+-- | otherwise -> loop_maximum z s'
665− Done -> Done
665+-- {-# INLINE [0] maximum #-}
666−{-# INLINE [0] scanl #-}
666+
667−
667+-- -- | /O(n)/ minimum returns the minimum value from a 'Text', which must be
668−-- -----------------------------------------------------------------------------
668+-- -- non-empty.
669−-- ** Generating and unfolding streams
669+-- minimum :: Stream Char -> Char
670−
670+-- -- minimum (Stream next0 s0 _len) = loop0_minimum s0
671−replicateCharI :: Integral a => a -> Char -> Stream Char
671+-- minimum (Stream next0 s0) = loop0_minimum s0
672−replicateCharI !n !c
672+-- where
673− | n < 0 = empty
673+-- loop0_minimum !s = case next0 s of
674− | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
674+-- Done -> emptyError "minimum"
675− where
675+-- Skip s' -> loop0_minimum s'
676− next !i | i >= n = Done
676+-- Yield x s' -> loop_minimum x s'
677− | otherwise = Yield c (i + 1)
677+-- loop_minimum !z !s = case next0 s of
678−{-# INLINE [0] replicateCharI #-}
678+-- Done -> z
679−
679+-- Skip s' -> loop_minimum z s'
680−data RI s = RI !s {-# UNPACK #-} !Int64
680+-- Yield x s'
681−
681+-- | x < z -> loop_minimum x s'
682−replicateI :: Int64 -> Stream Char -> Stream Char
682+-- | otherwise -> loop_minimum z s'
683−replicateI n (Stream next0 s0 len) =
683+-- {-# INLINE [0] minimum #-}
684− Stream next (RI s0 0) (fromIntegral (max 0 n) * len)
684+
685− where
685+-- -- -----------------------------------------------------------------------------
686− next (RI s k)
686+-- -- * Building streams
687− | k >= n = Done
687+
688− | otherwise = case next0 s of
688+-- scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
689− Done -> Skip (RI s0 (k+1))
689+-- -- scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
690− Skip s' -> Skip (RI s' k)
690+-- scanl f z0 (Stream next0 s0) = Stream next (Scan1 z0 s0) -- (len+1) -- HINT maybe too low
691− Yield x s' -> Yield x (RI s' k)
691+-- where
692−{-# INLINE [0] replicateI #-}
692+-- {-# INLINE next #-}
693−
693+-- next (Scan1 z s) = Yield z (Scan2 z s)
694−-- | /O(n)/, where @n@ is the length of the result. The unfoldr function
694+-- next (Scan2 z s) = case next0 s of
695−-- is analogous to the List 'unfoldr'. unfoldr builds a stream
695+-- Yield x s' -> let !x' = f z x
696−-- from a seed value. The function takes the element and returns
696+-- in Yield x' (Scan2 x' s')
697−-- Nothing if it is done producing the stream or returns Just
697+-- Skip s' -> Skip (Scan2 z s')
698−-- (a,b), in which case, a is the next Char in the string, and b is
698+-- Done -> Done
699−-- the seed value for further production.
699+-- {-# INLINE [0] scanl #-}
700−unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
700+
701−unfoldr f s0 = Stream next s0 1 -- HINT maybe too low
701+-- -- -----------------------------------------------------------------------------
702− where
702+-- -- ** Generating and unfolding streams
703− {-# INLINE next #-}
703+
704− next !s = case f s of
704+-- replicateCharI :: Integral a => a -> Char -> Stream Char
705− Nothing -> Done
705+-- replicateCharI n c
706− Just (w, s') -> Yield w s'
706+-- | n < 0 = empty
707−{-# INLINE [0] unfoldr #-}
707+-- | otherwise = Stream next 0 -- (fromIntegral n) -- HINT maybe too low
708−
708+-- where
709−-- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed
709+-- next i | i >= n = Done
710−-- value. However, the length of the result is limited by the
710+-- | otherwise = Yield c (i + 1)
711−-- first argument to 'unfoldrNI'. This function is more efficient than
711+-- {-# INLINE [0] replicateCharI #-}
712−-- 'unfoldr' when the length of the result is known.
712+
713−unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
713+-- data RI s = RI !s {-# UNPACK #-} !Int64
714−unfoldrNI n f s0 | n < 0 = empty
714+
715− | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high
715+-- replicateI :: Int64 -> Stream Char -> Stream Char
716− where
716+-- -- replicateI n (Stream next0 s0 len) =
717− {-# INLINE next #-}
717+-- replicateI n (Stream next0 s0) =
718− next (z :*: s) = case f s of
718+-- Stream next (RI s0 0) -- (fromIntegral (max 0 n) * len)
719− Nothing -> Done
719+-- where
720− Just (w, s') | z >= n -> Done
720+-- next (RI s k)
721− | otherwise -> Yield w ((z + 1) :*: s')
721+-- | k >= n = Done
722−{-# INLINE unfoldrNI #-}
722+-- | otherwise = case next0 s of
723−
723+-- Done -> Skip (RI s0 (k+1))
724−-------------------------------------------------------------------------------
724+-- Skip s' -> Skip (RI s' k)
725−-- * Substreams
725+-- Yield x s' -> Yield x (RI s' k)
726−
726+-- {-# INLINE [0] replicateI #-}
727−-- | /O(n)/ take n, applied to a stream, returns the prefix of the
727+
728−-- stream of length @n@, or the stream itself if @n@ is greater than the
728+-- -- | /O(n)/, where @n@ is the length of the result. The unfoldr function
729−-- length of the stream.
729+-- -- is analogous to the List 'unfoldr'. unfoldr builds a stream
730−take :: Integral a => a -> Stream Char -> Stream Char
730+-- -- from a seed value. The function takes the element and returns
731−take n0 (Stream next0 s0 len) =
731+-- -- Nothing if it is done producing the stream or returns Just
732− Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))
732+-- -- (a,b), in which case, a is the next Char in the string, and b is
733− where
733+-- -- the seed value for further production.
734− {-# INLINE next #-}
734+-- unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
735− next (n :*: s) | n <= 0 = Done
735+-- unfoldr f s0 = Stream next s0 -- 1 -- HINT maybe too low
736− | otherwise = case next0 s of
736+-- where
737− Done -> Done
737+-- {-# INLINE next #-}
738− Skip s' -> Skip (n :*: s')
738+-- next !s = case f s of
739− Yield x s' -> Yield x ((n-1) :*: s')
739+-- Nothing -> Done
740−{-# INLINE [0] take #-}
740+-- Just (w, s') -> Yield w s'
741−
741+-- {-# INLINE [0] unfoldr #-}
742−data Drop a s = NS !s
742+
743− | JS !a !s
743+-- -- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed
744−
744+-- -- value. However, the length of the result is limited by the
745−-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
745+-- -- first argument to 'unfoldrNI'. This function is more efficient than
746−-- stream after the first @n@ characters, or the empty stream if @n@
746+-- -- 'unfoldr' when the length of the result is known.
747−-- is greater than the length of the stream.
747+-- unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
748−drop :: Integral a => a -> Stream Char -> Stream Char
748+-- unfoldrNI n f s0 | n < 0 = empty
749−drop n0 (Stream next0 s0 len) =
749+-- | otherwise = Stream next (0 :*: s0) -- (fromIntegral (n*2)) -- HINT maybe too high
750− Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
750+-- where
751− where
751+-- {-# INLINE next #-}
752− {-# INLINE next #-}
752+-- next (z :*: s) = case f s of
753− next (JS n s)
753+-- Nothing -> Done
754− | n <= 0 = Skip (NS s)
754+-- Just (w, s') | z >= n -> Done
755− | otherwise = case next0 s of
755+-- | otherwise -> Yield w ((z + 1) :*: s')
756− Done -> Done
756+-- {-# INLINE unfoldrNI #-}
757− Skip s' -> Skip (JS n s')
757+
758− Yield _ s' -> Skip (JS (n-1) s')
758+-- -------------------------------------------------------------------------------
759− next (NS s) = case next0 s of
759+-- -- * Substreams
760− Done -> Done
760+
761− Skip s' -> Skip (NS s')
761+-- -- | /O(n)/ take n, applied to a stream, returns the prefix of the
762− Yield x s' -> Yield x (NS s')
762+-- -- stream of length @n@, or the stream itself if @n@ is greater than the
763−{-# INLINE [0] drop #-}
763+-- -- length of the stream.
764−
764+-- take :: Integral a => a -> Stream Char -> Stream Char
765−-- | takeWhile, applied to a predicate @p@ and a stream, returns the
765+-- take n0 (Stream next0 s0) =
766−-- longest prefix (possibly empty) of elements that satisfy p.
766+-- -- take n0 (Stream next0 s0 len) =
767−takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
767+-- Stream next (n0 :*: s0) -- (smaller len (fromIntegral (max 0 n0)))
768−takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
768+-- where
769− where
769+-- {-# INLINE next #-}
770− {-# INLINE next #-}
770+-- next (n :*: s) | n <= 0 = Done
771− next !s = case next0 s of
771+-- | otherwise = case next0 s of
772− Done -> Done
772+-- Done -> Done
773− Skip s' -> Skip s'
773+-- Skip s' -> Skip (n :*: s')
774− Yield x s' | p x -> Yield x s'
774+-- Yield x s' -> Yield x ((n-1) :*: s')
775− | otherwise -> Done
775+-- {-# INLINE [0] take #-}
776−{-# INLINE [0] takeWhile #-}
776+
777−
777+-- data Drop a s = NS !s
778−-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
778+-- | JS !a !s
779−dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
779+
780−dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
780+-- -- | /O(n)/ drop n, applied to a stream, returns the suffix of the
781− where
781+-- -- stream after the first @n@ characters, or the empty stream if @n@
782− {-# INLINE next #-}
782+-- -- is greater than the length of the stream.
783− next (L s) = case next0 s of
783+-- drop :: Integral a => a -> Stream Char -> Stream Char
784− Done -> Done
784+-- -- drop n0 (Stream next0 s0 len) =
785− Skip s' -> Skip (L s')
785+-- drop n0 (Stream next0 s0) =
786− Yield x s' | p x -> Skip (L s')
786+-- Stream next (JS n0 s0) -- (len - fromIntegral (max 0 n0))
787− | otherwise -> Yield x (R s')
787+-- where
788− next (R s) = case next0 s of
788+-- {-# INLINE next #-}
789− Done -> Done
789+-- next (JS n s)
790− Skip s' -> Skip (R s')
790+-- | n <= 0 = Skip (NS s)
791− Yield x s' -> Yield x (R s')
791+-- | otherwise = case next0 s of
792−{-# INLINE [0] dropWhile #-}
792+-- Done -> Done
793−
793+-- Skip s' -> Skip (JS n s')
794−-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
794+-- Yield _ s' -> Skip (JS (n-1) s')
795−-- 'True' iff the first is a prefix of the second.
795+-- next (NS s) = case next0 s of
796−isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool
796+-- Done -> Done
797−isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
797+-- Skip s' -> Skip (NS s')
798− where
798+-- Yield x s' -> Yield x (NS s')
799− loop Done _ = True
799+-- {-# INLINE [0] drop #-}
800− loop _ Done = False
800+
801− loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
801+-- -- | takeWhile, applied to a predicate @p@ and a stream, returns the
802− loop (Skip s1') x2 = loop (next1 s1') x2
802+-- -- longest prefix (possibly empty) of elements that satisfy p.
803− loop x1 (Skip s2') = loop x1 (next2 s2')
803+-- takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
804− loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
804+-- -- takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
805− loop (next1 s1') (next2 s2')
805+-- takeWhile p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high
806−{-# INLINE [0] isPrefixOf #-}
806+-- where
807−
807+-- {-# INLINE next #-}
808−-- ----------------------------------------------------------------------------
808+-- next !s = case next0 s of
809−-- * Searching
809+-- Done -> Done
810−
810+-- Skip s' -> Skip s'
811−-------------------------------------------------------------------------------
811+-- Yield x s' | p x -> Yield x s'
812−-- ** Searching by equality
812+-- | otherwise -> Done
813−
813+-- {-# INLINE [0] takeWhile #-}
814−-- | /O(n)/ elem is the stream membership predicate.
814+
815−elem :: Char -> Stream Char -> Bool
815+-- -- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
816−elem w (Stream next s0 _len) = loop_elem s0
816+-- dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
817− where
817+-- -- dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
818− loop_elem !s = case next s of
818+-- dropWhile p (Stream next0 s0) = Stream next (L s0) -- len -- HINT maybe too high
819− Done -> False
819+-- where
820− Skip s' -> loop_elem s'
820+-- {-# INLINE next #-}
821− Yield x s' | x == w -> True
821+-- next (L s) = case next0 s of
822− | otherwise -> loop_elem s'
822+-- Done -> Done
823−{-# INLINE [0] elem #-}
823+-- Skip s' -> Skip (L s')
824−
824+-- Yield x s' | p x -> Skip (L s')
825−-------------------------------------------------------------------------------
825+-- | otherwise -> Yield x (R s')
826−-- ** Searching with a predicate
826+-- next (R s) = case next0 s of
827−
827+-- Done -> Done
828−-- | /O(n)/ The 'findBy' function takes a predicate and a stream,
828+-- Skip s' -> Skip (R s')
829−-- and returns the first element in matching the predicate, or 'Nothing'
829+-- Yield x s' -> Yield x (R s')
830−-- if there is no such element.
830+-- {-# INLINE [0] dropWhile #-}
831−
831+
832−findBy :: (Char -> Bool) -> Stream Char -> Maybe Char
832+-- -- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
833−findBy p (Stream next s0 _len) = loop_find s0
833+-- -- 'True' iff the first is a prefix of the second.
834− where
834+-- isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool
835− loop_find !s = case next s of
835+-- -- isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
836− Done -> Nothing
836+-- isPrefixOf (Stream next1 s1) (Stream next2 s2) = loop (next1 s1) (next2 s2)
837− Skip s' -> loop_find s'
837+-- where
838− Yield x s' | p x -> Just x
838+-- loop Done _ = True
839− | otherwise -> loop_find s'
839+-- loop _ Done = False
840−{-# INLINE [0] findBy #-}
840+-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
841−
841+-- loop (Skip s1') x2 = loop (next1 s1') x2
842−-- | /O(n)/ Stream index (subscript) operator, starting from 0.
842+-- loop x1 (Skip s2') = loop x1 (next2 s2')
843−indexI :: Integral a => Stream Char -> a -> Char
843+-- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
844−indexI (Stream next s0 _len) n0
844+-- loop (next1 s1') (next2 s2')
845− | n0 < 0 = streamError "index" "Negative index"
845+-- {-# INLINE [0] isPrefixOf #-}
846− | otherwise = loop_index n0 s0
846+
847− where
847+-- -- ----------------------------------------------------------------------------
848− loop_index !n !s = case next s of
848+-- -- * Searching
849− Done -> streamError "index" "Index too large"
849+
850− Skip s' -> loop_index n s'
850+-- -------------------------------------------------------------------------------
851− Yield x s' | n == 0 -> x
851+-- -- ** Searching by equality
852− | otherwise -> loop_index (n-1) s'
852+
853−{-# INLINE [0] indexI #-}
853+-- -- | /O(n)/ elem is the stream membership predicate.
854−
854+-- elem :: Char -> Stream Char -> Bool
855−-- | /O(n)/ 'filter', applied to a predicate and a stream,
855+-- -- elem w (Stream next s0 _len) = loop_elem s0
856−-- returns a stream containing those characters that satisfy the
856+-- elem w (Stream next s0) = loop_elem s0
857−-- predicate.
857+-- where
858−filter :: (Char -> Bool) -> Stream Char -> Stream Char
858+-- loop_elem !s = case next s of
859−filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
859+-- Done -> False
860− where
860+-- Skip s' -> loop_elem s'
861− next !s = case next0 s of
861+-- Yield x s' | x == w -> True
862− Done -> Done
862+-- | otherwise -> loop_elem s'
863− Skip s' -> Skip s'
863+-- {-# INLINE [0] elem #-}
864− Yield x s' | p x -> Yield x s'
864+
865− | otherwise -> Skip s'
865+-- -------------------------------------------------------------------------------
866−{-# INLINE [0] filter #-}
866+-- -- ** Searching with a predicate
867−
867+
868−{-# RULES
868+-- -- | /O(n)/ The 'findBy' function takes a predicate and a stream,
869− "STREAM filter/filter fusion" forall p q s.
869+-- -- and returns the first element in matching the predicate, or 'Nothing'
870− filter p (filter q s) = filter (\x -> q x && p x) s
870+-- -- if there is no such element.
871− #-}
871+
872−
872+-- findBy :: (Char -> Bool) -> Stream Char -> Maybe Char
873−-- | The 'findIndexI' function takes a predicate and a stream and
873+-- -- findBy p (Stream next s0 _len) = loop_find s0
874−-- returns the index of the first element in the stream satisfying the
874+-- findBy p (Stream next s0) = loop_find s0
875−-- predicate.
875+-- where
876−findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a
876+-- loop_find !s = case next s of
877−findIndexI p s = case findIndicesI p s of
877+-- Done -> Nothing
878− (i:_) -> Just i
878+-- Skip s' -> loop_find s'
879− _ -> Nothing
879+-- Yield x s' | p x -> Just x
880−{-# INLINE [0] findIndexI #-}
880+-- | otherwise -> loop_find s'
881−
881+-- {-# INLINE [0] findBy #-}
882−-- | The 'findIndicesI' function takes a predicate and a stream and
882+
883−-- returns all indices of the elements in the stream satisfying the
883+-- -- | /O(n)/ Stream index (subscript) operator, starting from 0.
884−-- predicate.
884+-- indexI :: Integral a => Stream Char -> a -> Char
885−findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]
885+-- -- indexI (Stream next s0 _len) n0
886−findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
886+-- indexI (Stream next s0) n0
887− where
887+-- | n0 < 0 = streamError "index" "Negative index"
888− loop_findIndex !i !s = case next s of
888+-- | otherwise = loop_index n0 s0
889− Done -> []
889+-- where
890− Skip s' -> loop_findIndex i s' -- hmm. not caught by QC
890+-- loop_index !n !s = case next s of
891− Yield x s' | p x -> i : loop_findIndex (i+1) s'
891+-- Done -> streamError "index" "Index too large"
892− | otherwise -> loop_findIndex (i+1) s'
892+-- Skip s' -> loop_index n s'
893−{-# INLINE [0] findIndicesI #-}
893+-- Yield x s' | n == 0 -> x
894−
894+-- | otherwise -> loop_index (n-1) s'
895−-------------------------------------------------------------------------------
895+-- {-# INLINE [0] indexI #-}
896−-- * Zipping
896+
897−
897+-- -- | /O(n)/ 'filter', applied to a predicate and a stream,
898−-- | Strict triple.
898+-- -- returns a stream containing those characters that satisfy the
899−data Zip a b m = Z1 !a !b
899+-- -- predicate.
900− | Z2 !a !b !m
900+-- filter :: (Char -> Bool) -> Stream Char -> Stream Char
901−
901+-- -- filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
902−-- | zipWith generalises 'zip' by zipping with the function given as
902+-- filter p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high
903−-- the first argument, instead of a tupling function.
903+-- where
904−zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
904+-- next !s = case next0 s of
905−zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
905+-- Done -> Done
906− Stream next (Z1 sa0 sb0) (smaller len1 len2)
906+-- Skip s' -> Skip s'
907− where
907+-- Yield x s' | p x -> Yield x s'
908− next (Z1 sa sb) = case next0 sa of
908+-- | otherwise -> Skip s'
909− Done -> Done
909+-- {-# INLINE [0] filter #-}
910− Skip sa' -> Skip (Z1 sa' sb)
910+
911− Yield a sa' -> Skip (Z2 sa' sb a)
911+-- {-# RULES
912−
912+-- "STREAM filter/filter fusion" forall p q s.
913− next (Z2 sa' sb a) = case next1 sb of
913+-- filter p (filter q s) = filter (\x -> q x && p x) s
914− Done -> Done
914+-- #-}
915− Skip sb' -> Skip (Z2 sa' sb' a)
915+
916− Yield b sb' -> Yield (f a b) (Z1 sa' sb')
916+-- -- | The 'findIndexI' function takes a predicate and a stream and
917−{-# INLINE [0] zipWith #-}
917+-- -- returns the index of the first element in the stream satisfying the
918−
918+-- -- predicate.
919−-- | /O(n)/ The 'countCharI' function returns the number of times the
919+-- findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a
920−-- query element appears in the given stream.
920+-- findIndexI p s = case findIndicesI p s of
921−countCharI :: Integral a => Char -> Stream Char -> a
921+-- (i:_) -> Just i
922−countCharI a (Stream next s0 _len) = loop 0 s0
922+-- _ -> Nothing
923− where
923+-- {-# INLINE [0] findIndexI #-}
924− loop !i !s = case next s of
924+
925− Done -> i
925+-- -- | The 'findIndicesI' function takes a predicate and a stream and
926− Skip s' -> loop i s'
926+-- -- returns all indices of the elements in the stream satisfying the
927− Yield x s' | a == x -> loop (i+1) s'
927+-- -- predicate.
928− | otherwise -> loop i s'
928+-- findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]
929−{-# INLINE [0] countCharI #-}
929+-- -- findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
930−
930+-- findIndicesI p (Stream next s0) = loop_findIndex 0 s0
931−streamError :: String -> String -> a
931+-- where
932−streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
932+-- loop_findIndex !i !s = case next s of
933−
933+-- Done -> []
934−emptyError :: String -> a
934+-- Skip s' -> loop_findIndex i s' -- hmm. not caught by QC
935−emptyError func = internalError func "Empty input"
935+-- Yield x s' | p x -> i : loop_findIndex (i+1) s'
936−
936+-- | otherwise -> loop_findIndex (i+1) s'
937−internalError :: String -> a
937+-- {-# INLINE [0] findIndicesI #-}
938−internalError func = streamError func "Internal error"
938+
939+-- -------------------------------------------------------------------------------
940+-- -- * Zipping
941+
942+-- -- | Strict triple.
943+-- data Zip a b m = Z1 !a !b
944+-- | Z2 !a !b !m
945+
946+-- -- | zipWith generalises 'zip' by zipping with the function given as
947+-- -- the first argument, instead of a tupling function.
948+-- zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
949+-- -- zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
950+-- zipWith f (Stream next0 sa0) (Stream next1 sb0) =
951+-- Stream next (Z1 sa0 sb0) -- (smaller len1 len2)
952+-- where
953+-- next (Z1 sa sb) = case next0 sa of
954+-- Done -> Done
955+-- Skip sa' -> Skip (Z1 sa' sb)
956+-- Yield a sa' -> Skip (Z2 sa' sb a)
957+
958+-- next (Z2 sa' sb a) = case next1 sb of
959+-- Done -> Done
960+-- Skip sb' -> Skip (Z2 sa' sb' a)
961+-- Yield b sb' -> Yield (f a b) (Z1 sa' sb')
962+-- {-# INLINE [0] zipWith #-}
963+
964+-- -- | /O(n)/ The 'countCharI' function returns the number of times the
965+-- -- query element appears in the given stream.
966+-- countCharI :: Integral a => Char -> Stream Char -> a
967+-- -- countCharI a (Stream next s0 _len) = loop 0 s0
968+-- countCharI a (Stream next s0) = loop 0 s0
969+-- where
970+-- loop !i !s = case next s of
971+-- Done -> i
972+-- Skip s' -> loop i s'
973+-- Yield x s' | a == x -> loop (i+1) s'
974+-- | otherwise -> loop i s'
975+-- {-# INLINE [0] countCharI #-}
976+
977+-- streamError :: String -> String -> a
978+-- streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
979+
980+-- emptyError :: String -> a
981+-- emptyError func = internalError func "Empty input"
982+
983+-- internalError :: String -> a
984+-- internalError func = streamError func "Internal error"
Data/Text/Internal/Fusion/Size.hs+33−7
@@ -1,4 +1,4 @@
1−{-# LANGUAGE CPP #-}
1+{-# LANGUAGE CPP, PatternGuards #-}
2{-# OPTIONS_GHC -fno-warn-missing-methods #-}
2{-# OPTIONS_GHC -fno-warn-missing-methods #-}
3-- |
3-- |
4-- Module : Data.Text.Internal.Fusion.Internal
4-- Module : Data.Text.Internal.Fusion.Internal
@@ -19,11 +19,16 @@
19module Data.Text.Internal.Fusion.Size
19module Data.Text.Internal.Fusion.Size
20 (
20 (
21 Size
21 Size
22− , exactly
22+ -- * Sizes
23 , exactSize
23 , exactSize
24 , maxSize
24 , maxSize
25 , betweenSize
25 , betweenSize
26 , unknownSize
26 , unknownSize
27+ , unionSize
28+ , charSize
29+ , codePointsSize
30+ -- * Querying sizes
31+ , exactly
27 , smaller
32 , smaller
28 , larger
33 , larger
29 , upperBound
34 , upperBound
@@ -32,11 +37,13 @@ module Data.Text.Internal.Fusion.Size
32 , isEmpty
37 , isEmpty
33 ) where
38 ) where
34
39
40+import Data.Char (ord)
35import Data.Text.Internal (mul)
41import Data.Text.Internal (mul)
36#if defined(ASSERTS)
42#if defined(ASSERTS)
37import Control.Exception (assert)
43import Control.Exception (assert)
38#endif
44#endif
39
45
46+-- | A size in UTF-16 code units.
40data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
47data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
41 | Unknown -- ^ Unknown size.
48 | Unknown -- ^ Unknown size.
42 deriving (Eq, Show)
49 deriving (Eq, Show)
@@ -46,6 +53,17 @@ exactly (Between na nb) | na == nb = Just na
46exactly _ = Nothing
53exactly _ = Nothing
47{-# INLINE exactly #-}
54{-# INLINE exactly #-}
48
55
56+-- | The 'Size' of the given code point.
57+charSize :: Char -> Size
58+charSize c
59+ | ord c < 0x10000 = exactSize 1
60+ | otherwise = exactSize 2
61+
62+-- | The 'Size' of @n@ code points.
63+codePointsSize :: Int -> Size
64+codePointsSize n = Between n (2*n)
65+{-# INLINE codePointsSize #-}
66+
49exactSize :: Int -> Size
67exactSize :: Int -> Size
50exactSize n =
68exactSize n =
51#if defined(ASSERTS)
69#if defined(ASSERTS)
@@ -71,6 +89,10 @@ betweenSize m n =
71 Between m n
89 Between m n
72{-# INLINE betweenSize #-}
90{-# INLINE betweenSize #-}
73
91
92+unionSize :: Size -> Size -> Size
93+unionSize (Between a b) (Between c d) = Between (min a c) (max b d)
94+unionSize _ _ = Unknown
95+
74unknownSize :: Size
96unknownSize :: Size
75unknownSize = Unknown
97unknownSize = Unknown
76{-# INLINE unknownSize #-}
98{-# INLINE unknownSize #-}
@@ -140,11 +162,15 @@ lowerBound _ (Between n _) = n
140lowerBound k _ = k
162lowerBound k _ = k
141{-# INLINE lowerBound #-}
163{-# INLINE lowerBound #-}
142
164
165+-- | Determine the ordering relationship between two 'Size's, or 'Nothing' in
166+-- the indeterminate case.
143−compareSize :: Size -> Int -> Maybe Ordering
167+compareSize :: Size -> Size -> Maybe Ordering
144−compareSize (Between ma mb) n
168+compareSize (Between ma mb) (Between na nb)
145− | mb < n = Just LT
169+ | mb < na = Just LT
146− | ma > n = Just GT
170+ | ma > nb = Just GT
171+ | ma == mb
172+ , ma == na
147− | ma == n && mb == n = Just EQ
173+ , ma == nb = Just EQ
148compareSize _ _ = Nothing
174compareSize _ _ = Nothing
149
175
150
176
Data/Text/Internal/Fusion/Types.hs+102−99
@@ -19,104 +19,107 @@
19
19
20module Data.Text.Internal.Fusion.Types
20module Data.Text.Internal.Fusion.Types
21 (
21 (
22− CC(..)
22+ -- CC(..)
23− , PairS(..)
23+ -- , PairS(..)
24− , Scan(..)
24+ -- , Scan(..)
25− , RS(..)
25+ -- , RS(..)
26− , Step(..)
26+ -- , Step(..)
27− , Stream(..)
27+ -- , Stream(..)
28− , empty
28+ -- , empty
29+ module Data.JSString.Internal.Fusion.Types
29 ) where
30 ) where
30
31
31−import Data.Text.Internal.Fusion.Size
32+-- import Data.Text.Internal.Fusion.Size
32−import Data.Word (Word8)
33+-- import Data.Word (Word8)
33−
34+
35+import Data.JSString.Internal.Fusion.Types
36+
34−-- | Specialised tuple for case conversion.
37+-- -- | Specialised tuple for case conversion.
35−data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
38+-- data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
36−
39+
37−-- | Restreaming state.
40+-- -- | Restreaming state.
38−data RS s
41+-- data RS s
39− = RS0 !s
42+-- = RS0 !s
40− | RS1 !s {-# UNPACK #-} !Word8
43+-- | RS1 !s {-# UNPACK #-} !Word8
41− | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
44+-- | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
42− | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
45+-- | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
43−
46+
44−-- | Strict pair.
47+-- -- | Strict pair.
45−data PairS a b = !a :*: !b
48+-- data PairS a b = !a :*: !b
46− -- deriving (Eq, Ord, Show)
49+-- -- deriving (Eq, Ord, Show)
47−infixl 2 :*:
50+-- infixl 2 :*:
48−
51+
49−-- | An intermediate result in a scan.
52+-- -- | An intermediate result in a scan.
50−data Scan s = Scan1 {-# UNPACK #-} !Char !s
53+-- data Scan s = Scan1 {-# UNPACK #-} !Char !s
51− | Scan2 {-# UNPACK #-} !Char !s
54+-- | Scan2 {-# UNPACK #-} !Char !s
52−
55+
53−-- | Intermediate result in a processing pipeline.
56+-- -- | Intermediate result in a processing pipeline.
54−data Step s a = Done
57+-- data Step s a = Done
55− | Skip !s
58+-- | Skip !s
56− | Yield !a !s
59+-- | Yield !a !s
57−
60+
58−{-
61+-- {-
59−instance (Show a) => Show (Step s a)
62+-- instance (Show a) => Show (Step s a)
60− where show Done = "Done"
63+-- where show Done = "Done"
61− show (Skip _) = "Skip"
64+-- show (Skip _) = "Skip"
62− show (Yield x _) = "Yield " ++ show x
65+-- show (Yield x _) = "Yield " ++ show x
63−-}
66+-- -}
64−
67+
65−instance (Eq a) => Eq (Stream a) where
68+-- instance (Eq a) => Eq (Stream a) where
66− (==) = eq
69+-- (==) = eq
67−
70+
68−instance (Ord a) => Ord (Stream a) where
71+-- instance (Ord a) => Ord (Stream a) where
69− compare = cmp
72+-- compare = cmp
70−
73+
71−-- The length hint in a Stream has two roles. If its value is zero,
74+-- -- The length hint in a Stream has two roles. If its value is zero,
72−-- we trust it, and treat the stream as empty. Otherwise, we treat it
75+-- -- we trust it, and treat the stream as empty. Otherwise, we treat it
73−-- as a hint: it should usually be accurate, so we use it when
76+-- -- as a hint: it should usually be accurate, so we use it when
74−-- unstreaming to decide what size array to allocate. However, the
77+-- -- unstreaming to decide what size array to allocate. However, the
75−-- unstreaming functions must be able to cope with the hint being too
78+-- -- unstreaming functions must be able to cope with the hint being too
76−-- small or too large.
79+-- -- small or too large.
77−--
80+-- --
78−-- The size hint tries to track the UTF-16 code points in a stream,
81+-- -- The size hint tries to track the UTF-16 code units in a stream,
79−-- but often counts the number of characters instead. It can easily
82+-- -- but often counts the number of code points instead. It can easily
80−-- undercount if, for instance, a transformed stream contains astral
83+-- -- undercount if, for instance, a transformed stream contains astral
81−-- plane characters (those above 0x10000).
84+-- -- plane code points (those above 0x10000).
82−
85+
83−data Stream a =
86+-- data Stream a =
84− forall s. Stream
87+-- forall s. Stream
85− (s -> Step s a) -- stepper function
88+-- (s -> Step s a) -- stepper function
86− !s -- current state
89+-- !s -- current state
87− !Size -- size hint
90+-- !Size -- size hint in code units
88−
91+
89−-- | /O(n)/ Determines if two streams are equal.
92+-- -- | /O(n)/ Determines if two streams are equal.
90−eq :: (Eq a) => Stream a -> Stream a -> Bool
93+-- eq :: (Eq a) => Stream a -> Stream a -> Bool
91−eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
94+-- eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
92− where
95+-- where
93− loop Done Done = True
96+-- loop Done Done = True
94− loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
97+-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
95− loop (Skip s1') x2 = loop (next1 s1') x2
98+-- loop (Skip s1') x2 = loop (next1 s1') x2
96− loop x1 (Skip s2') = loop x1 (next2 s2')
99+-- loop x1 (Skip s2') = loop x1 (next2 s2')
97− loop Done _ = False
100+-- loop Done _ = False
98− loop _ Done = False
101+-- loop _ Done = False
99− loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
102+-- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
100− loop (next1 s1') (next2 s2')
103+-- loop (next1 s1') (next2 s2')
101−{-# INLINE [0] eq #-}
104+-- {-# INLINE [0] eq #-}
102−
105+
103−cmp :: (Ord a) => Stream a -> Stream a -> Ordering
106+-- cmp :: (Ord a) => Stream a -> Stream a -> Ordering
104−cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
107+-- cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
105− where
108+-- where
106− loop Done Done = EQ
109+-- loop Done Done = EQ
107− loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
110+-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
108− loop (Skip s1') x2 = loop (next1 s1') x2
111+-- loop (Skip s1') x2 = loop (next1 s1') x2
109− loop x1 (Skip s2') = loop x1 (next2 s2')
112+-- loop x1 (Skip s2') = loop x1 (next2 s2')
110− loop Done _ = LT
113+-- loop Done _ = LT
111− loop _ Done = GT
114+-- loop _ Done = GT
112− loop (Yield x1 s1') (Yield x2 s2') =
115+-- loop (Yield x1 s1') (Yield x2 s2') =
113− case compare x1 x2 of
116+-- case compare x1 x2 of
114− EQ -> loop (next1 s1') (next2 s2')
117+-- EQ -> loop (next1 s1') (next2 s2')
115− other -> other
118+-- other -> other
116−{-# INLINE [0] cmp #-}
119+-- {-# INLINE [0] cmp #-}
117−
120+
118−-- | The empty stream.
121+-- -- | The empty stream.
119−empty :: Stream a
122+-- empty :: Stream a
120−empty = Stream next () 0
123+-- empty = Stream next () 0
121− where next _ = Done
124+-- where next _ = Done
122−{-# INLINE [0] empty #-}
125+-- {-# INLINE [0] empty #-}
Data/Text/Internal/IO.hs+8
@@ -95,7 +95,11 @@ unpack !buf !r !w
95 | r >= w = return T.empty
95 | r >= w = return T.empty
96 | otherwise = withRawBuffer buf go
96 | otherwise = withRawBuffer buf go
97 where
97 where
98+#ifndef __GHCJS__
98 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))
99 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))
100+#else
101+ go pbuf = return $! unstream (Stream next r)
102+#endif
99 where
103 where
100 next !i | i >= w = Done
104 next !i | i >= w = Done
101 | otherwise = Yield (ix i) (i+1)
105 | otherwise = Yield (ix i) (i+1)
@@ -108,7 +112,11 @@ unpack_nl !buf !r !w
108 | otherwise = withRawBuffer buf $ go
112 | otherwise = withRawBuffer buf $ go
109 where
113 where
110 go pbuf = do
114 go pbuf = do
115+#ifndef __GHCJS__
111 let !t = unstream (Stream next r (maxSize (w-r)))
116 let !t = unstream (Stream next r (maxSize (w-r)))
117+#else
118+ let !t = unstream (Stream next r)
119+#endif
112 w' = w - 1
120 w' = w - 1
113 return $ if ix w' == '\r'
121 return $ if ix w' == '\r'
114 then (t,w')
122 then (t,w')
Data/Text/Internal/Lazy.hs+20−1
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
1+{-# LANGUAGE BangPatterns, DeriveDataTypeable, CPP #-}
2{-# OPTIONS_HADDOCK not-home #-}
2{-# OPTIONS_HADDOCK not-home #-}
3
3
4-- |
4-- |
@@ -44,6 +44,10 @@ import Data.Typeable (Typeable)
44import Foreign.Storable (sizeOf)
44import Foreign.Storable (sizeOf)
45import qualified Data.Text.Internal as T
45import qualified Data.Text.Internal as T
46
46
47+#ifdef __GHCJS__
48+import qualified Data.Text as TT
49+#endif
50+
47data Text = Empty
51data Text = Empty
48 | Chunk {-# UNPACK #-} !T.Text Text
52 | Chunk {-# UNPACK #-} !T.Text Text
49 deriving (Typeable)
53 deriving (Typeable)
@@ -57,16 +61,26 @@ data Text = Empty
57-- | Check the invariant strictly.
61-- | Check the invariant strictly.
58strictInvariant :: Text -> Bool
62strictInvariant :: Text -> Bool
59strictInvariant Empty = True
63strictInvariant Empty = True
64+#ifndef __GHCJS__
60strictInvariant x@(Chunk (T.Text _ _ len) cs)
65strictInvariant x@(Chunk (T.Text _ _ len) cs)
61 | len > 0 = strictInvariant cs
66 | len > 0 = strictInvariant cs
67+#else
68+strictInvariant x@(Chunk t cs)
69+ | TT.length t > 0 = strictInvariant cs
70+#endif
62 | otherwise = error $ "Data.Text.Lazy: invariant violation: "
71 | otherwise = error $ "Data.Text.Lazy: invariant violation: "
63 ++ showStructure x
72 ++ showStructure x
64
73
65-- | Check the invariant lazily.
74-- | Check the invariant lazily.
66lazyInvariant :: Text -> Text
75lazyInvariant :: Text -> Text
67lazyInvariant Empty = Empty
76lazyInvariant Empty = Empty
77+#ifndef __GHCJS__
68lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
78lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
69 | len > 0 = Chunk c (lazyInvariant cs)
79 | len > 0 = Chunk c (lazyInvariant cs)
80+#else
81+lazyInvariant x@(Chunk c cs)
82+ | TT.length c > 0 = Chunk c (lazyInvariant cs)
83+#endif
70 | otherwise = error $ "Data.Text.Lazy: invariant violation: "
84 | otherwise = error $ "Data.Text.Lazy: invariant violation: "
71 ++ showStructure x
85 ++ showStructure x
72
86
@@ -80,8 +94,13 @@ showStructure (Chunk t ts) =
80-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
94-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
81chunk :: T.Text -> Text -> Text
95chunk :: T.Text -> Text -> Text
82{-# INLINE chunk #-}
96{-# INLINE chunk #-}
97+#ifndef __GHCJS__
83chunk t@(T.Text _ _ len) ts | len == 0 = ts
98chunk t@(T.Text _ _ len) ts | len == 0 = ts
84 | otherwise = Chunk t ts
99 | otherwise = Chunk t ts
100+#else
101+chunk t ts | TT.null t = ts
102+ | otherwise = Chunk t ts
103+#endif
85
104
86-- | Smart constructor for 'Empty'.
105-- | Smart constructor for 'Empty'.
87empty :: Text
106empty :: Text
Data/Text/Internal/Lazy/Encoding/Fusion.hs+26
@@ -38,7 +38,9 @@ import qualified Data.ByteString.Unsafe as B
38import Data.Text.Internal.Encoding.Fusion.Common
38import Data.Text.Internal.Encoding.Fusion.Common
39import Data.Text.Encoding.Error
39import Data.Text.Encoding.Error
40import Data.Text.Internal.Fusion (Step(..), Stream(..))
40import Data.Text.Internal.Fusion (Step(..), Stream(..))
41+#ifndef __GHCJS__
41import Data.Text.Internal.Fusion.Size
42import Data.Text.Internal.Fusion.Size
43+#endif
42import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
44import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
43import Data.Text.Internal.Unsafe.Shift (shiftL)
45import Data.Text.Internal.Unsafe.Shift (shiftL)
44import Data.Word (Word8, Word16, Word32)
46import Data.Word (Word8, Word16, Word32)
@@ -65,7 +67,11 @@ data T = T !ByteString !S {-# UNPACK #-} !Int
65-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
67-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
66-- UTF-8 encoding.
68-- UTF-8 encoding.
67streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
69streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
70+#ifndef __GHCJS__
68streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize
71streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize
72+#else
73+streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
74+#endif
69 where
75 where
70 next (T bs@(Chunk ps _) S0 i)
76 next (T bs@(Chunk ps _) S0 i)
71 | i < len && U8.validate1 a =
77 | i < len && U8.validate1 a =
@@ -107,7 +113,11 @@ streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize
107-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
113-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
108-- endian UTF-16 encoding.
114-- endian UTF-16 encoding.
109streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
115streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
116+#ifndef __GHCJS__
110streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
117streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
118+#else
119+streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
120+#endif
111 where
121 where
112 next (T bs@(Chunk ps _) S0 i)
122 next (T bs@(Chunk ps _) S0 i)
113 | i + 1 < len && U16.validate1 x1 =
123 | i + 1 < len && U16.validate1 x1 =
@@ -147,7 +157,11 @@ streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
157-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
148-- endian UTF-16 encoding.
158-- endian UTF-16 encoding.
149streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
159streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
160+#ifndef __GHCJS__
150streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
161streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
162+#else
163+streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
164+#endif
151 where
165 where
152 next (T bs@(Chunk ps _) S0 i)
166 next (T bs@(Chunk ps _) S0 i)
153 | i + 1 < len && U16.validate1 x1 =
167 | i + 1 < len && U16.validate1 x1 =
@@ -187,7 +201,11 @@ streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
187-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
201-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
188-- endian UTF-32 encoding.
202-- endian UTF-32 encoding.
189streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
203streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
204+#ifndef __GHCJS__
190streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
205streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
206+#else
207+streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
208+#endif
191 where
209 where
192 next (T bs@(Chunk ps _) S0 i)
210 next (T bs@(Chunk ps _) S0 i)
193 | i + 3 < len && U32.validate x =
211 | i + 3 < len && U32.validate x =
@@ -231,7 +249,11 @@ streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
231-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
249-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
232-- endian UTF-32 encoding.
250-- endian UTF-32 encoding.
233streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
251streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
252+#ifndef __GHCJS__
234streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
253streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
254+#else
255+streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
256+#endif
235 where
257 where
236 next (T bs@(Chunk ps _) S0 i)
258 next (T bs@(Chunk ps _) S0 i)
237 | i + 3 < len && U32.validate x =
259 | i + 3 < len && U32.validate x =
@@ -274,7 +296,11 @@ streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
274
296
275-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
297-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
276unstreamChunks :: Int -> Stream Word8 -> ByteString
298unstreamChunks :: Int -> Stream Word8 -> ByteString
299+#ifndef __GHCJS__
277unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
300unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
301+#else
302+unstreamChunks chunkSize (Stream next s0) = chunk s0 4
303+#endif
278 where chunk s1 len1 = unsafeDupablePerformIO $ do
304 where chunk s1 len1 = unsafeDupablePerformIO $ do
279 let len = max 4 (min len1 chunkSize)
305 let len = max 4 (min len1 chunkSize)
280 mallocByteString len >>= loop len 0 s1
306 mallocByteString len >>= loop len 0 s1
Data/Text/Internal/Lazy/Fusion.hs+62
@@ -1,4 +1,10 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2+{-# LANGUAGE CPP #-}
3+#ifdef __GHCJS__
4+{-# LANGUAGE ForeignFunctionInterface #-}
5+{-# LANGUAGE MagicHash #-}
6+{-# LANGUAGE UnliftedFFITypes #-}
7+#endif
2-- |
8-- |
3-- Module : Data.Text.Lazy.Fusion
9-- Module : Data.Text.Lazy.Fusion
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
10-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
@@ -29,7 +35,14 @@ import Prelude hiding (length)
29import qualified Data.Text.Internal.Fusion.Common as S
35import qualified Data.Text.Internal.Fusion.Common as S
30import Control.Monad.ST (runST)
36import Control.Monad.ST (runST)
31import Data.Text.Internal.Fusion.Types
37import Data.Text.Internal.Fusion.Types
38+#ifndef __GHCJS__
32import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)
39import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)
40+#else
41+import Data.JSString (JSString)
42+import qualified Data.JSString as JSS
43+import GHC.Base (Int(..))
44+import GHC.Exts (ByteArray#, Int#)
45+#endif
33import Data.Text.Internal.Lazy
46import Data.Text.Internal.Lazy
34import qualified Data.Text.Internal as I
47import qualified Data.Text.Internal as I
35import qualified Data.Text.Array as A
48import qualified Data.Text.Array as A
@@ -42,6 +55,7 @@ default(Int64)
42
55
43-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
56-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
44stream :: Text -> Stream Char
57stream :: Text -> Stream Char
58+#ifndef __GHCJS__
45stream text = Stream next (text :*: 0) unknownSize
59stream text = Stream next (text :*: 0) unknownSize
46 where
60 where
47 next (Empty :*: _) = Done
61 next (Empty :*: _) = Done
@@ -49,11 +63,22 @@ stream text = Stream next (text :*: 0) unknownSize
49 | i >= len = next (ts :*: 0)
63 | i >= len = next (ts :*: 0)
50 | otherwise = Yield c (txt :*: i+d)
64 | otherwise = Yield c (txt :*: i+d)
51 where Iter c d = iter t i
65 where Iter c d = iter t i
66+#else
67+stream text = Stream next (text :*: 0) -- unknownSize
68+ where
69+ next (Empty :*: _) = Done
70+ next (txt@(Chunk t@(I.Text jst) ts) :*: i)
71+ | i >= JSS.length jst = next (ts :*: 0)
72+ | otherwise = Yield c (txt :*: i+d)
73+ where Iter c d = iter t i
74+#endif
52{-# INLINE [0] stream #-}
75{-# INLINE [0] stream #-}
53
76
77+-- TODO
54-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
78-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
55-- chunk size.
79-- chunk size.
56unstreamChunks :: Int -> Stream Char -> Text
80unstreamChunks :: Int -> Stream Char -> Text
81+#ifndef __GHCJS__
57unstreamChunks !chunkSize (Stream next s0 len0)
82unstreamChunks !chunkSize (Stream next s0 len0)
58 | isEmpty len0 = Empty
83 | isEmpty len0 = Empty
59 | otherwise = outer s0
84 | otherwise = outer s0
@@ -84,6 +109,36 @@ unstreamChunks !chunkSize (Stream next s0 len0)
84 finish marr len s' = do
109 finish marr len s' = do
85 arr <- A.unsafeFreeze marr
110 arr <- A.unsafeFreeze marr
86 return (I.Text arr 0 len `Chunk` outer s')
111 return (I.Text arr 0 len `Chunk` outer s')
112+#else
113+unstreamChunks !chunkSize (Stream next s0) = outer s0
114+ where
115+ outer so = {-# SCC "unstreamChunks/outer" #-}
116+ case next so of
117+ Done -> Empty
118+ Skip s' -> outer s'
119+ Yield x s' -> runST $ do
120+ a <- A.new unknownLength
121+ unsafeWrite a 0 x >>= inner a unknownLength s'
122+ where unknownLength = 4
123+ where
124+ inner marr !len s !i
125+ | i + 1 >= chunkSize = finish marr i s
126+ | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do
127+ let newLen = min (len `shiftL` 1) chunkSize
128+ marr' <- A.new newLen
129+ A.copyM marr' 0 marr 0 len
130+ inner marr' newLen s i
131+ | otherwise =
132+ {-# SCC "unstreamChunks/inner" #-}
133+ case next s of
134+ Done -> finish marr i s
135+ Skip s' -> inner marr len s' i
136+ Yield x s' -> do d <- unsafeWrite marr i x
137+ inner marr len s' (i+d)
138+ finish marr (I# len#) s' = do
139+ arr <- A.unsafeFreeze marr
140+ return (I.Text (js_toString (A.aBA arr) 0# len#) `Chunk` outer s')
141+#endif
87{-# INLINE [0] unstreamChunks #-}
142{-# INLINE [0] unstreamChunks #-}
88
143
89-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
144-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
@@ -118,3 +173,10 @@ index = S.indexI
118countChar :: Char -> Stream Char -> Int64
173countChar :: Char -> Stream Char -> Int64
119countChar = S.countCharI
174countChar = S.countCharI
120{-# INLINE [0] countChar #-}
175{-# INLINE [0] countChar #-}
176+
177+#ifdef __GHCJS__
178+foreign import javascript unsafe
179+ "h$textToString"
180+ js_toString :: ByteArray# -> Int# -> Int# -> JSString
181+#endif
182+
Data/Text/Internal/Lazy/Search.hs+55−11
@@ -1,4 +1,7 @@
1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
2+{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, JavaScriptFFI,
3+ UnboxedTuples, DeriveDataTypeable, GHCForeignImportPrim,
4+ MagicHash, FlexibleInstances, BangPatterns, Rank2Types, CPP #-}
2
5
3-- |
6-- |
4-- Module : Data.Text.Lazy.Search
7-- Module : Data.Text.Lazy.Search
@@ -31,6 +34,17 @@ import Data.Text.Internal.Lazy (Text(..), foldlChunks)
31import Data.Bits ((.|.), (.&.))
34import Data.Bits ((.|.), (.&.))
32import Data.Text.Internal.Unsafe.Shift (shiftL)
35import Data.Text.Internal.Unsafe.Shift (shiftL)
33
36
37+import Data.JSString (JSString)
38+import qualified Data.Text as TT
39+import GHC.Exts (Int(..), Int#, ByteArray#)
40+
41+foreign import javascript unsafe
42+ "h$textFromString"
43+ js_fromString :: JSString -> (# ByteArray#, Int# #)
44+
45+fromString :: T.Text -> (# ByteArray#, Int# #)
46+fromString (T.Text txt) = js_fromString txt
47+
34-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
48-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
35-- @needle@ within @haystack@.
49-- @needle@ within @haystack@.
36--
50--
@@ -47,8 +61,10 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
47 | nlen == 1 = indicesOne (nindex 0) 0 k ks
61 | nlen == 1 = indicesOne (nindex 0) 0 k ks
48 | otherwise = advance k ks 0 0
62 | otherwise = advance k ks 0 0
49 where
63 where
50− advance x@(T.Text _ _ l) xs = scan
64+ -- advance x@(T.Text _ _ l) xs = scan
65+ advance x xs = scan
51 where
66 where
67+ l = TT.length x
52 scan !g !i
68 scan !g !i
53 | i >= m = case xs of
69 | i >= m = case xs of
54 Empty -> []
70 Empty -> []
@@ -72,11 +88,23 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
72 nlast = nlen - 1
88 nlast = nlen - 1
73 nindex = index n ns
89 nindex = index n ns
74 z = foldlChunks fin 0 needle
90 z = foldlChunks fin 0 needle
91+ where
92+ -- fin _ (T.Text farr foff flen) =
93+ fin _ t =
94+ let foff = 0
95+ (farr, flen) =
96+ let (# ba, len #) = fromString t
97+ in (A.Array ba, I# len)
75− where fin _ (T.Text farr foff flen) = A.unsafeIndex farr (foff+flen-1)
98+ in A.unsafeIndex farr (foff+flen-1)
76 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)
99 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)
77 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)
100 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)
78− buildTable (T.Text xarr xoff xlen) xs = go
101+ -- buildTable (T.Text xarr xoff xlen) xs = go
102+ buildTable t xs = go
79 where
103 where
104+ xoff = 0
105+ (xarr, xlen) =
106+ let (# ba, len #) = fromString t
107+ in (A.Array ba, I# len)
80 go !(g::Int64) !i !msk !skp
108 go !(g::Int64) !i !msk !skp
81 | i >= xlast = case xs of
109 | i >= xlast = case xs of
82 Empty -> (msk .|. swizzle z) :*: skp
110 Empty -> (msk .|. swizzle z) :*: skp
@@ -91,17 +119,22 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
91 -- given offset would fail.
119 -- given offset would fail.
92 lackingHay q = go 0
120 lackingHay q = go 0
93 where
121 where
94− go p (T.Text _ _ l) ps = p' < q && case ps of
122+ -- go p (T.Text _ _ l) ps = p' < q && case ps of
123+ go p t ps = p' < q && case ps of
95− Empty -> True
124+ Empty -> True
96− Chunk r rs -> go p' r rs
125+ Chunk r rs -> go p' r rs
126+ where
127+ l = TT.length t
97− where p' = p + fromIntegral l
128+ p' = p + fromIntegral l
129+
98indices _ _ = []
130indices _ _ = []
99
131
100-- | Fast index into a partly unpacked 'Text'. We take into account
132-- | Fast index into a partly unpacked 'Text'. We take into account
101-- the possibility that the caller might try to access one element
133-- the possibility that the caller might try to access one element
102-- past the end.
134-- past the end.
103index :: T.Text -> Text -> Int64 -> Word16
135index :: T.Text -> Text -> Int64 -> Word16
104−index (T.Text arr off len) xs !i
136+-- index (T.Text arr off len) xs !i
137+index t xs !i
105 | j < len = A.unsafeIndex arr (off+j)
138 | j < len = A.unsafeIndex arr (off+j)
106 | otherwise = case xs of
139 | otherwise = case xs of
107 Empty
140 Empty
@@ -110,14 +143,24 @@ index (T.Text arr off len) xs !i
110 -- should never happen, due to lackingHay above
143 -- should never happen, due to lackingHay above
111 | otherwise -> emptyError "index"
144 | otherwise -> emptyError "index"
112 Chunk c cs -> index c cs (i-fromIntegral len)
145 Chunk c cs -> index c cs (i-fromIntegral len)
146+ where
113− where j = fromIntegral i
147+ j = fromIntegral i
148+ off = 0
149+ (arr, len) =
150+ let (# ba, len' #) = fromString t
151+ in (A.Array ba, I# len')
114
152
115-- | A variant of 'indices' that scans linearly for a single 'Word16'.
153-- | A variant of 'indices' that scans linearly for a single 'Word16'.
116indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]
154indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]
117indicesOne c = chunk
155indicesOne c = chunk
118 where
156 where
119− chunk !i (T.Text oarr ooff olen) os = go 0
157+ -- chunk !i (T.Text oarr ooff olen) os = go 0
158+ chunk !i t os = go 0
120 where
159 where
160+ ooff = 0
161+ (oarr, olen) =
162+ let (# ba, len #) = fromString t
163+ in (A.Array ba, I# len)
121 go h | h >= olen = case os of
164 go h | h >= olen = case os of
122 Empty -> []
165 Empty -> []
123 Chunk y ys -> chunk (i+fromIntegral olen) y ys
166 Chunk y ys -> chunk (i+fromIntegral olen) y ys
@@ -128,7 +171,8 @@ indicesOne c = chunk
128-- | The number of 'Word16' values in a 'Text'.
171-- | The number of 'Word16' values in a 'Text'.
129wordLength :: Text -> Int64
172wordLength :: Text -> Int64
130wordLength = foldlChunks sumLength 0
173wordLength = foldlChunks sumLength 0
174+ where sumLength i t = i + fromIntegral (TT.length t)
131− where sumLength i (T.Text _ _ l) = i + fromIntegral l
175+ -- where sumLength i (T.Text _ _ l) = i + fromIntegral l
132
176
133emptyError :: String -> a
177emptyError :: String -> a
134emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")
178emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")
Data/Text/Internal/Private.hs+8−1
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}
1+{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples, CPP #-}
2
2
3-- |
3-- |
4-- Module : Data.Text.Internal.Private
4-- Module : Data.Text.Internal.Private
@@ -19,8 +19,12 @@ import Control.Monad.ST (ST, runST)
19import Data.Text.Internal (Text(..), text)
19import Data.Text.Internal (Text(..), text)
20import Data.Text.Unsafe (Iter(..), iter)
20import Data.Text.Unsafe (Iter(..), iter)
21import qualified Data.Text.Array as A
21import qualified Data.Text.Array as A
22+#ifdef __GHCJS__
23+import qualified Data.JSString as JSS
24+#endif
22
25
23span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
26span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
27+#ifndef __GHCJS__
24span_ p t@(Text arr off len) = (# hd,tl #)
28span_ p t@(Text arr off len) = (# hd,tl #)
25 where hd = text arr off k
29 where hd = text arr off k
26 tl = text arr (off+k) (len-k)
30 tl = text arr (off+k) (len-k)
@@ -28,6 +32,9 @@ span_ p t@(Text arr off len) = (# hd,tl #)
28 loop !i | i < len && p c = loop (i+d)
32 loop !i | i < len && p c = loop (i+d)
29 | otherwise = i
33 | otherwise = i
30 where Iter c d = iter t i
34 where Iter c d = iter t i
35+#else
36+span_ p (Text t) = let (# a, b #) = JSS.span_ p t in (# Text a, Text b #)
37+#endif
31{-# INLINE span_ #-}
38{-# INLINE span_ #-}
32
39
33runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
40runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
Data/Text/Internal/Search.hs+40−37
@@ -37,6 +37,8 @@ import Data.Text.Internal (Text(..))
37import Data.Bits ((.|.), (.&.))
37import Data.Bits ((.|.), (.&.))
38import Data.Text.Internal.Unsafe.Shift (shiftL)
38import Data.Text.Internal.Unsafe.Shift (shiftL)
39
39
40+import qualified Data.JSString.Internal.Search as JSS
41+
40data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
42data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
41
43
42-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
44-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
@@ -49,41 +51,42 @@ data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
49indices :: Text -- ^ Substring to search for (@needle@)
51indices :: Text -- ^ Substring to search for (@needle@)
50 -> Text -- ^ Text to search in (@haystack@)
52 -> Text -- ^ Text to search in (@haystack@)
51 -> [Int]
53 -> [Int]
54+indices = coerce JSS.indices
52−indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
55+-- indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
53− | nlen == 1 = scanOne (nindex 0)
56+-- | nlen == 1 = scanOne (nindex 0)
54− | nlen <= 0 || ldiff < 0 = []
57+-- | nlen <= 0 || ldiff < 0 = []
55− | otherwise = scan 0
58+-- | otherwise = scan 0
56− where
59+-- where
57− ldiff = hlen - nlen
60+-- ldiff = hlen - nlen
58− nlast = nlen - 1
61+-- nlast = nlen - 1
59− z = nindex nlast
62+-- z = nindex nlast
60− nindex k = A.unsafeIndex narr (noff+k)
63+-- nindex k = A.unsafeIndex narr (noff+k)
61− hindex k = A.unsafeIndex harr (hoff+k)
64+-- hindex k = A.unsafeIndex harr (hoff+k)
62− hindex' k | k == hlen = 0
65+-- hindex' k | k == hlen = 0
63− | otherwise = A.unsafeIndex harr (hoff+k)
66+-- | otherwise = A.unsafeIndex harr (hoff+k)
64− buildTable !i !msk !skp
67+-- buildTable !i !msk !skp
65− | i >= nlast = (msk .|. swizzle z) :* skp
68+-- | i >= nlast = (msk .|. swizzle z) :* skp
66− | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
69+-- | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
67− where c = nindex i
70+-- where c = nindex i
68− skp' | c == z = nlen - i - 2
71+-- skp' | c == z = nlen - i - 2
69− | otherwise = skp
72+-- | otherwise = skp
70− swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)
73+-- swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)
71− scan !i
74+-- scan !i
72− | i > ldiff = []
75+-- | i > ldiff = []
73− | c == z && candidateMatch 0 = i : scan (i + nlen)
76+-- | c == z && candidateMatch 0 = i : scan (i + nlen)
74− | otherwise = scan (i + delta)
77+-- | otherwise = scan (i + delta)
75− where c = hindex (i + nlast)
78+-- where c = hindex (i + nlast)
76− candidateMatch !j
79+-- candidateMatch !j
77− | j >= nlast = True
80+-- | j >= nlast = True
78− | hindex (i+j) /= nindex j = False
81+-- | hindex (i+j) /= nindex j = False
79− | otherwise = candidateMatch (j+1)
82+-- | otherwise = candidateMatch (j+1)
80− delta | nextInPattern = nlen + 1
83+-- delta | nextInPattern = nlen + 1
81− | c == z = skip + 1
84+-- | c == z = skip + 1
82− | otherwise = 1
85+-- | otherwise = 1
83− where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
86+-- where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
84− !(mask :* skip) = buildTable 0 0 (nlen-2)
87+-- !(mask :* skip) = buildTable 0 0 (nlen-2)
85− scanOne c = loop 0
88+-- scanOne c = loop 0
86− where loop !i | i >= hlen = []
89+-- where loop !i | i >= hlen = []
87− | hindex i == c = i : loop (i+1)
90+-- | hindex i == c = i : loop (i+1)
88− | otherwise = loop (i+1)
91+-- | otherwise = loop (i+1)
89{-# INLINE indices #-}
92{-# INLINE indices #-}
Data/Text/Lazy.hs+103−21
@@ -6,14 +6,15 @@
6#if __GLASGOW_HASKELL__ >= 708
6#if __GLASGOW_HASKELL__ >= 708
7{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeFamilies #-}
8#endif
8#endif
9−
9+#ifdef __GHCJS__
10+{-# LANGUAGE ForeignFunctionInterface #-}
11+#endif
10-- |
12-- |
11-- Module : Data.Text.Lazy
13-- Module : Data.Text.Lazy
12-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
14-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
13--
15--
14-- License : BSD-style
16-- License : BSD-style
15-- Maintainer : bos@serpentine.com
17-- Maintainer : bos@serpentine.com
16−-- Stability : experimental
17-- Portability : GHC
18-- Portability : GHC
18--
19--
19-- A time and space-efficient implementation of Unicode text using
20-- A time and space-efficient implementation of Unicode text using
@@ -68,6 +69,7 @@ module Data.Text.Lazy
68 , snoc
69 , snoc
69 , append
70 , append
70 , uncons
71 , uncons
72+ , unsnoc
71 , head
73 , head
72 , last
74 , last
73 , tail
75 , tail
@@ -244,6 +246,9 @@ import GHC.Prim (Addr#)
244#if MIN_VERSION_base(4,7,0)
246#if MIN_VERSION_base(4,7,0)
245import Text.Printf (PrintfArg, formatArg, formatString)
247import Text.Printf (PrintfArg, formatArg, formatString)
246#endif
248#endif
249+#ifdef __GHCJS__
250+import Data.JSString (JSString)
251+#endif
247
252
248-- $fusion
253-- $fusion
249--
254--
@@ -273,14 +278,16 @@ import Text.Printf (PrintfArg, formatArg, formatString)
273-- $replacement
278-- $replacement
274--
279--
275-- A 'Text' value is a sequence of Unicode scalar values, as defined
280-- A 'Text' value is a sequence of Unicode scalar values, as defined
281+-- in
276−-- in &#xa7;3.9, definition D76 of the Unicode 5.2 standard:
282+-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.
277−-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35>. As
278−-- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF
283+-- As such, a 'Text' cannot contain values in the range U+D800 to
279−-- inclusive. Haskell implementations admit all Unicode code points
284+-- U+DFFF inclusive. Haskell implementations admit all Unicode code
285+-- points
286+-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)
280−-- (&#xa7;3.4, definition D10) as 'Char' values, including code points
287+-- as 'Char' values, including code points from this invalid range.
281−-- from this invalid range. This means that there are some 'Char'
288+-- This means that there are some 'Char' values that are not valid
282−-- values that are not valid Unicode scalar values, and the functions
289+-- Unicode scalar values, and the functions in this module must handle
283−-- in this module must handle those cases.
290+-- those cases.
284--
291--
285-- Within this module, many functions construct a 'Text' from one or
292-- Within this module, many functions construct a 'Text' from one or
286-- more 'Char' values. Those functions will substitute 'Char' values
293-- more 'Char' values. Those functions will substitute 'Char' values
@@ -294,8 +301,8 @@ import Text.Printf (PrintfArg, formatArg, formatString)
294-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
301-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
295-- code points, and so cannot be represented. The functions replace
302-- code points, and so cannot be represented. The functions replace
296-- invalid scalar values, instead of dropping them, as a security
303-- invalid scalar values, instead of dropping them, as a security
297−-- measure. For details, see Unicode Technical Report 36, &#xa7;3.5:
304+-- measure. For details, see
298−-- <http://unicode.org/reports/tr36#Deletion_of_Noncharacters>)
305+-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)
299
306
300equal :: Text -> Text -> Bool
307equal :: Text -> Text -> Bool
301equal Empty Empty = True
308equal Empty Empty = True
@@ -324,6 +331,7 @@ compareText Empty _ = LT
324compareText _ Empty = GT
331compareText _ Empty = GT
325compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
332compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
326 where
333 where
334+#ifndef __GHCJS__
327 outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
335 outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
328 where
336 where
329 go !i !j
337 go !i !j
@@ -334,6 +342,20 @@ compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
334 | otherwise = go (i+di) (j+dj)
342 | otherwise = go (i+di) (j+dj)
335 where T.Iter a di = T.iter ta i
343 where T.Iter a di = T.iter ta i
336 T.Iter b dj = T.iter tb j
344 T.Iter b dj = T.iter tb j
345+#else
346+ outer ta@(T.Text jsa) tb@(T.Text jsb) = go 0 0
347+ where
348+ go !i !j
349+ | i >= lenA = compareText as (chunk (T.Text (js_substr1 j jsb)) bs)
350+ | j >= lenB = compareText (chunk (T.Text (js_substr1 i jsa)) as) bs
351+ | a < b = LT
352+ | a > b = GT
353+ | otherwise = go (i+di) (j+dj)
354+ where T.Iter a di = T.iter ta i
355+ T.Iter b dj = T.iter tb j
356+ lenA = T.length ta
357+ lenB = T.length tb
358+#endif
337
359
338instance Show Text where
360instance Show Text where
339 showsPrec p ps r = showsPrec p (unpack ps) r
361 showsPrec p ps r = showsPrec p (unpack ps) r
@@ -342,9 +364,13 @@ instance Read Text where
342 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
364 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
343
365
344#if MIN_VERSION_base(4,9,0)
366#if MIN_VERSION_base(4,9,0)
367+-- | Non-orphan 'Semigroup' instance only defined for
345−-- Semigroup orphan instances for older GHCs are provided by
368+-- @base-4.9.0.0@ and later; orphan instances for older GHCs are
369+-- provided by
370+-- the [semigroups](http://hackage.haskell.org/package/semigroups)
346−-- 'semigroups` package
371+-- package
347−
372+--
373+-- @since 1.2.2.0
348instance Semigroup Text where
374instance Semigroup Text where
349 (<>) = append
375 (<>) = append
350#endif
376#endif
@@ -362,6 +388,7 @@ instance IsString Text where
362 fromString = pack
388 fromString = pack
363
389
364#if __GLASGOW_HASKELL__ >= 708
390#if __GLASGOW_HASKELL__ >= 708
391+-- | @since 1.2.0.0
365instance Exts.IsList Text where
392instance Exts.IsList Text where
366 type Item Text = Char
393 type Item Text = Char
367 fromList = pack
394 fromList = pack
@@ -374,6 +401,7 @@ instance NFData Text where
374 rnf (Chunk _ ts) = rnf ts
401 rnf (Chunk _ ts) = rnf ts
375#endif
402#endif
376
403
404+-- | @since 1.2.1.0
377instance Binary Text where
405instance Binary Text where
378 put t = put (encodeUtf8 t)
406 put t = put (encodeUtf8 t)
379 get = do
407 get = do
@@ -397,6 +425,8 @@ instance Data Text where
397
425
398#if MIN_VERSION_base(4,7,0)
426#if MIN_VERSION_base(4,7,0)
399-- | Only defined for @base-4.7.0.0@ and later
427-- | Only defined for @base-4.7.0.0@ and later
428+--
429+-- @since 1.2.2.0
400instance PrintfArg Text where
430instance PrintfArg Text where
401 formatArg txt = formatString $ unpack txt
431 formatArg txt = formatString $ unpack txt
402#endif
432#endif
@@ -475,9 +505,7 @@ fromStrict t = chunk t Empty
475-- -----------------------------------------------------------------------------
505-- -----------------------------------------------------------------------------
476-- * Basic functions
506-- * Basic functions
477
507
478−-- | /O(n)/ Adds a character to the front of a 'Text'. This function
508+-- | /O(1)/ Adds a character to the front of a 'Text'. Subject to fusion.
479−-- is more costly than its 'List' counterpart because it requires
480−-- copying a new array. Subject to fusion.
481cons :: Char -> Text -> Text
509cons :: Char -> Text -> Text
482cons c t = Chunk (T.singleton c) t
510cons c t = Chunk (T.singleton c) t
483{-# INLINE [1] cons #-}
511{-# INLINE [1] cons #-}
@@ -561,6 +589,17 @@ init Empty = emptyError "init"
561 unstream (S.init (stream t)) = init t
589 unstream (S.init (stream t)) = init t
562 #-}
590 #-}
563
591
592+-- | /O(n\/c)/ Returns the 'init' and 'last' of a 'Text', or 'Nothing' if
593+-- empty.
594+--
595+-- * It is no faster than using 'init' and 'last'.
596+--
597+-- @since 1.2.3.0
598+unsnoc :: Text -> Maybe (Text, Char)
599+unsnoc Empty = Nothing
600+unsnoc ts@(Chunk _ _) = Just (init ts, last ts)
601+{-# INLINE unsnoc #-}
602+
564-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
603-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
565-- fusion.
604-- fusion.
566null :: Text -> Bool
605null :: Text -> Bool
@@ -820,6 +859,8 @@ toUpper t = unstream (S.toUpper (stream t))
820-- guides disagree on whether the book name \"The Hill of the Red
859-- guides disagree on whether the book name \"The Hill of the Red
821-- Fox\" is correctly title cased&#x2014;but this function will
860-- Fox\" is correctly title cased&#x2014;but this function will
822-- capitalize /every/ word.
861-- capitalize /every/ word.
862+--
863+-- @since 1.0.0.0
823toTitle :: Text -> Text
864toTitle :: Text -> Text
824toTitle t = unstream (S.toTitle (stream t))
865toTitle t = unstream (S.toTitle (stream t))
825{-# INLINE toTitle #-}
866{-# INLINE toTitle #-}
@@ -972,6 +1013,8 @@ mapAccumR f = go
972
1013
973-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every
1014-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every
974-- element.
1015-- element.
1016+--
1017+-- @since 1.2.0.5
975repeat :: Char -> Text
1018repeat :: Char -> Text
976repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t
1019repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t
977 in t
1020 in t
@@ -989,6 +1032,8 @@ replicate n t
989
1032
990-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or
1033-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or
991-- equivalently, the infinite repetition of the original 'Text'.
1034-- equivalently, the infinite repetition of the original 'Text'.
1035+--
1036+-- @since 1.2.0.5
992cycle :: Text -> Text
1037cycle :: Text -> Text
993cycle Empty = emptyError "cycle"
1038cycle Empty = emptyError "cycle"
994cycle t = let t' = foldrChunks Chunk t' t
1039cycle t = let t' = foldrChunks Chunk t' t
@@ -998,6 +1043,8 @@ cycle t = let t' = foldrChunks Chunk t' t
998-- of @f@ to @x@:
1043-- of @f@ to @x@:
999--
1044--
1000-- > iterate f x == [x, f x, f (f x), ...]
1045-- > iterate f x == [x, f x, f (f x), ...]
1046+--
1047+-- @since 1.2.0.5
1001iterate :: (Char -> Char) -> Char -> Text
1048iterate :: (Char -> Char) -> Char -> Text
1002iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))
1049iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))
1003 in t c
1050 in t c
@@ -1061,6 +1108,8 @@ take i t0 = take' i t0
1061-- Examples:
1108-- Examples:
1062--
1109--
1063-- > takeEnd 3 "foobar" == "bar"
1110-- > takeEnd 3 "foobar" == "bar"
1111+--
1112+-- @since 1.1.1.0
1064takeEnd :: Int64 -> Text -> Text
1113takeEnd :: Int64 -> Text -> Text
1065takeEnd n t0
1114takeEnd n t0
1066 | n <= 0 = empty
1115 | n <= 0 = empty
@@ -1099,6 +1148,8 @@ drop i t0
1099-- Examples:
1148-- Examples:
1100--
1149--
1101-- > dropEnd 3 "foobar" == "foo"
1150-- > dropEnd 3 "foobar" == "foo"
1151+--
1152+-- @since 1.1.1.0
1102dropEnd :: Int64 -> Text -> Text
1153dropEnd :: Int64 -> Text -> Text
1103dropEnd n t0
1154dropEnd n t0
1104 | n <= 0 = t0
1155 | n <= 0 = t0
@@ -1119,11 +1170,20 @@ dropWords i t0
1119 | otherwise = drop' i t0
1170 | otherwise = drop' i t0
1120 where drop' 0 ts = ts
1171 where drop' 0 ts = ts
1121 drop' _ Empty = Empty
1172 drop' _ Empty = Empty
1173+#ifndef __GHCJS__
1122 drop' n (Chunk (T.Text arr off len) ts)
1174 drop' n (Chunk (T.Text arr off len) ts)
1123 | n < len' = chunk (text arr (off+n') (len-n')) ts
1175 | n < len' = chunk (text arr (off+n') (len-n')) ts
1124 | otherwise = drop' (n - len') ts
1176 | otherwise = drop' (n - len') ts
1125 where len' = fromIntegral len
1177 where len' = fromIntegral len
1126 n' = fromIntegral n
1178 n' = fromIntegral n
1179+#else
1180+ drop' n (Chunk t@(T.Text jst) ts)
1181+ | n < len' = chunk (T.Text $ js_substr1 n' jst) ts
1182+ | otherwise = drop' (n - len') ts
1183+ where len' = fromIntegral len
1184+ len = T.length t
1185+ n' = fromIntegral n
1186+#endif
1127
1187
1128-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1188-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1129-- returns the longest prefix (possibly empty) of elements that
1189-- returns the longest prefix (possibly empty) of elements that
@@ -1150,12 +1210,15 @@ takeWhile p t0 = takeWhile' t0
1150-- Examples:
1210-- Examples:
1151--
1211--
1152-- > takeWhileEnd (=='o') "foo" == "oo"
1212-- > takeWhileEnd (=='o') "foo" == "oo"
1213+--
1214+-- @since 1.2.2.0
1153takeWhileEnd :: (Char -> Bool) -> Text -> Text
1215takeWhileEnd :: (Char -> Bool) -> Text -> Text
1154takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1216takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1155 where takeChunk acc [] = acc
1217 where takeChunk acc [] = acc
1156− takeChunk acc (t:ts) = if T.length t' < T.length t
1218+ takeChunk acc (t:ts)
1157− then (Chunk t' acc)
1219+ | T.lengthWord16 t' < T.lengthWord16 t
1220+ = chunk t' acc
1158− else takeChunk (Chunk t' acc) ts
1221+ | otherwise = takeChunk (Chunk t' acc) ts
1159 where t' = T.takeWhileEnd p t
1222 where t' = T.takeWhileEnd p t
1160{-# INLINE takeWhileEnd #-}
1223{-# INLINE takeWhileEnd #-}
1161
1224
@@ -1244,12 +1307,22 @@ splitAt = loop
1244-- values, and whose second is the remainder of the string.
1307-- values, and whose second is the remainder of the string.
1245splitAtWord :: Int64 -> Text -> PairS Text Text
1308splitAtWord :: Int64 -> Text -> PairS Text Text
1246splitAtWord _ Empty = empty :*: empty
1309splitAtWord _ Empty = empty :*: empty
1310+#ifndef __GHCJS__
1247splitAtWord x (Chunk c@(T.Text arr off len) cs)
1311splitAtWord x (Chunk c@(T.Text arr off len) cs)
1248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1312 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1249 in Chunk c h :*: t
1313 in Chunk c h :*: t
1250 | otherwise = chunk (text arr off y) empty :*:
1314 | otherwise = chunk (text arr off y) empty :*:
1251 chunk (text arr (off+y) (len-y)) cs
1315 chunk (text arr (off+y) (len-y)) cs
1252 where y = fromIntegral x
1316 where y = fromIntegral x
1317+#else
1318+splitAtWord x (Chunk c@(T.Text jst) cs)
1319+ | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1320+ in Chunk c h :*: t
1321+ | otherwise = chunk (T.Text (js_substr 0 (y-1) jst)) empty :*:
1322+ chunk (T.Text (js_substr1 y jst)) cs
1323+ where y = fromIntegral x
1324+ len = T.length c
1325+#endif
1253
1326
1254-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1327-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1255-- non-'null') in @haystack@. The first element of the returned tuple
1328-- non-'null') in @haystack@. The first element of the returned tuple
@@ -1429,7 +1502,11 @@ splitOn pat src
1429 go _ [] cs = [cs]
1502 go _ [] cs = [cs]
1430 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1503 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1431 in h : go (x+l) xs (dropWords l t)
1504 in h : go (x+l) xs (dropWords l t)
1505+#ifndef __GHCJS__
1432 l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1506 l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1507+#else
1508+ l = foldlChunks (\a t -> a + fromIntegral (T.length t)) 0 pat
1509+#endif
1433{-# INLINE [1] splitOn #-}
1510{-# INLINE [1] splitOn #-}
1434
1511
1435{-# RULES
1512{-# RULES
@@ -1693,3 +1770,8 @@ emptyError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": empty input")
1693
1770
1694impossibleError :: String -> a
1771impossibleError :: String -> a
1695impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")
1772impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")
1773+
1774+#ifdef __GHCJS__
1775+foreign import javascript unsafe "$2.substr($1)" js_substr1 :: Exts.Int -> JSString -> JSString
1776+foreign import javascript unsafe "$3.substr($1,$2)" js_substr :: Exts.Int -> Exts.Int -> JSString -> JSString
1777+#endif
Data/Text/Lazy/Builder.hs−1
@@ -11,7 +11,6 @@
11-- License : BSD-style (see LICENSE)
11-- License : BSD-style (see LICENSE)
12--
12--
13-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
13-- Maintainer : Johan Tibell <johan.tibell@gmail.com>
14−-- Stability : experimental
15-- Portability : portable to Hugs and GHC
14-- Portability : portable to Hugs and GHC
16--
15--
17-- Efficient construction of lazy @Text@ values. The principal
16-- Efficient construction of lazy @Text@ values. The principal
Data/Text/Lazy/Builder/Int.hs+11−217
@@ -1,15 +1,8 @@
1−{-# LANGUAGE BangPatterns, CPP, MagicHash, RankNTypes, ScopedTypeVariables,
2− UnboxedTuples #-}
3−#if __GLASGOW_HASKELL__ >= 702
4−{-# LANGUAGE Trustworthy #-}
5−#endif
6−
7-- Module: Data.Text.Lazy.Builder.Int
1-- Module: Data.Text.Lazy.Builder.Int
8-- Copyright: (c) 2013 Bryan O'Sullivan
2-- Copyright: (c) 2013 Bryan O'Sullivan
9-- (c) 2011 MailRank, Inc.
3-- (c) 2011 MailRank, Inc.
10-- License: BSD-style
4-- License: BSD-style
11-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
5-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
12−-- Stability: experimental
13-- Portability: portable
6-- Portability: portable
14--
7--
15-- Efficiently write an integral value to a 'Builder'.
8-- Efficiently write an integral value to a 'Builder'.
@@ -20,6 +13,13 @@ module Data.Text.Lazy.Builder.Int
20 , hexadecimal
13 , hexadecimal
21 ) where
14 ) where
22
15
16+-- import Data.Text.Lazy (Text)
17+import qualified Data.Text.Lazy as L
18+import qualified Data.Text as T
19+import qualified Data.JSString.Int as JSS
20+import Data.Text.Internal (Text (..))
21+import Data.Text.Lazy.Builder
22+
23import Data.Int (Int8, Int16, Int32, Int64)
23import Data.Int (Int8, Int16, Int32, Int64)
24import Data.Monoid (mempty)
24import Data.Monoid (mempty)
25import qualified Data.ByteString.Unsafe as B
25import qualified Data.ByteString.Unsafe as B
@@ -32,6 +32,9 @@ import GHC.Base (quotInt, remInt)
32import GHC.Num (quotRemInteger)
32import GHC.Num (quotRemInteger)
33import GHC.Types (Int(..))
33import GHC.Types (Int(..))
34import Control.Monad.ST
34import Control.Monad.ST
35+#if MIN_VERSION_base(4,11,0)
36+import Prelude hiding ((<>))
37+#endif
35
38
36#ifdef __GLASGOW_HASKELL__
39#ifdef __GLASGOW_HASKELL__
37# if defined(INTEGER_GMP)
40# if defined(INTEGER_GMP)
@@ -50,213 +53,4 @@ import GHC.Integer
50#endif
53#endif
51
54
52decimal :: Integral a => a -> Builder
55decimal :: Integral a => a -> Builder
53−{-# RULES "decimal/Int8" decimal = boundedDecimal :: Int8 -> Builder #-}
56+decimal n = fromText $ Text $ JSS.decimal n
54−{-# RULES "decimal/Int" decimal = boundedDecimal :: Int -> Builder #-}
55−{-# RULES "decimal/Int16" decimal = boundedDecimal :: Int16 -> Builder #-}
56−{-# RULES "decimal/Int32" decimal = boundedDecimal :: Int32 -> Builder #-}
57−{-# RULES "decimal/Int64" decimal = boundedDecimal :: Int64 -> Builder #-}
58−{-# RULES "decimal/Word" decimal = positive :: Data.Word.Word -> Builder #-}
59−{-# RULES "decimal/Word8" decimal = positive :: Word8 -> Builder #-}
60−{-# RULES "decimal/Word16" decimal = positive :: Word16 -> Builder #-}
61−{-# RULES "decimal/Word32" decimal = positive :: Word32 -> Builder #-}
62−{-# RULES "decimal/Word64" decimal = positive :: Word64 -> Builder #-}
63−{-# RULES "decimal/Integer" decimal = integer 10 :: Integer -> Builder #-}
64−decimal i = decimal' (<= -128) i
65−{-# NOINLINE decimal #-}
66−
67−boundedDecimal :: (Integral a, Bounded a) => a -> Builder
68−{-# SPECIALIZE boundedDecimal :: Int -> Builder #-}
69−{-# SPECIALIZE boundedDecimal :: Int8 -> Builder #-}
70−{-# SPECIALIZE boundedDecimal :: Int16 -> Builder #-}
71−{-# SPECIALIZE boundedDecimal :: Int32 -> Builder #-}
72−{-# SPECIALIZE boundedDecimal :: Int64 -> Builder #-}
73−boundedDecimal i = decimal' (== minBound) i
74−
75−decimal' :: (Integral a) => (a -> Bool) -> a -> Builder
76−{-# INLINE decimal' #-}
77−decimal' p i
78− | i < 0 = if p i
79− then let (q, r) = i `quotRem` 10
80− qq = -q
81− !n = countDigits qq
82− in writeN (n + 2) $ \marr off -> do
83− unsafeWrite marr off minus
84− posDecimal marr (off+1) n qq
85− unsafeWrite marr (off+n+1) (i2w (-r))
86− else let j = -i
87− !n = countDigits j
88− in writeN (n + 1) $ \marr off ->
89− unsafeWrite marr off minus >> posDecimal marr (off+1) n j
90− | otherwise = positive i
91−
92−positive :: (Integral a) => a -> Builder
93−{-# SPECIALIZE positive :: Int -> Builder #-}
94−{-# SPECIALIZE positive :: Int8 -> Builder #-}
95−{-# SPECIALIZE positive :: Int16 -> Builder #-}
96−{-# SPECIALIZE positive :: Int32 -> Builder #-}
97−{-# SPECIALIZE positive :: Int64 -> Builder #-}
98−{-# SPECIALIZE positive :: Word -> Builder #-}
99−{-# SPECIALIZE positive :: Word8 -> Builder #-}
100−{-# SPECIALIZE positive :: Word16 -> Builder #-}
101−{-# SPECIALIZE positive :: Word32 -> Builder #-}
102−{-# SPECIALIZE positive :: Word64 -> Builder #-}
103−positive i
104− | i < 10 = writeN 1 $ \marr off -> unsafeWrite marr off (i2w i)
105− | otherwise = let !n = countDigits i
106− in writeN n $ \marr off -> posDecimal marr off n i
107−
108−posDecimal :: (Integral a) =>
109− forall s. MArray s -> Int -> Int -> a -> ST s ()
110−{-# INLINE posDecimal #-}
111−posDecimal marr off0 ds v0 = go (off0 + ds - 1) v0
112− where go off v
113− | v >= 100 = do
114− let (q, r) = v `quotRem` 100
115− write2 off r
116− go (off - 2) q
117− | v < 10 = unsafeWrite marr off (i2w v)
118− | otherwise = write2 off v
119− write2 off i0 = do
120− let i = fromIntegral i0; j = i + i
121− unsafeWrite marr off $ get (j + 1)
122− unsafeWrite marr (off - 1) $ get j
123− get = fromIntegral . B.unsafeIndex digits
124−
125−minus, zero :: Word16
126−{-# INLINE minus #-}
127−{-# INLINE zero #-}
128−minus = 45
129−zero = 48
130−
131−i2w :: (Integral a) => a -> Word16
132−{-# INLINE i2w #-}
133−i2w v = zero + fromIntegral v
134−
135−countDigits :: (Integral a) => a -> Int
136−{-# INLINE countDigits #-}
137−countDigits v0
138− | fromIntegral v64 == v0 = go 1 v64
139− | otherwise = goBig 1 (fromIntegral v0)
140− where v64 = fromIntegral v0
141− goBig !k (v :: Integer)
142− | v > big = goBig (k + 19) (v `quot` big)
143− | otherwise = go k (fromIntegral v)
144− big = 10000000000000000000
145− go !k (v :: Word64)
146− | v < 10 = k
147− | v < 100 = k + 1
148− | v < 1000 = k + 2
149− | v < 1000000000000 =
150− k + if v < 100000000
151− then if v < 1000000
152− then if v < 10000
153− then 3
154− else 4 + fin v 100000
155− else 6 + fin v 10000000
156− else if v < 10000000000
157− then 8 + fin v 1000000000
158− else 10 + fin v 100000000000
159− | otherwise = go (k + 12) (v `quot` 1000000000000)
160− fin v n = if v >= n then 1 else 0
161−
162−hexadecimal :: Integral a => a -> Builder
163−{-# SPECIALIZE hexadecimal :: Int -> Builder #-}
164−{-# SPECIALIZE hexadecimal :: Int8 -> Builder #-}
165−{-# SPECIALIZE hexadecimal :: Int16 -> Builder #-}
166−{-# SPECIALIZE hexadecimal :: Int32 -> Builder #-}
167−{-# SPECIALIZE hexadecimal :: Int64 -> Builder #-}
168−{-# SPECIALIZE hexadecimal :: Word -> Builder #-}
169−{-# SPECIALIZE hexadecimal :: Word8 -> Builder #-}
170−{-# SPECIALIZE hexadecimal :: Word16 -> Builder #-}
171−{-# SPECIALIZE hexadecimal :: Word32 -> Builder #-}
172−{-# SPECIALIZE hexadecimal :: Word64 -> Builder #-}
173−{-# RULES "hexadecimal/Integer"
174− hexadecimal = hexInteger :: Integer -> Builder #-}
175−hexadecimal i
176− | i < 0 = error hexErrMsg
177− | otherwise = go i
178− where
179− go n | n < 16 = hexDigit n
180− | otherwise = go (n `quot` 16) <> hexDigit (n `rem` 16)
181−{-# NOINLINE[0] hexadecimal #-}
182−
183−hexInteger :: Integer -> Builder
184−hexInteger i
185− | i < 0 = error hexErrMsg
186− | otherwise = integer 16 i
187−
188−hexErrMsg :: String
189−hexErrMsg = "Data.Text.Lazy.Builder.Int.hexadecimal: applied to negative number"
190−
191−hexDigit :: Integral a => a -> Builder
192−hexDigit n
193− | n <= 9 = singleton $! i2d (fromIntegral n)
194− | otherwise = singleton $! toEnum (fromIntegral n + 87)
195−{-# INLINE hexDigit #-}
196−
197−data T = T !Integer !Int
198−
199−integer :: Int -> Integer -> Builder
200−#ifdef INTEGER_GMP
201−integer 10 (S# i#) = decimal (I# i#)
202−integer 16 (S# i#) = hexadecimal (I# i#)
203−#endif
204−integer base i
205− | i < 0 = singleton '-' <> go (-i)
206− | otherwise = go i
207− where
208− go n | n < maxInt = int (fromInteger n)
209− | otherwise = putH (splitf (maxInt * maxInt) n)
210−
211− splitf p n
212− | p > n = [n]
213− | otherwise = splith p (splitf (p*p) n)
214−
215− splith p (n:ns) = case n `quotRemInteger` p of
216− PAIR(q,r) | q > 0 -> q : r : splitb p ns
217− | otherwise -> r : splitb p ns
218− splith _ _ = error "splith: the impossible happened."
219−
220− splitb p (n:ns) = case n `quotRemInteger` p of
221− PAIR(q,r) -> q : r : splitb p ns
222− splitb _ _ = []
223−
224− T maxInt10 maxDigits10 =
225− until ((>mi) . (*10) . fstT) (\(T n d) -> T (n*10) (d+1)) (T 10 1)
226− where mi = fromIntegral (maxBound :: Int)
227− T maxInt16 maxDigits16 =
228− until ((>mi) . (*16) . fstT) (\(T n d) -> T (n*16) (d+1)) (T 16 1)
229− where mi = fromIntegral (maxBound :: Int)
230−
231− fstT (T a _) = a
232−
233− maxInt | base == 10 = maxInt10
234− | otherwise = maxInt16
235− maxDigits | base == 10 = maxDigits10
236− | otherwise = maxDigits16
237−
238− putH (n:ns) = case n `quotRemInteger` maxInt of
239− PAIR(x,y)
240− | q > 0 -> int q <> pblock r <> putB ns
241− | otherwise -> int r <> putB ns
242− where q = fromInteger x
243− r = fromInteger y
244− putH _ = error "putH: the impossible happened"
245−
246− putB (n:ns) = case n `quotRemInteger` maxInt of
247− PAIR(x,y) -> pblock q <> pblock r <> putB ns
248− where q = fromInteger x
249− r = fromInteger y
250− putB _ = Data.Monoid.mempty
251−
252− int :: Int -> Builder
253− int x | base == 10 = decimal x
254− | otherwise = hexadecimal x
255−
256− pblock = loop maxDigits
257− where
258− loop !d !n
259− | d == 1 = hexDigit n
260− | otherwise = loop (d-1) q <> hexDigit r
261− where q = n `quotInt` base
262− r = n `remInt` base
Data/Text/Lazy/Builder/RealFloat.hs+20−15
@@ -11,19 +11,23 @@
11-- Write a floating point value to a 'Builder'.
11-- Write a floating point value to a 'Builder'.
12
12
13module Data.Text.Lazy.Builder.RealFloat
13module Data.Text.Lazy.Builder.RealFloat
14− (
14+ (
15− FPFormat(..)
15+ FPFormat(..)
16− , realFloat
16+ , realFloat
17− , formatRealFloat
17+ , formatRealFloat
18− ) where
18+ ) where
19−
19+
20−import Data.Array.Base (unsafeAt)
20+-- import Data.Array.Base (unsafeAt)
21−import Data.Array.IArray
21+-- import Data.Array.IArray
22import Data.Text.Internal.Builder.Functions ((<>), i2d)
22import Data.Text.Internal.Builder.Functions ((<>), i2d)
23import Data.Text.Lazy.Builder.Int (decimal)
23import Data.Text.Lazy.Builder.Int (decimal)
24import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
24import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
25import Data.Text.Lazy.Builder
25import Data.Text.Lazy.Builder
26import qualified Data.Text as T
26import qualified Data.Text as T
27+#if MIN_VERSION_base(4,11,0)
28+import Prelude hiding ((<>))
29+#endif
30+
27
31
28-- | Control the rendering of floating point numbers.
32-- | Control the rendering of floating point numbers.
29data FPFormat = Exponent
33data FPFormat = Exponent
@@ -33,7 +37,7 @@ data FPFormat = Exponent
33 | Generic
37 | Generic
34 -- ^ Use decimal notation for values between @0.1@ and
38 -- ^ Use decimal notation for values between @0.1@ and
35 -- @9,999,999@, and scientific notation otherwise.
39 -- @9,999,999@, and scientific notation otherwise.
36− deriving (Enum, Read, Show)
40+ deriving (Enum, Read, Show)
37
41
38-- | Show a signed 'RealFloat' value to full precision,
42-- | Show a signed 'RealFloat' value to full precision,
39-- using standard decimal notation for arguments whose absolute value lies
43-- using standard decimal notation for arguments whose absolute value lies
@@ -228,15 +232,16 @@ maxExpt = 1100
228
232
229expt :: Integer -> Int -> Integer
233expt :: Integer -> Int -> Integer
230expt base n
234expt base n
231− | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n
235+ | base == 2 && n >= minExpt && n <= maxExpt = expts !! n
232− | base == 10 && n <= maxExpt10 = expts10 `unsafeAt` n
236+ | base == 10 && n <= maxExpt10 = expts10 !! n
233 | otherwise = base^n
237 | otherwise = base^n
234
238
235−expts :: Array Int Integer
239+expts :: [Integer]
236−expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
240+expts = [2^n | n <- [minExpt .. maxExpt]]
237
241
238maxExpt10 :: Int
242maxExpt10 :: Int
239maxExpt10 = 324
243maxExpt10 = 324
240
244
241−expts10 :: Array Int Integer
245+expts10 :: [Integer]
242−expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]
246+expts10 = [10^n | n <- [minExpt .. maxExpt10]]
247+
Data/Text/Lazy/Encoding.hs+13−3
@@ -8,14 +8,13 @@
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10-- Maintainer : bos@serpentine.com
10-- Maintainer : bos@serpentine.com
11−-- Stability : experimental
12-- Portability : portable
11-- Portability : portable
13--
12--
14-- Functions for converting lazy 'Text' values to and from lazy
13-- Functions for converting lazy 'Text' values to and from lazy
15-- 'ByteString', using several standard encodings.
14-- 'ByteString', using several standard encodings.
16--
15--
17−-- To gain access to a much larger variety of encodings, use the
16+-- To gain access to a much larger family of encodings, use the
18−-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
17+-- <http://hackage.haskell.org/package/text-icu text-icu package>.
19
18
20module Data.Text.Lazy.Encoding
19module Data.Text.Lazy.Encoding
21 (
20 (
@@ -141,6 +140,7 @@ decodeUtf8' bs = unsafeDupablePerformIO $ do
141 rnf (Chunk _ ts) = rnf ts
140 rnf (Chunk _ ts) = rnf ts
142{-# INLINE decodeUtf8' #-}
141{-# INLINE decodeUtf8' #-}
143
142
143+-- | Encode text using UTF-8 encoding.
144encodeUtf8 :: Text -> B.ByteString
144encodeUtf8 :: Text -> B.ByteString
145encodeUtf8 Empty = B.empty
145encodeUtf8 Empty = B.empty
146encodeUtf8 lt@(Chunk t _) =
146encodeUtf8 lt@(Chunk t _) =
@@ -154,10 +154,20 @@ encodeUtf8 lt@(Chunk t _) =
154 firstChunkSize = min B.smallChunkSize (4 * (T.length t + 1))
154 firstChunkSize = min B.smallChunkSize (4 * (T.length t + 1))
155 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize
155 strategy = B.safeStrategy firstChunkSize B.defaultChunkSize
156
156
157+-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
158+--
159+-- @since 1.1.0.0
157encodeUtf8Builder :: Text -> B.Builder
160encodeUtf8Builder :: Text -> B.Builder
158encodeUtf8Builder =
161encodeUtf8Builder =
159 foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty
162 foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty
160
163
164+-- | Encode text using UTF-8 encoding and escape the ASCII characters using
165+-- a 'BP.BoundedPrim'.
166+--
167+-- Use this function is to implement efficient encoders for text-based formats
168+-- like JSON or HTML.
169+--
170+-- @since 1.1.0.0
161{-# INLINE encodeUtf8BuilderEscaped #-}
171{-# INLINE encodeUtf8BuilderEscaped #-}
162encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
172encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
163encodeUtf8BuilderEscaped prim =
173encodeUtf8BuilderEscaped prim =
Data/Text/Lazy/IO.hs−1
@@ -8,7 +8,6 @@
8-- (c) 2009 Simon Marlow
8-- (c) 2009 Simon Marlow
9-- License : BSD-style
9-- License : BSD-style
10-- Maintainer : bos@serpentine.com
10-- Maintainer : bos@serpentine.com
11−-- Stability : experimental
12-- Portability : GHC
11-- Portability : GHC
13--
12--
14-- Efficient locale-sensitive support for lazy text I\/O.
13-- Efficient locale-sensitive support for lazy text I\/O.
Data/Text/Lazy/Read.hs+3−4
@@ -11,7 +11,6 @@
11--
11--
12-- License : BSD-style
12-- License : BSD-style
13-- Maintainer : bos@serpentine.com
13-- Maintainer : bos@serpentine.com
14−-- Stability : experimental
15-- Portability : GHC
14-- Portability : GHC
16--
15--
17-- Functions used frequently when reading textual data.
16-- Functions used frequently when reading textual data.
@@ -68,9 +67,9 @@ decimal txt
68 go n d = (n * 10 + fromIntegral (digitToInt d))
67 go n d = (n * 10 + fromIntegral (digitToInt d))
69
68
70-- | Read a hexadecimal integer, consisting of an optional leading
69-- | Read a hexadecimal integer, consisting of an optional leading
71−-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
70+-- @\"0x\"@ followed by at least one hexadecimal digit. Input is
72−-- until a non-hex-digit or end of string is reached. This function
71+-- consumed until a non-hex-digit or end of string is reached.
73−-- is case insensitive.
72+-- This function is case insensitive.
74--
73--
75-- This function does not handle leading sign characters. If you need
74-- This function does not handle leading sign characters. If you need
76-- to handle signed input, use @'signed' 'hexadecimal'@.
75-- to handle signed input, use @'signed' 'hexadecimal'@.
Data/Text/Read.hs+3−4
@@ -9,7 +9,6 @@
9--
9--
10-- License : BSD-style
10-- License : BSD-style
11-- Maintainer : bos@serpentine.com
11-- Maintainer : bos@serpentine.com
12−-- Stability : experimental
13-- Portability : GHC
12-- Portability : GHC
14--
13--
15-- Functions used frequently when reading textual data.
14-- Functions used frequently when reading textual data.
@@ -67,9 +66,9 @@ decimal txt
67 go n d = (n * 10 + fromIntegral (digitToInt d))
66 go n d = (n * 10 + fromIntegral (digitToInt d))
68
67
69-- | Read a hexadecimal integer, consisting of an optional leading
68-- | Read a hexadecimal integer, consisting of an optional leading
70−-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
69+-- @\"0x\"@ followed by at least one hexadecimal digit. Input is
71−-- until a non-hex-digit or end of string is reached. This function
70+-- consumed until a non-hex-digit or end of string is reached.
72−-- is case insensitive.
71+-- This function is case insensitive.
73--
72--
74-- This function does not handle leading sign characters. If you need
73-- This function does not handle leading sign characters. If you need
75-- to handle signed input, use @'signed' 'hexadecimal'@.
74-- to handle signed input, use @'signed' 'hexadecimal'@.
Data/Text/Show.hs+2
@@ -46,6 +46,8 @@ unpack = S.unstreamList . stream
46-- fusion.
46-- fusion.
47--
47--
48-- This is exposed solely for people writing GHC rewrite rules.
48-- This is exposed solely for people writing GHC rewrite rules.
49+--
50+-- @since 1.2.1.1
49unpackCString# :: Addr# -> Text
51unpackCString# :: Addr# -> Text
50unpackCString# addr# = unstream (S.streamCString# addr#)
52unpackCString# addr# = unstream (S.streamCString# addr#)
51{-# NOINLINE unpackCString# #-}
53{-# NOINLINE unpackCString# #-}
Data/Text/Unsafe.hs+89−1
@@ -1,10 +1,12 @@
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
2+#ifdef __GHCJS__
3+{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes #-}
4+#endif
2-- |
5-- |
3-- Module : Data.Text.Unsafe
6-- Module : Data.Text.Unsafe
4-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
7-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
5-- License : BSD-style
8-- License : BSD-style
6-- Maintainer : bos@serpentine.com
9-- Maintainer : bos@serpentine.com
7−-- Stability : experimental
8-- Portability : portable
10-- Portability : portable
9--
11--
10-- A module containing unsafe 'Text' operations, for very very careful
12-- A module containing unsafe 'Text' operations, for very very careful
@@ -32,31 +34,47 @@ import Control.Exception (assert)
32import Data.Text.Internal.Encoding.Utf16 (chr2)
34import Data.Text.Internal.Encoding.Utf16 (chr2)
33import Data.Text.Internal (Text(..))
35import Data.Text.Internal (Text(..))
34import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)
36import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)
37+#ifdef __GHCJS__
38+import Data.Coerce
39+import qualified Data.JSString.Raw as JSS
40+import GHC.Exts (Int(..), Int#, chr#, int2Word#, Char(..))
41+import GHC.Word (Word16(..))
42+import Data.JSString (JSString)
43+#else
35import Data.Text.Internal.Unsafe.Char (unsafeChr)
44import Data.Text.Internal.Unsafe.Char (unsafeChr)
36import qualified Data.Text.Array as A
45import qualified Data.Text.Array as A
46+#endif
37import GHC.IO (unsafeDupablePerformIO)
47import GHC.IO (unsafeDupablePerformIO)
38
48
39-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
49-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
40-- omits the check for the empty case, so there is an obligation on
50-- omits the check for the empty case, so there is an obligation on
41-- the programmer to provide a proof that the 'Text' is non-empty.
51-- the programmer to provide a proof that the 'Text' is non-empty.
42unsafeHead :: Text -> Char
52unsafeHead :: Text -> Char
53+#ifndef __GHCJS__
43unsafeHead (Text arr off _len)
54unsafeHead (Text arr off _len)
44 | m < 0xD800 || m > 0xDBFF = unsafeChr m
55 | m < 0xD800 || m > 0xDBFF = unsafeChr m
45 | otherwise = chr2 m n
56 | otherwise = chr2 m n
46 where m = A.unsafeIndex arr off
57 where m = A.unsafeIndex arr off
47 n = A.unsafeIndex arr (off+1)
58 n = A.unsafeIndex arr (off+1)
59+#else
60+unsafeHead = coerce JSS.rawHead
61+#endif
48{-# INLINE unsafeHead #-}
62{-# INLINE unsafeHead #-}
49
63
50-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'
64-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'
51-- omits the check for the empty case, so there is an obligation on
65-- omits the check for the empty case, so there is an obligation on
52-- the programmer to provide a proof that the 'Text' is non-empty.
66-- the programmer to provide a proof that the 'Text' is non-empty.
53unsafeTail :: Text -> Text
67unsafeTail :: Text -> Text
68+#ifndef __GHCJS__
54unsafeTail t@(Text arr off len) =
69unsafeTail t@(Text arr off len) =
55#if defined(ASSERTS)
70#if defined(ASSERTS)
56 assert (d <= len) $
71 assert (d <= len) $
57#endif
72#endif
58 Text arr (off+d) (len-d)
73 Text arr (off+d) (len-d)
59 where d = iter_ t 0
74 where d = iter_ t 0
75+#else
76+unsafeTail = coerce JSS.rawTail
77+#endif
60{-# INLINE unsafeTail #-}
78{-# INLINE unsafeTail #-}
61
79
62data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
80data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
@@ -65,6 +83,7 @@ data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
65-- array, returning the current character and the delta to add to give
83-- array, returning the current character and the delta to add to give
66-- the next offset to iterate at.
84-- the next offset to iterate at.
67iter :: Text -> Int -> Iter
85iter :: Text -> Int -> Iter
86+#ifndef __GHCJS__
68iter (Text arr off _len) i
87iter (Text arr off _len) i
69 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
88 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
70 | otherwise = Iter (chr2 m n) 2
89 | otherwise = Iter (chr2 m n) 2
@@ -72,20 +91,40 @@ iter (Text arr off _len) i
72 n = A.unsafeIndex arr k
91 n = A.unsafeIndex arr k
73 j = off + i
92 j = off + i
74 k = j + 1
93 k = j + 1
94+#else
95+iter (Text txt) i
96+ | m < 0xD800 || m > 0xDBFF = Iter (C# (chr# m#)) 1
97+ | otherwise = Iter (chr2 m n) 2
98+ where m# = js_charCodeAt j txt
99+ n# = js_charCodeAt k txt
100+ m = W16# (int2Word# m#)
101+ n = W16# (int2Word# n#)
102+ j = off + i
103+ k = j + 1
104+ off = 0
105+#endif
75{-# INLINE iter #-}
106{-# INLINE iter #-}
76
107
77-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
108-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
78-- delta to add to give the next offset to iterate at.
109-- delta to add to give the next offset to iterate at.
79iter_ :: Text -> Int -> Int
110iter_ :: Text -> Int -> Int
111+#ifndef __GHCJS__
80iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1
112iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1
81 | otherwise = 2
113 | otherwise = 2
82 where m = A.unsafeIndex arr (off+i)
114 where m = A.unsafeIndex arr (off+i)
115+#else
116+iter_ (Text txt) i | m < 0xD800 || m > 0xDBFF = 1
117+ | otherwise = 2
118+ where m# = js_charCodeAt i txt
119+ m = W16# (int2Word# m#)
120+#endif
83{-# INLINE iter_ #-}
121{-# INLINE iter_ #-}
84
122
85-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
123-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
86-- returning the current character and the delta to add (i.e. a
124-- returning the current character and the delta to add (i.e. a
87-- negative number) to give the next offset to iterate at.
125-- negative number) to give the next offset to iterate at.
88reverseIter :: Text -> Int -> (Char,Int)
126reverseIter :: Text -> Int -> (Char,Int)
127+#ifndef __GHCJS__
89reverseIter (Text arr off _len) i
128reverseIter (Text arr off _len) i
90 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)
129 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)
91 | otherwise = (chr2 n m, -2)
130 | otherwise = (chr2 n m, -2)
@@ -93,31 +132,80 @@ reverseIter (Text arr off _len) i
93 n = A.unsafeIndex arr k
132 n = A.unsafeIndex arr k
94 j = off + i
133 j = off + i
95 k = j - 1
134 k = j - 1
135+#else
136+reverseIter (Text txt) i
137+ | m < 0xDC00 || m > 0xDFFF = (C# (chr# m#), -1)
138+ | otherwise = (chr2 n m, -2)
139+ where m# = js_charCodeAt j txt
140+ n# = js_charCodeAt k txt
141+ m = W16# (int2Word# m#)
142+ n = W16# (int2Word# n#)
143+ j = off + i
144+ k = j - 1
145+ off = 0
146+#endif
96{-# INLINE reverseIter #-}
147{-# INLINE reverseIter #-}
97
148
98-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
149-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
99-- returning the delta to add (i.e. a negative number) to give the
150-- returning the delta to add (i.e. a negative number) to give the
100-- next offset to iterate at.
151-- next offset to iterate at.
152+--
153+-- @since 1.1.1.0
101reverseIter_ :: Text -> Int -> Int
154reverseIter_ :: Text -> Int -> Int
155+#ifndef __GHCJS__
102reverseIter_ (Text arr off _len) i
156reverseIter_ (Text arr off _len) i
103 | m < 0xDC00 || m > 0xDFFF = -1
157 | m < 0xDC00 || m > 0xDFFF = -1
104 | otherwise = -2
158 | otherwise = -2
105 where m = A.unsafeIndex arr (off+i)
159 where m = A.unsafeIndex arr (off+i)
160+#else
161+reverseIter_ (Text txt) i
162+ | m < 0xDC00 || m > 0xDFFF = -1
163+ | otherwise = -2
164+ where m# = js_charCodeAt (off + i) txt
165+ m = W16# (int2Word# m#)
166+ off = 0
167+#endif
106{-# INLINE reverseIter_ #-}
168{-# INLINE reverseIter_ #-}
107
169
108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
170-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
109-- is useful for sizing a target array appropriately before using
171-- is useful for sizing a target array appropriately before using
110-- 'unsafeCopyToPtr'.
172-- 'unsafeCopyToPtr'.
111lengthWord16 :: Text -> Int
173lengthWord16 :: Text -> Int
174+#ifndef __GHCJS__
112lengthWord16 (Text _arr _off len) = len
175lengthWord16 (Text _arr _off len) = len
176+#else
177+lengthWord16 (Text t) = js_length t
178+#endif
113{-# INLINE lengthWord16 #-}
179{-# INLINE lengthWord16 #-}
114
180
115-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.
181-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.
116takeWord16 :: Int -> Text -> Text
182takeWord16 :: Int -> Text -> Text
183+#ifndef __GHCJS__
117takeWord16 k (Text arr off _len) = Text arr off k
184takeWord16 k (Text arr off _len) = Text arr off k
185+#else
186+takeWord16 k (Text txt) = Text $ js_take k txt
187+#endif
118{-# INLINE takeWord16 #-}
188{-# INLINE takeWord16 #-}
119
189
120-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.
190-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.
121dropWord16 :: Int -> Text -> Text
191dropWord16 :: Int -> Text -> Text
192+#ifndef __GHCJS__
122dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)
193dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)
194+#else
195+dropWord16 k (Text txt) = Text $ js_drop k txt
196+#endif
123{-# INLINE dropWord16 #-}
197{-# INLINE dropWord16 #-}
198+
199+#ifdef __GHCJS__
200+foreign import javascript unsafe
201+ "$2.charCodeAt($1)" js_charCodeAt :: Int -> JSString -> Int#
202+
203+foreign import javascript unsafe
204+ "h$jsstringTake" js_take :: Int -> JSString -> JSString
205+
206+foreign import javascript unsafe
207+ "h$jsstringDrop" js_drop :: Int -> JSString -> JSString
208+
209+foreign import javascript unsafe
210+ "$1.length" js_length :: JSString -> Int
211+#endif
README.markdown+5−16
@@ -1,29 +1,18 @@
1−# Text: Fast, packed Unicode strings, using stream fusion
1+# `text`: Fast, packed Unicode strings, using stream fusion
2
2
3This package provides the Data.Text library, a library for the space-
3This package provides the Data.Text library, a library for the space-
4and time-efficient manipulation of Unicode text in Haskell.
4and time-efficient manipulation of Unicode text in Haskell.
5
5
6−
7−# Normalization, conversion, and collation, oh my!
8−
9−This library intentionally provides a simple API based on the
10−Haskell prelude's list manipulation functions. For more complicated
11−real-world tasks, such as Unicode normalization, conversion to and
12−from a larger variety of encodings, and collation, use the [text-icu
13−package](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/text-icu).
6+**Please refer to the [package description on Hackage](https://hackage.haskell.org/package/text#description) for more information.**
14−
15−That library uses the well-respected and liberally licensed ICU
16−library to provide these facilities.
17−
18
7
19# Get involved!
8# Get involved!
20
9
21Please report bugs via the
10Please report bugs via the
22−[github issue tracker](https://github.com/bos/text/issues).
11+[github issue tracker](https://github.com/haskell/text/issues).
23
12
24−Master [git repository](https://github.com/bos/text):
13+Master [git repository](https://github.com/haskell/text):
25
14
26−* `git clone git://github.com/bos/text.git`
15+* `git clone git://github.com/haskell/text.git`
27
16
28There's also a [Mercurial mirror](https://bitbucket.org/bos/text):
17There's also a [Mercurial mirror](https://bitbucket.org/bos/text):
29
18
benchmarks/.gitignore+4−1
@@ -1 +1,4 @@
1+/dist/
1−dist
2+/dist-newstyle/
3+/.ghc.environment.*
4+/cabal.project.local
benchmarks/cabal.projectnew file+2
@@ -0,0 +1,2 @@
1+-- NB: we use a separate project
2+packages: .
benchmarks/haskell/Benchmarks.hs+2
@@ -10,6 +10,7 @@ import System.FilePath ((</>))
10import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)
10import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)
11
11
12import qualified Benchmarks.Builder as Builder
12import qualified Benchmarks.Builder as Builder
13+import qualified Benchmarks.Concat as Concat
13import qualified Benchmarks.DecodeUtf8 as DecodeUtf8
14import qualified Benchmarks.DecodeUtf8 as DecodeUtf8
14import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
15import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
15import qualified Benchmarks.Equality as Equality
16import qualified Benchmarks.Equality as Equality
@@ -41,6 +42,7 @@ benchmarks = do
41 -- Traditional benchmarks
42 -- Traditional benchmarks
42 bs <- sequence
43 bs <- sequence
43 [ Builder.benchmark
44 [ Builder.benchmark
45+ , Concat.benchmark
44 , DecodeUtf8.benchmark "html" (tf "libya-chinese.html")
46 , DecodeUtf8.benchmark "html" (tf "libya-chinese.html")
45 , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml")
47 , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml")
46 , DecodeUtf8.benchmark "ascii" (tf "ascii.txt")
48 , DecodeUtf8.benchmark "ascii" (tf "ascii.txt")
benchmarks/haskell/Benchmarks/Concat.hsnew file+25
@@ -0,0 +1,25 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Benchmarks.Concat (benchmark) where
4+
5+import Control.Monad.Trans.Writer
6+import Criterion (Benchmark, bgroup, bench, whnf)
7+import Data.Text as T
8+
9+benchmark :: IO Benchmark
10+benchmark = return $ bgroup "Concat"
11+ [ bench "append" $ whnf (append4 "Text 1" "Text 2" "Text 3") "Text 4"
12+ , bench "concat" $ whnf (concat4 "Text 1" "Text 2" "Text 3") "Text 4"
13+ , bench "write" $ whnf (write4 "Text 1" "Text 2" "Text 3") "Text 4"
14+ ]
15+
16+append4, concat4, write4 :: Text -> Text -> Text -> Text -> Text
17+
18+{-# NOINLINE append4 #-}
19+append4 x1 x2 x3 x4 = x1 `append` x2 `append` x3 `append` x4
20+
21+{-# NOINLINE concat4 #-}
22+concat4 x1 x2 x3 x4 = T.concat [x1, x2, x3, x4]
23+
24+{-# NOINLINE write4 #-}
25+write4 x1 x2 x3 x4 = execWriter $ tell x1 >> tell x2 >> tell x3 >> tell x4
benchmarks/text-benchmarks.cabal+82−8
@@ -12,8 +12,7 @@ author: Jasper Van der Jeugt <jaspervdj@gmail.com>,
12maintainer: jaspervdj@gmail.com
12maintainer: jaspervdj@gmail.com
13category: Text
13category: Text
14build-type: Simple
14build-type: Simple
15−
16−cabal-version: >=1.2
15+cabal-version: >=1.8
17
16
18flag bytestring-builder
17flag bytestring-builder
19 description: Depend on the bytestring-builder package for backwards compatibility.
18 description: Depend on the bytestring-builder package for backwards compatibility.
@@ -26,16 +25,12 @@ flag llvm
26 manual: True
25 manual: True
27
26
28executable text-benchmarks
27executable text-benchmarks
29− hs-source-dirs: haskell ..
30− c-sources: ../cbits/cbits.c
31− cbits/time_iconv.c
32− include-dirs: ../include
33− main-is: Benchmarks.hs
34 ghc-options: -Wall -O2 -rtsopts
28 ghc-options: -Wall -O2 -rtsopts
35 if flag(llvm)
29 if flag(llvm)
36 ghc-options: -fllvm
30 ghc-options: -fllvm
37 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
31 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
38− build-depends: base == 4.*,
32+ build-depends: array,
33+ base == 4.*,
39 binary,
34 binary,
40 blaze-builder,
35 blaze-builder,
41 bytestring-lexing >= 0.5.0,
36 bytestring-lexing >= 0.5.0,
@@ -47,6 +42,7 @@ executable text-benchmarks
47 ghc-prim,
42 ghc-prim,
48 integer-gmp,
43 integer-gmp,
49 stringsearch,
44 stringsearch,
45+ transformers,
50 utf8-string,
46 utf8-string,
51 vector
47 vector
52
48
@@ -56,9 +52,87 @@ executable text-benchmarks
56 else
52 else
57 build-depends: bytestring >= 0.10.4
53 build-depends: bytestring >= 0.10.4
58
54
55+ -- modules for benchmark proper
56+ c-sources: cbits/time_iconv.c
57+ hs-source-dirs: haskell
58+ main-is: Benchmarks.hs
59+ other-modules:
60+ Benchmarks.Builder
61+ Benchmarks.Concat
62+ Benchmarks.DecodeUtf8
63+ Benchmarks.EncodeUtf8
64+ Benchmarks.Equality
65+ Benchmarks.FileRead
66+ Benchmarks.FoldLines
67+ Benchmarks.Mul
68+ Benchmarks.Programs.BigTable
69+ Benchmarks.Programs.Cut
70+ Benchmarks.Programs.Fold
71+ Benchmarks.Programs.Sort
72+ Benchmarks.Programs.StripTags
73+ Benchmarks.Programs.Throughput
74+ Benchmarks.Pure
75+ Benchmarks.ReadNumbers
76+ Benchmarks.Replace
77+ Benchmarks.Search
78+ Benchmarks.Stream
79+ Benchmarks.WordFrequencies
80+
81+ -- Source code for IUT (implementation under test)
82+ -- "borrowed" from parent folder
83+ include-dirs: ../include
84+ c-sources: ../cbits/cbits.c
85+ hs-source-dirs: ..
86+ other-modules:
87+ Data.Text
88+ Data.Text.Array
89+ Data.Text.Encoding
90+ Data.Text.Encoding.Error
91+ Data.Text.Foreign
92+ Data.Text.IO
93+ Data.Text.Internal
94+ Data.Text.Internal.Builder
95+ Data.Text.Internal.Builder.Functions
96+ Data.Text.Internal.Builder.Int.Digits
97+ Data.Text.Internal.Builder.RealFloat.Functions
98+ Data.Text.Internal.Encoding.Fusion
99+ Data.Text.Internal.Encoding.Fusion.Common
100+ Data.Text.Internal.Encoding.Utf16
101+ Data.Text.Internal.Encoding.Utf32
102+ Data.Text.Internal.Encoding.Utf8
103+ Data.Text.Internal.Functions
104+ Data.Text.Internal.Fusion
105+ Data.Text.Internal.Fusion.CaseMapping
106+ Data.Text.Internal.Fusion.Common
107+ Data.Text.Internal.Fusion.Size
108+ Data.Text.Internal.Fusion.Types
109+ Data.Text.Internal.IO
110+ Data.Text.Internal.Lazy
111+ Data.Text.Internal.Lazy.Encoding.Fusion
112+ Data.Text.Internal.Lazy.Fusion
113+ Data.Text.Internal.Lazy.Search
114+ Data.Text.Internal.Private
115+ Data.Text.Internal.Read
116+ Data.Text.Internal.Search
117+ Data.Text.Internal.Unsafe
118+ Data.Text.Internal.Unsafe.Char
119+ Data.Text.Internal.Unsafe.Shift
120+ Data.Text.Lazy
121+ Data.Text.Lazy.Builder
122+ Data.Text.Lazy.Builder.Int
123+ Data.Text.Lazy.Builder.RealFloat
124+ Data.Text.Lazy.Encoding
125+ Data.Text.Lazy.IO
126+ Data.Text.Lazy.Internal
127+ Data.Text.Lazy.Read
128+ Data.Text.Read
129+ Data.Text.Unsafe
130+ Data.Text.Show
131+
59executable text-multilang
132executable text-multilang
60 hs-source-dirs: haskell
133 hs-source-dirs: haskell
61 main-is: Multilang.hs
134 main-is: Multilang.hs
135+ other-modules: Timer
62 ghc-options: -Wall -O2
136 ghc-options: -Wall -O2
63 build-depends: base == 4.*,
137 build-depends: base == 4.*,
64 bytestring,
138 bytestring,
cabal.projectnew file+3
@@ -0,0 +1,3 @@
1+-- See http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html
2+packages: .
3+tests: True
cbits/cbits.c+6−11
@@ -206,11 +206,9 @@ _hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,
206 const uint8_t *srcend,
206 const uint8_t *srcend,
207 uint32_t *codepoint0, uint32_t *state0)
207 uint32_t *codepoint0, uint32_t *state0)
208{
208{
209− uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,
209+ _hs_text_decode_utf8_int(dest, destoff, src, srcend, codepoint0, state0);
210− codepoint0, state0);
210+
211− if (*state0 == UTF8_REJECT)
212− ret -=1;
213− return ret;
211+ return *src;
214}
212}
215
213
216/*
214/*
@@ -222,12 +220,9 @@ _hs_text_decode_utf8(uint16_t *const dest, size_t *destoff,
222{
220{
223 uint32_t codepoint;
221 uint32_t codepoint;
224 uint32_t state = UTF8_ACCEPT;
222 uint32_t state = UTF8_ACCEPT;
225− uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, &src, srcend,
223+ _hs_text_decode_utf8_int(dest, destoff, &src, srcend,
226− &codepoint, &state);
224+ &codepoint, &state);
227− /* Back up if we have an incomplete or invalid encoding */
228− if (state != UTF8_ACCEPT)
229− ret -= 1;
230− return ret;
225+ return src;
231}
226}
232
227
233void
228void
changelog.md+61−19
@@ -1,15 +1,57 @@
1+### 1.2.3.1 TBD
2+
3+* Make `decodeUtf8With` fail explicitly for unsupported non-BMP
4+ replacement characters instead silent undefined behaviour (gh-213)
5+
6+### 1.2.3.0
7+
8+* Spec compliance: `toCaseFold` now follows the Unicode 9.0 spec
9+ (updated from 8.0).
10+
11+* Bug fix: the lazy `takeWhileEnd` function violated the
12+ [lazy text invariant](https://github.com/bos/text/blob/1.2.3.0/Data/Text/Internal/Lazy.hs#L51)
13+ (gh-184).
14+
15+* Bug fix: Fixed usage of size hints causing incorrect behavior (gh-197).
16+
17+* New function: `unsnoc` (gh-173).
18+
19+* Reduce memory overhead in `encodeUTF8` (gh-194).
20+
21+* Improve UTF-8 decoder error-recovery (gh-182).
22+
23+* Minor documentation improvements (`@since` annotations, more
24+ examples, clarifications).
25+
26+#### 1.2.2.2
27+
28+* The `toTitle` function now correctly handles letters that
29+ immediately follow punctuation. Before, `"there's"` would turn into
30+ `"There'S"`. Now, it becomes `"There's"`.
31+
32+* The implementation of unstreaming is faster, resulting in operations
33+ such as `map` and `intersperse` speeding up by up to 30%, with
34+ smaller code generated.
35+
36+* The optimised length comparison function is now more likely to be
37+ used after some rewrite rule tweaking.
38+
39+* Bug fix: an off-by-one bug in `takeEnd` is fixed.
40+
41+* Bug fix: a logic error in `takeWord16` is fixed.
42+
1−1.2.2.1
43+#### 1.2.2.1
2
44
3* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.
45* 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
46 The build flag has been renamed accordingly. Your army of diligent
5 maintainers apologizes for the churn.
47 maintainers apologizes for the churn.
6
48
7−* Spec compliance: toCaseFold now follows the Unicode 8.0 spec
49+* Spec compliance: `toCaseFold` now follows the Unicode 8.0 spec
8 (updated from 7.0)
50 (updated from 7.0)
9
51
10* An STG lint error has been fixed
52* An STG lint error has been fixed
11
53
12−1.2.2.0
54+### 1.2.2.0
13
55
14* The `integer-simple` package, upon which this package optionally
56* The `integer-simple` package, upon which this package optionally
15 depended, has been replaced with `integer-pure`. The build flag has
57 depended, has been replaced with `integer-pure`. The build flag has
@@ -25,7 +67,7 @@
25 * if `base` >= 4.7: `PrintfArg`
67 * if `base` >= 4.7: `PrintfArg`
26 * if `base` >= 4.9: `Semigroup`
68 * if `base` >= 4.9: `Semigroup`
27
69
28−1.2.1.3
70+#### 1.2.1.3
29
71
30* Bug fix: As it turns out, moving the literal rewrite rules to simplifier
72* 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
73 phase 2 does not prevent competition with the `unpack` rule, which is
@@ -33,7 +75,7 @@
33 test environment mistake. Moving literal rules back to phase 1 finally
75 test environment mistake. Moving literal rules back to phase 1 finally
34 fixes GHC Trac #10528 correctly.
76 fixes GHC Trac #10528 correctly.
35
77
36−1.2.1.2
78+#### 1.2.1.2
37
79
38* Bug fix: Run literal rewrite rules in simplifier phase 2.
80* Bug fix: Run literal rewrite rules in simplifier phase 2.
39 The behavior of the simplifier changed in GHC 7.10.2,
81 The behavior of the simplifier changed in GHC 7.10.2,
@@ -41,21 +83,21 @@
41 and long compilation times. See
83 and long compilation times. See
42 [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528).
84 [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528).
43
85
44−1.2.1.1
86+#### 1.2.1.1
45
87
46* Expose unpackCString#, which you should never use.
88* Expose unpackCString#, which you should never use.
47
89
48−1.2.1.0
90+### 1.2.1.0
49
91
50* Added Binary instances for both Text types. (If you have previously
92* 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
93 been using the text-binary package to get a Binary instance, it is
52 now obsolete.)
94 now obsolete.)
53
95
54−1.2.0.6
96+#### 1.2.0.6
55
97
56* Fixed a space leak in UTF-8 decoding
98* Fixed a space leak in UTF-8 decoding
57
99
58−1.2.0.5
100+#### 1.2.0.5
59
101
60* Feature parity: repeat, cycle, iterate are now implemented for lazy
102* Feature parity: repeat, cycle, iterate are now implemented for lazy
61 Text, and the Data instance is more complete
103 Text, and the Data instance is more complete
@@ -75,26 +117,26 @@
75* Spec compliance: toCaseFold now follows the Unicode 7.0 spec
117* Spec compliance: toCaseFold now follows the Unicode 7.0 spec
76 (updated from 6.3)
118 (updated from 6.3)
77
119
78−1.2.0.4
120+#### 1.2.0.4
79
121
80* Fixed an incompatibility with base < 4.5
122* Fixed an incompatibility with base < 4.5
81
123
82−1.2.0.3
124+#### 1.2.0.3
83
125
84* Update formatRealFloat to correspond to the definition in versions
126* Update formatRealFloat to correspond to the definition in versions
85 of base newer than 4.5 (https://github.com/bos/text/issues/105)
127 of base newer than 4.5 (https://github.com/bos/text/issues/105)
86
128
87−1.2.0.2
129+#### 1.2.0.2
88
130
89* Bumped lower bound on deepseq to 1.4 for compatibility with the
131* Bumped lower bound on deepseq to 1.4 for compatibility with the
90 upcoming GHC 7.10
132 upcoming GHC 7.10
91
133
92−1.2.0.1
134+#### 1.2.0.1
93
135
94* Fixed a buffer overflow in rendering of large Integers
136* Fixed a buffer overflow in rendering of large Integers
95 (https://github.com/bos/text/issues/99)
137 (https://github.com/bos/text/issues/99)
96
138
97−1.2.0.0
139+## 1.2.0.0
98
140
99* Fixed an integer overflow in the replace function
141* Fixed an integer overflow in the replace function
100 (https://github.com/bos/text/issues/81)
142 (https://github.com/bos/text/issues/81)
@@ -107,7 +149,7 @@
107
149
108* Added an instance of IsList for GHC 7.8 and above
150* Added an instance of IsList for GHC 7.8 and above
109
151
110−1.1.1.0
152+### 1.1.1.0
111
153
112* The Data.Data instance now allows gunfold to work, via a virtual
154* The Data.Data instance now allows gunfold to work, via a virtual
113 pack constructor
155 pack constructor
@@ -117,12 +159,12 @@
117* Comparing the length of a Text against a number can now
159* Comparing the length of a Text against a number can now
118 short-circuit in more cases
160 short-circuit in more cases
119
161
120−1.1.0.1
162+#### 1.1.0.1
121
163
122* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes
164* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes
123 in single-byte chunks
165 in single-byte chunks
124
166
125−1.1.0.0
167+## 1.1.0.0
126
168
127* encodeUtf8: Performance is improved by up to 4x.
169* encodeUtf8: Performance is improved by up to 4x.
128
170
@@ -141,12 +183,12 @@
141 use at your own risk - there are no API stability guarantees for
183 use at your own risk - there are no API stability guarantees for
142 internal modules!
184 internal modules!
143
185
144−1.0.0.1
186+#### 1.0.0.1
145
187
146* decodeUtf8: Fixed a regression that caused us to incorrectly
188* decodeUtf8: Fixed a regression that caused us to incorrectly
147 identify truncated UTF-8 as valid (gh-61)
189 identify truncated UTF-8 as valid (gh-61)
148
190
149−1.0.0.0
191+# 1.0.0.0
150
192
151* Added support for Unicode 6.3.0 to case conversion functions
193* Added support for Unicode 6.3.0 to case conversion functions
152
194
tests-and-benchmarks.markdown+13−8
@@ -13,10 +13,13 @@ you can clone from one of the following locations:
13* Git mirror repository:
13* Git mirror repository:
14 [github.com/bos/text-test-data](https://github.com/bos/text-test-data)
14 [github.com/bos/text-test-data](https://github.com/bos/text-test-data)
15
15
16−You should clone that repository into the `tests` subdirectory (your
16+You can clone either repository into the `tests` subdirectory using
17−clone must be named `text-test-data` locally), then run `make -C
17+
18−tests/text-test-data` to uncompress the test files. Many tests and
18+ cd tests/
19+ make text-test-data # to clone from mercurial, OR
20+ make VCS=git text-test-data # to clone from git
21+
19−benchmarks will fail if the test files are missing.
22+Many tests and benchmarks will fail if the test files are missing.
20
23
21Functional tests
24Functional tests
22----------------
25----------------
@@ -54,10 +57,12 @@ To compile the benchmarks, navigate to the `benchmarks` subdirectory and run
54
57
55 ./dist/build/text-benchmarks/text-benchmarks
58 ./dist/build/text-benchmarks/text-benchmarks
56
59
57−However, since there's quite a lot of benchmarks, you usually don't want to
60+Or if you have a recent enough `cabal`, you can build and run the
58−run them all. Instead, use the `-l` flag to get a list of benchmarks:
61+benchmarks via
59
62
60− ./dist/build/text-benchmarks/text-benchmarks
63+ cabal new-run exe:text-benchmarks -- --help
61
64
65+However, since there's quite a lot of benchmarks, you usually don't want to
66+run them all. Instead, use the `-l` flag to get a list of benchmarks
62−And run the ones you want to inspect. If you want to configure the benchmarks
67+and run the ones you want to inspect. If you want to configure the benchmarks
63further, the exact parameters can be changed in `Benchmarks.hs`.
68further, the exact parameters can be changed in `Benchmarks.hs`.
tests/Makefile+6−1
@@ -1,3 +1,4 @@
1+VCS = hg
1count = 1000
2count = 1000
2
3
3all: coverage literal-rule-test
4all: coverage literal-rule-test
@@ -12,7 +13,11 @@ build: text-test-data
12 cabal build
13 cabal build
13
14
14text-test-data:
15text-test-data:
16+ifeq ($(VCS),git)
17+ git clone https://github.com/bos/text-test-data.git
18+else
15 hg clone https://bitbucket.org/bos/text-test-data
19 hg clone https://bitbucket.org/bos/text-test-data
20+endif
16 $(MAKE) -C text-test-data
21 $(MAKE) -C text-test-data
17
22
18coverage/text-tests.tix:
23coverage/text-tests.tix:
@@ -37,4 +42,4 @@ coverage/hpc_index.html: coverage/coverage.tix
37clean:
42clean:
38 rm -rf dist coverage .hpc
43 rm -rf dist coverage .hpc
39
44
40−.PHONY: build coverage all literal-rule-test
45+.PHONY: all build clean coverage literal-rule-test
tests/Tests/Properties.hs+94−21
@@ -9,9 +9,9 @@ module Tests.Properties
9 ) where
9 ) where
10
10
11import Control.Applicative ((<$>), (<*>))
11import Control.Applicative ((<$>), (<*>))
12−import Control.Arrow ((***), second)
12+import Control.Arrow ((***), first, second)
13import Data.Bits ((.&.))
13import Data.Bits ((.&.))
14−import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
14+import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isLetter, isUpper, ord)
15import Data.Int (Int8, Int16, Int32, Int64)
15import Data.Int (Int8, Int16, Int32, Int64)
16import Data.Monoid (Monoid(..))
16import Data.Monoid (Monoid(..))
17import Data.String (IsString(fromString))
17import Data.String (IsString(fromString))
@@ -23,6 +23,7 @@ import Data.Text.Internal.Search (indices)
23import Data.Text.Lazy.Read as TL
23import Data.Text.Lazy.Read as TL
24import Data.Text.Read as T
24import Data.Text.Read as T
25import Data.Word (Word, Word8, Word16, Word32, Word64)
25import Data.Word (Word, Word8, Word16, Word32, Word64)
26+import Data.Maybe (mapMaybe)
26import Numeric (showEFloat, showFFloat, showGFloat, showHex)
27import Numeric (showEFloat, showFFloat, showGFloat, showHex)
27import Prelude hiding (replicate)
28import Prelude hiding (replicate)
28import Test.Framework (Test, testGroup)
29import Test.Framework (Test, testGroup)
@@ -30,6 +31,7 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
30import Test.QuickCheck hiding ((.&.))
31import Test.QuickCheck hiding ((.&.))
31import Test.QuickCheck.Monadic
32import Test.QuickCheck.Monadic
32import Test.QuickCheck.Property (Property(..))
33import Test.QuickCheck.Property (Property(..))
34+import Test.QuickCheck.Unicode (char)
33import Tests.QuickCheckUtils
35import Tests.QuickCheckUtils
34import Tests.Utils
36import Tests.Utils
35import Text.Show.Functions ()
37import Text.Show.Functions ()
@@ -37,6 +39,7 @@ import qualified Control.Exception as Exception
37import qualified Data.Bits as Bits (shiftL, shiftR)
39import qualified Data.Bits as Bits (shiftL, shiftR)
38import qualified Data.ByteString as B
40import qualified Data.ByteString as B
39import qualified Data.ByteString.Lazy as BL
41import qualified Data.ByteString.Lazy as BL
42+import qualified Data.Char as C
40import qualified Data.List as L
43import qualified Data.List as L
41import qualified Data.Text as T
44import qualified Data.Text as T
42import qualified Data.Text.Encoding as E
45import qualified Data.Text.Encoding as E
@@ -60,10 +63,10 @@ t_pack_unpack = (T.unpack . T.pack) `eq` id
60tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
63tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
61t_stream_unstream = (S.unstream . S.stream) `eq` id
64t_stream_unstream = (S.unstream . S.stream) `eq` id
62tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
65tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
63−t_reverse_stream t = (S.reverse . S.reverseStream) t == t
66+t_reverse_stream t = (S.reverse . S.reverseStream) t === t
64−t_singleton c = [c] == (T.unpack . T.singleton) c
67+t_singleton c = [c] === (T.unpack . T.singleton) c
65−tl_singleton c = [c] == (TL.unpack . TL.singleton) c
68+tl_singleton c = [c] === (TL.unpack . TL.singleton) c
66−tl_unstreamChunks x = f 11 x == f 1000 x
69+tl_unstreamChunks x = f 11 x === f 1000 x
67 where f n = SL.unstreamChunks n . S.streamList
70 where f n = SL.unstreamChunks n . S.streamList
68tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
71tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
69tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
72tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
@@ -74,13 +77,13 @@ encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
74encodeLazyL1 :: TL.Text -> BL.ByteString
77encodeLazyL1 :: TL.Text -> BL.ByteString
75encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
78encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
76
79
77−t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
80+t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a
78 where a = T.map (\c -> chr (ord c `mod` 128)) t
81 where a = T.map (\c -> chr (ord c `mod` 128)) t
79−tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
82+tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) === a
80 where a = TL.map (\c -> chr (ord c `mod` 128)) t
83 where a = TL.map (\c -> chr (ord c `mod` 128)) t
81−t_latin1 t = E.decodeLatin1 (encodeL1 a) == a
84+t_latin1 t = E.decodeLatin1 (encodeL1 a) === a
82 where a = T.map (\c -> chr (ord c `mod` 256)) t
85 where a = T.map (\c -> chr (ord c `mod` 256)) t
83−tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a
86+tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) === a
84 where a = TL.map (\c -> chr (ord c `mod` 256)) t
87 where a = TL.map (\c -> chr (ord c `mod` 256)) t
85t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
88t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
86t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
89t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
@@ -111,7 +114,7 @@ t_utf8_undecoded = forAll genUnicode $ \t ->
111 let b = E.encodeUtf8 t
114 let b = E.encodeUtf8 t
112 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
115 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
113 leftover = (++ [B.empty]) . init . tail . B.inits
116 leftover = (++ [B.empty]) . init . tail . B.inits
114− in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls
117+ in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b === ls
115
118
116data Badness = Solo | Leading | Trailing
119data Badness = Solo | Leading | Trailing
117 deriving (Eq, Show)
120 deriving (Eq, Show)
@@ -177,6 +180,33 @@ genInvalidUTF8 = B.pack <$> oneof [
177 k <- choose (0,n)
180 k <- choose (0,n)
178 vectorOf k gen
181 vectorOf k gen
179
182
183+-- See http://unicode.org/faq/utf_bom.html#gen8
184+-- A sequence such as <110xxxxx2 0xxxxxxx2> is illegal ...
185+-- When faced with this illegal byte sequence ... a UTF-8 conformant process
186+-- must treat the first byte 110xxxxx2 as an illegal termination error
187+-- (e.g. filter it out or replace by 0xFFFD) ...
188+-- ... and continue processing at the second byte 0xxxxxxx2
189+t_decode_with_error2 =
190+ E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97]) === "xa"
191+t_decode_with_error3 =
192+ E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xE0, 97, 97]) === "xaa"
193+t_decode_with_error4 =
194+ E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xF0, 97, 97, 97]) === "xaaa"
195+
196+t_decode_with_error2' =
197+ case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97]) of
198+ E.Some x _ _ -> x === "xa"
199+t_decode_with_error3' =
200+ case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97]) of
201+ E.Some x _ _ -> x === "xaa"
202+t_decode_with_error4' =
203+ case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97, 97]) of
204+ E.Some x _ _ -> x === "xaaa"
205+
206+t_infix_concat bs1 text bs2 rep =
207+ text `T.isInfixOf`
208+ E.decodeUtf8With (\_ _ -> rep) (B.concat [bs1, E.encodeUtf8 text, bs2])
209+
180s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
210s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
181 where _types = s :: String
211 where _types = s :: String
182sf_Eq p s =
212sf_Eq p s =
@@ -201,8 +231,8 @@ t_mconcat = unsquare $
201 mconcat `eq` (unpackS . mconcat . L.map T.pack)
231 mconcat `eq` (unpackS . mconcat . L.map T.pack)
202tl_mconcat = unsquare $
232tl_mconcat = unsquare $
203 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
233 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
204−t_mempty = mempty == (unpackS (mempty :: T.Text))
234+t_mempty = mempty === (unpackS (mempty :: T.Text))
205−tl_mempty = mempty == (unpackS (mempty :: TL.Text))
235+tl_mempty = mempty === (unpackS (mempty :: TL.Text))
206t_IsString = fromString `eqP` (T.unpack . fromString)
236t_IsString = fromString `eqP` (T.unpack . fromString)
207tl_IsString = fromString `eqP` (TL.unpack . fromString)
237tl_IsString = fromString `eqP` (TL.unpack . fromString)
208
238
@@ -229,6 +259,13 @@ sf_uncons p = (uncons . L.filter p) `eqP`
229 (fmap (second unpackS) . S.uncons . S.filter p)
259 (fmap (second unpackS) . S.uncons . S.filter p)
230t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
260t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
231tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
261tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
262+
263+unsnoc xs@(_:_) = Just (init xs, last xs)
264+unsnoc [] = Nothing
265+
266+t_unsnoc = unsnoc `eqP` (fmap (first unpackS) . T.unsnoc)
267+tl_unsnoc = unsnoc `eqP` (fmap (first unpackS) . TL.unsnoc)
268+
232s_head = head `eqP` S.head
269s_head = head `eqP` S.head
233sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
270sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
234t_head = head `eqP` T.head
271t_head = head `eqP` T.head
@@ -326,6 +363,19 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
326 where p = T.length . T.filter isUpper
363 where p = T.length . T.filter isUpper
327tl_toUpper_upper t = p (TL.toUpper t) >= p t
364tl_toUpper_upper t = p (TL.toUpper t) >= p t
328 where p = TL.length . TL.filter isUpper
365 where p = TL.length . TL.filter isUpper
366+t_toTitle_title t = all (<= 1) (caps w)
367+ where caps = fmap (T.length . T.filter isUpper) . T.words . T.toTitle
368+ -- TIL: there exist uppercase-only letters
369+ w = T.filter (\c -> if C.isUpper c then C.toLower c /= c else True) t
370+t_toTitle_1stNotLower = and . notLow . T.toTitle . T.filter stable
371+ where notLow = mapMaybe (fmap (not . isLower) . (T.find isLetter)) . T.words
372+ -- Surprise! The Spanish/Portuguese ordinal indicators changed
373+ -- from category Ll (letter, lowercase) to Lo (letter, other)
374+ -- in Unicode 7.0
375+ -- Oh, and there exist lowercase-only letters (see previous test)
376+ stable c = if isLower c
377+ then C.toUpper c /= c
378+ else c /= '\170' && c /= '\186'
329
379
330justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
380justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
331justifyRight m n xs = L.replicate (m - length xs) n ++ xs
381justifyRight m n xs = L.replicate (m - length xs) n ++ xs
@@ -514,12 +564,20 @@ s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
514s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
564s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
515sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
565sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
516 (unpackS . S.takeWhile p . S.filter q)
566 (unpackS . S.takeWhile p . S.filter q)
567+noMatch = do
568+ c <- char
569+ d <- suchThat char (/= c)
570+ return (c,d)
517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
571t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
572tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
519t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
573t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
520 (unpackS . T.takeWhileEnd p)
574 (unpackS . T.takeWhileEnd p)
575+t_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> T.null $
576+ T.takeWhileEnd (==d) (T.snoc t c)
521tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
577tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
522 (unpackS . TL.takeWhileEnd p)
578 (unpackS . TL.takeWhileEnd p)
579+tl_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> TL.null $
580+ TL.takeWhileEnd (==d) (TL.snoc t c)
523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
581s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
582s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
583sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -720,7 +778,7 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
720 conc = T.concat . TL.toChunks
778 conc = T.concat . TL.toChunks
721t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
779t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
722 let s = T.intercalate t ts
780 let s = T.intercalate t ts
723− in Slow.indices t s == indices t s
781+ in Slow.indices t s === indices t s
724
782
725-- Bit shifts.
783-- Bit shifts.
726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
784shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -812,18 +870,18 @@ tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
812-- Reading.
870-- Reading.
813
871
814t_decimal (n::Int) s =
872t_decimal (n::Int) s =
815− T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)
873+ T.signed T.decimal (T.pack (show n) `T.append` t) === Right (n,t)
816 where t = T.dropWhile isDigit s
874 where t = T.dropWhile isDigit s
817tl_decimal (n::Int) s =
875tl_decimal (n::Int) s =
818− TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
876+ TL.signed TL.decimal (TL.pack (show n) `TL.append` t) === Right (n,t)
819 where t = TL.dropWhile isDigit s
877 where t = TL.dropWhile isDigit s
820t_hexadecimal m s ox =
878t_hexadecimal m s ox =
821− T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
879+ T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) === Right (n,t)
822 where t = T.dropWhile isHexDigit s
880 where t = T.dropWhile isHexDigit s
823 p = if ox then "0x" else ""
881 p = if ox then "0x" else ""
824 n = getPositive m :: Int
882 n = getPositive m :: Int
825tl_hexadecimal m s ox =
883tl_hexadecimal m s ox =
826− TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
884+ TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) === Right (n,t)
827 where t = TL.dropWhile isHexDigit s
885 where t = TL.dropWhile isHexDigit s
828 p = if ox then "0x" else ""
886 p = if ox then "0x" else ""
829 n = getPositive m :: Int
887 n = getPositive m :: Int
@@ -867,11 +925,11 @@ tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
867
925
868t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
926t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
869t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
927t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
870−t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t
928+t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) === t
871 where n = small m
929 where n = small m
872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
930t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
873
931
874−t_copy t = T.copy t == t
932+t_copy t = T.copy t === t
875
933
876-- Regression tests.
934-- Regression tests.
877s_filter_eq s = S.filter p t == S.streamList (filter p s)
935s_filter_eq s = S.filter p t == S.streamList (filter p s)
@@ -924,6 +982,15 @@ tests =
924 testGroup "errors" [
982 testGroup "errors" [
925 testProperty "t_utf8_err" t_utf8_err,
983 testProperty "t_utf8_err" t_utf8_err,
926 testProperty "t_utf8_err'" t_utf8_err'
984 testProperty "t_utf8_err'" t_utf8_err'
985+ ],
986+ testGroup "error recovery" [
987+ testProperty "t_decode_with_error2" t_decode_with_error2,
988+ testProperty "t_decode_with_error3" t_decode_with_error3,
989+ testProperty "t_decode_with_error4" t_decode_with_error4,
990+ testProperty "t_decode_with_error2'" t_decode_with_error2',
991+ testProperty "t_decode_with_error3'" t_decode_with_error3',
992+ testProperty "t_decode_with_error4'" t_decode_with_error4',
993+ testProperty "t_infix_concat" t_infix_concat
927 ]
994 ]
928 ],
995 ],
929
996
@@ -967,6 +1034,8 @@ tests =
967 testProperty "sf_uncons" sf_uncons,
1034 testProperty "sf_uncons" sf_uncons,
968 testProperty "t_uncons" t_uncons,
1035 testProperty "t_uncons" t_uncons,
969 testProperty "tl_uncons" tl_uncons,
1036 testProperty "tl_uncons" tl_uncons,
1037+ testProperty "t_unsnoc" t_unsnoc,
1038+ testProperty "tl_unsnoc" tl_unsnoc,
970 testProperty "s_head" s_head,
1039 testProperty "s_head" s_head,
971 testProperty "sf_head" sf_head,
1040 testProperty "sf_head" sf_head,
972 testProperty "t_head" t_head,
1041 testProperty "t_head" t_head,
@@ -1030,7 +1099,9 @@ tests =
1030 testProperty "tl_toLower_lower" tl_toLower_lower,
1099 testProperty "tl_toLower_lower" tl_toLower_lower,
1031 testProperty "t_toUpper_length" t_toUpper_length,
1100 testProperty "t_toUpper_length" t_toUpper_length,
1032 testProperty "t_toUpper_upper" t_toUpper_upper,
1101 testProperty "t_toUpper_upper" t_toUpper_upper,
1033− testProperty "tl_toUpper_upper" tl_toUpper_upper
1102+ testProperty "tl_toUpper_upper" tl_toUpper_upper,
1103+ testProperty "t_toTitle_title" t_toTitle_title,
1104+ testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower
1034 ],
1105 ],
1035
1106
1036 testGroup "justification" [
1107 testGroup "justification" [
@@ -1147,7 +1218,9 @@ tests =
1147 testProperty "t_takeWhile" t_takeWhile,
1218 testProperty "t_takeWhile" t_takeWhile,
1148 testProperty "tl_takeWhile" tl_takeWhile,
1219 testProperty "tl_takeWhile" tl_takeWhile,
1149 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1220 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1221+ testProperty "t_takeWhileEnd_null" t_takeWhileEnd_null,
1150 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1222 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1223+ testProperty "tl_takeWhileEnd_null" tl_takeWhileEnd_null,
1151 testProperty "sf_dropWhile" sf_dropWhile,
1224 testProperty "sf_dropWhile" sf_dropWhile,
1152 testProperty "s_dropWhile" s_dropWhile,
1225 testProperty "s_dropWhile" s_dropWhile,
1153 testProperty "s_dropWhile_s" s_dropWhile_s,
1226 testProperty "s_dropWhile_s" s_dropWhile_s,
tests/Tests/QuickCheckUtils.hs+1−1
@@ -106,7 +106,7 @@ smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
106 where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
106 where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
107
107
108instance Arbitrary T.Text where
108instance Arbitrary T.Text where
109− arbitrary = T.pack `fmap` arbitrary
109+ arbitrary = T.pack `fmap` string
110 shrink = map T.pack . shrink . T.unpack
110 shrink = map T.pack . shrink . T.unpack
111
111
112instance Arbitrary TL.Text where
112instance Arbitrary TL.Text where
tests/Tests/Regressions.hs+11
@@ -72,6 +72,16 @@ mapAccumL_resize = do
72 assertEqual "mapAccumL should correctly size buffers for two-word results"
72 assertEqual "mapAccumL should correctly size buffers for two-word results"
73 (count * 2) (T.lengthWord16 (snd val))
73 (count * 2) (T.lengthWord16 (snd val))
74
74
75+-- See GitHub #197
76+t197 :: IO ()
77+t197 =
78+ assertBool "length (filter (==',') \"0,00\") should be 1" (currencyParser "0,00")
79+ where
80+ currencyParser x = cond == 1
81+ where
82+ cond = length fltr
83+ fltr = filter (== ',') x
84+
75tests :: F.Test
85tests :: F.Test
76tests = F.testGroup "Regressions"
86tests = F.testGroup "Regressions"
77 [ F.testCase "hGetContents_crash" hGetContents_crash
87 [ F.testCase "hGetContents_crash" hGetContents_crash
@@ -79,4 +89,5 @@ tests = F.testGroup "Regressions"
79 , F.testCase "mapAccumL_resize" mapAccumL_resize
89 , F.testCase "mapAccumL_resize" mapAccumL_resize
80 , F.testCase "replicate_crash" replicate_crash
90 , F.testCase "replicate_crash" replicate_crash
81 , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
91 , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
92+ , F.testCase "t197" t197
82 ]
93 ]
tests/text-tests.cabal+18−3
@@ -20,6 +20,11 @@ flag hpc
20 default: False
20 default: False
21 manual: True
21 manual: True
22
22
23+flag bytestring-builder
24+ description: Depend on the bytestring-builder package for backwards compatibility.
25+ default: False
26+ manual: False
27+
23executable text-tests
28executable text-tests
24 main-is: Tests.hs
29 main-is: Tests.hs
25
30
@@ -48,16 +53,21 @@ executable text-tests
48 HUnit >= 1.2,
53 HUnit >= 1.2,
49 QuickCheck >= 2.7,
54 QuickCheck >= 2.7,
50 base == 4.*,
55 base == 4.*,
51− bytestring,
52 deepseq,
56 deepseq,
53 directory,
57 directory,
54− quickcheck-unicode,
58+ quickcheck-unicode >= 1.0.1.0,
55 random,
59 random,
56 test-framework >= 0.4,
60 test-framework >= 0.4,
57 test-framework-hunit >= 0.2,
61 test-framework-hunit >= 0.2,
58 test-framework-quickcheck2 >= 0.2,
62 test-framework-quickcheck2 >= 0.2,
59 text-tests
63 text-tests
60
64
65+ if flag(bytestring-builder)
66+ build-depends: bytestring >= 0.9 && < 0.10.4,
67+ bytestring-builder >= 0.10.4
68+ else
69+ build-depends: bytestring >= 0.10.4
70+
61executable text-tests-stdio
71executable text-tests-stdio
62 main-is: Tests/IO.hs
72 main-is: Tests/IO.hs
63
73
@@ -137,7 +147,12 @@ library
137 array,
147 array,
138 base == 4.*,
148 base == 4.*,
139 binary,
149 binary,
140− bytestring,
141 deepseq,
150 deepseq,
142 ghc-prim,
151 ghc-prim,
143 integer-gmp
152 integer-gmp
153+
154+ if flag(bytestring-builder)
155+ build-depends: bytestring >= 0.9 && < 0.10.4,
156+ bytestring-builder >= 0.10.4
157+ else
158+ build-depends: bytestring >= 0.10.4
text.cabal+124−52
@@ -1,7 +1,7 @@
1name: text
1name: text
2−version: 1.2.2.1
2+version: 1.2.3.0
3−homepage: https://github.com/bos/text
3+homepage: https://github.com/haskell/text
4−bug-reports: https://github.com/bos/text/issues
4+bug-reports: https://github.com/haskell/text/issues
5synopsis: An efficient packed Unicode text type.
5synopsis: An efficient packed Unicode text type.
6description:
6description:
7 .
7 .
@@ -14,11 +14,13 @@ description:
14 in terms of large data quantities and high speed.
14 in terms of large data quantities and high speed.
15 .
15 .
16 The 'Text' type provides character-encoding, type-safe case
16 The 'Text' type provides character-encoding, type-safe case
17− conversion via whole-string case conversion functions. It also
17+ conversion via whole-string case conversion functions (see "Data.Text").
18− provides a range of functions for converting 'Text' values to and from
18+ It also provides a range of functions for converting 'Text' values to
19− 'ByteStrings', using several standard encodings.
19+ and from 'ByteStrings', using several standard encodings
20+ (see "Data.Text.Encoding").
20 .
21 .
21− Efficient locale-sensitive support for text IO is also supported.
22+ Efficient locale-sensitive support for text IO is also supported
23+ (see "Data.Text.IO").
22 .
24 .
23 These modules are intended to be imported qualified, to avoid name
25 These modules are intended to be imported qualified, to avoid name
24 clashes with Prelude functions, e.g.
26 clashes with Prelude functions, e.g.
@@ -28,8 +30,9 @@ description:
28 To use an extended and very rich family of functions for working
30 To use an extended and very rich family of functions for working
29 with Unicode text (including normalization, regular expressions,
31 with Unicode text (including normalization, regular expressions,
30 non-standard encodings, text breaking, and locales), see
32 non-standard encodings, text breaking, and locales), see
31− the @text-icu@ package:
32− <http://hackage.haskell.org/package/text-icu>
33+ the [text-icu package](https://hackage.haskell.org/package/text-icu)
34+ based on the well-respected and liberally
35+ licensed [ICU library](http://site.icu-project.org/).
33
36
34license: BSD2
37license: BSD2
35license-file: LICENSE
38license-file: LICENSE
@@ -39,6 +42,8 @@ copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper
39category: Data, Text
42category: Data, Text
40build-type: Simple
43build-type: Simple
41cabal-version: >= 1.8
44cabal-version: >= 1.8
45+tested-with: GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4,
46+ GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4
42extra-source-files:
47extra-source-files:
43 -- scripts/CaseFolding.txt
48 -- scripts/CaseFolding.txt
44 -- scripts/SpecialCasing.txt
49 -- scripts/SpecialCasing.txt
@@ -65,7 +70,9 @@ extra-source-files:
65 tests/text-tests.cabal
70 tests/text-tests.cabal
66
71
67flag bytestring-builder
72flag bytestring-builder
73+ description:
74+ Depend on the [bytestring-builder](https://hackage.haskell.org/package/bytestring-builder)
68− description: Depend on the bytestring-builder package for backwards compatibility.
75+ package for backwards compatibility.
69 default: False
76 default: False
70 manual: False
77 manual: False
71
78
@@ -75,7 +82,9 @@ flag developer
75 manual: True
82 manual: True
76
83
77flag integer-simple
84flag integer-simple
85+ description:
78− description: Use the simple integer library instead of GMP
86+ Use the [simple integer library](http://hackage.haskell.org/package/integer-simple)
87+ instead of [integer-gmp](http://hackage.haskell.org/package/integer-gmp)
79 default: False
88 default: False
80 manual: False
89 manual: False
81
90
@@ -158,51 +167,114 @@ library
158 cpp-options: -DINTEGER_GMP
167 cpp-options: -DINTEGER_GMP
159 build-depends: integer-gmp >= 0.2
168 build-depends: integer-gmp >= 0.2
160
169
161−test-suite tests
170+-- test-suite tests
162− type: exitcode-stdio-1.0
171+-- type: exitcode-stdio-1.0
163− hs-source-dirs: tests .
164− main-is: Tests.hs
165− c-sources: cbits/cbits.c
172+-- c-sources: cbits/cbits.c
166− include-dirs: include
173+-- include-dirs: include
167
174
168− ghc-options:
175+-- ghc-options:
169− -Wall -threaded -O0 -rtsopts
176+-- -Wall -threaded -rtsopts
170
177
171− cpp-options:
178+-- cpp-options:
172− -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
179+-- -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
173
180
174− build-depends:
181+-- -- modules specific to test-suite
175− HUnit >= 1.2,
182+-- hs-source-dirs: tests
176− QuickCheck >= 2.7,
183+-- main-is: Tests.hs
177− array,
184+-- other-modules:
178− base,
185+-- Tests.Properties
179− binary,
186+-- Tests.Properties.Mul
180− deepseq,
187+-- Tests.QuickCheckUtils
181− directory,
188+-- Tests.Regressions
182− ghc-prim,
189+-- Tests.SlowFunctions
183− quickcheck-unicode,
190+-- Tests.Utils
184− random,
185− test-framework >= 0.4,
186− test-framework-hunit >= 0.2,
187− test-framework-quickcheck2 >= 0.2
188
191
189− if flag(bytestring-builder)
192+-- -- Same as in `library` stanza; this is needed by cabal for accurate
190− build-depends: bytestring >= 0.9 && < 0.10.4,
193+-- -- file-monitoring as well as to avoid `-Wmissing-home-modules`
191− bytestring-builder >= 0.10.4
194+-- -- warnings We can't use an inter-package library dependency because
192− else
195+-- -- of different `ghc-options`/`cpp-options` (as a side-benefitt,
193− build-depends: bytestring >= 0.10.4
196+-- -- this enables per-component build parallelism in `cabal
197+-- -- new-build`!); We could, however, use cabal-version:2.2's `common`
198+-- -- blocks at some point in the future to reduce the duplication.
199+-- hs-source-dirs: .
200+-- other-modules:
201+-- Data.Text
202+-- Data.Text.Array
203+-- Data.Text.Encoding
204+-- Data.Text.Encoding.Error
205+-- Data.Text.Foreign
206+-- Data.Text.IO
207+-- Data.Text.Internal
208+-- Data.Text.Internal.Builder
209+-- Data.Text.Internal.Builder.Functions
210+-- Data.Text.Internal.Builder.Int.Digits
211+-- Data.Text.Internal.Builder.RealFloat.Functions
212+-- Data.Text.Internal.Encoding.Fusion
213+-- Data.Text.Internal.Encoding.Fusion.Common
214+-- Data.Text.Internal.Encoding.Utf16
215+-- Data.Text.Internal.Encoding.Utf32
216+-- Data.Text.Internal.Encoding.Utf8
217+-- Data.Text.Internal.Functions
218+-- Data.Text.Internal.Fusion
219+-- Data.Text.Internal.Fusion.CaseMapping
220+-- Data.Text.Internal.Fusion.Common
221+-- Data.Text.Internal.Fusion.Size
222+-- Data.Text.Internal.Fusion.Types
223+-- Data.Text.Internal.IO
224+-- Data.Text.Internal.Lazy
225+-- Data.Text.Internal.Lazy.Encoding.Fusion
226+-- Data.Text.Internal.Lazy.Fusion
227+-- Data.Text.Internal.Lazy.Search
228+-- Data.Text.Internal.Private
229+-- Data.Text.Internal.Read
230+-- Data.Text.Internal.Search
231+-- Data.Text.Internal.Unsafe
232+-- Data.Text.Internal.Unsafe.Char
233+-- Data.Text.Internal.Unsafe.Shift
234+-- Data.Text.Lazy
235+-- Data.Text.Lazy.Builder
236+-- Data.Text.Lazy.Builder.Int
237+-- Data.Text.Lazy.Builder.RealFloat
238+-- Data.Text.Lazy.Encoding
239+-- Data.Text.Lazy.IO
240+-- Data.Text.Lazy.Internal
241+-- Data.Text.Lazy.Read
242+-- Data.Text.Read
243+-- Data.Text.Unsafe
244+-- Data.Text.Show
194
245
246+-- build-depends:
247+-- HUnit >= 1.2,
248+-- QuickCheck >= 2.7 && < 2.10,
249+-- array,
250+-- base,
251+-- binary,
252+-- deepseq,
253+-- directory,
254+-- ghc-prim,
255+-- quickcheck-unicode >= 1.0.1.0,
256+-- random,
257+-- test-framework >= 0.4,
258+-- test-framework-hunit >= 0.2,
259+-- test-framework-quickcheck2 >= 0.2
260+
261+-- if flag(bytestring-builder)
262+-- build-depends: bytestring >= 0.9 && < 0.10.4,
263+-- bytestring-builder >= 0.10.4
264+-- else
265+-- build-depends: bytestring >= 0.10.4
266+
195− if flag(integer-simple)
267+-- if flag(integer-simple)
196− cpp-options: -DINTEGER_SIMPLE
268+-- cpp-options: -DINTEGER_SIMPLE
197− build-depends: integer-simple >= 0.1 && < 0.5
269+-- build-depends: integer-simple >= 0.1 && < 0.5
198− else
270+-- else
199− cpp-options: -DINTEGER_GMP
271+-- cpp-options: -DINTEGER_GMP
200− build-depends: integer-gmp >= 0.2
272+-- build-depends: integer-gmp >= 0.2
201
273
202−source-repository head
274+-- source-repository head
203− type: git
275+-- type: git
204− location: https://github.com/bos/text
276+-- location: https://github.com/haskell/text
205
277
206−source-repository head
278+-- source-repository head
207− type: mercurial
279+-- type: mercurial
208− location: https://bitbucket.org/bos/text
280+-- location: https://bitbucket.org/bos/text