on f7ba53c 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+698−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,76 @@ 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 (unsafeUnpackJSString#)
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.
281+ pack (GHC.Base.build (GHC.unpackFoldrCString# s)) =
282+ Text (JSString (unsafeUnpackJSString# s)) #-}
283+
284+-- | /O(n)/ Convert a literal string into a JSString. Subject to fusion.
285+unpackCString# :: Addr# -> Text
286+unpackCString# addr# = Text $ SJS.unstream (SJS.streamCString# addr#)
287+{-# NOINLINE unpackCString# #-}
288+
289+{-# RULES "TEXT literal" forall a.
290+ unstream (S.map safe (S.streamList (GHC.unpackCString# a)))
291+ = unpackCString# a #-}
292+
293+{-# RULES "TEXT literal UTF8" [1] forall a.
294+ unstream (S.map safe (S.streamList (GHC.unpackCStringUtf8# a)))
295+ = unpackCString# a #-}
296+
297+{-# RULES "TEXT empty literal" [1]
298+ unstream (S.map safe (S.streamList []))
299+ = empty_ #-}
300+
301+{-# RULES "TEXT singleton literal" [1] forall a.
302+ unstream (S.map safe (S.streamList [a]))
303+ = singleton a #-}
304+
305+#if MIN_VERSION_ghcjs_prim(0,1,1)
306+{-# RULES "TEXT literal prim" [0] forall a.
307+ unpackCString# a = Text (JSString (unsafeUnpackJSString# a))
308+ #-}
309+#endif
310+
311+---------------------------------------------------------------------
312+-- $character_definition
313+--
314+-- This package uses the term /character/ to denote Unicode /code points/.
315+--
316+-- Note that this is not the same thing as a grapheme (e.g. a
317+-- composition of code points that form one visual symbol). For
318+-- instance, consider the grapheme \"&#x00e4;\". This symbol has two
319+-- Unicode representations: a single code-point representation
320+-- @U+00E4@ (the @LATIN SMALL LETTER A WITH DIAERESIS@ code point),
321+-- and a two code point representation @U+0061@ (the \"@A@\" code
322+-- point) and @U+0308@ (the @COMBINING DIAERESIS@ code point).
323+
249-- $strict
324-- $strict
250--
325--
251-- This package provides both strict and lazy 'Text' types. The
326-- This package provides both strict and lazy 'Text' types. The
@@ -321,22 +396,31 @@ import Text.Printf (PrintfArg, formatArg, formatString)
321-- Functions that can be fused by the compiler are documented with the
396-- Functions that can be fused by the compiler are documented with the
322-- phrase \"Subject to fusion\".
397-- phrase \"Subject to fusion\".
323
398
399+-- instance Eq Text where
400+-- Text arrA offA lenA == Text arrB offB lenB
401+-- | lenA == lenB = A.equal arrA offA arrB offB lenA
402+-- | otherwise = False
403+-- {-# INLINE (==) #-}
324instance Eq Text where
404instance Eq Text where
325− Text arrA offA lenA == Text arrB offB lenB
405+ Text x == Text y = x == y
326− | lenA == lenB = A.equal arrA offA arrB offB lenA
406+
327− | otherwise = False
407+-- instance Ord Text where
328− {-# INLINE (==) #-}
408+-- compare = compareText
329
409
330instance Ord Text where
410instance Ord Text where
331− compare = compareText
411+ compare (Text x) (Text y) = compare x y
332
412
333instance Read Text where
413instance Read Text where
334 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
414 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
335
415
336#if MIN_VERSION_base(4,9,0)
416#if MIN_VERSION_base(4,9,0)
417+-- | Non-orphan 'Semigroup' instance only defined for
337−-- Semigroup orphan instances for older GHCs are provided by
418+-- @base-4.9.0.0@ and later; orphan instances for older GHCs are
419+-- provided by
420+-- the [semigroups](http://hackage.haskell.org/package/semigroups)
338−-- 'semigroups` package
421+-- package
339−
422+--
423+-- @since 1.2.2.0
340instance Semigroup Text where
424instance Semigroup Text where
341 (<>) = append
425 (<>) = append
342#endif
426#endif
@@ -354,6 +438,7 @@ instance IsString Text where
354 fromString = pack
438 fromString = pack
355
439
356#if __GLASGOW_HASKELL__ >= 708
440#if __GLASGOW_HASKELL__ >= 708
441+-- | @since 1.2.0.0
357instance Exts.IsList Text where
442instance Exts.IsList Text where
358 type Item Text = Char
443 type Item Text = Char
359 fromList = pack
444 fromList = pack
@@ -364,6 +449,7 @@ instance Exts.IsList Text where
364instance NFData Text where rnf !_ = ()
449instance NFData Text where rnf !_ = ()
365#endif
450#endif
366
451
452+-- | @since 1.2.1.0
367instance Binary Text where
453instance Binary Text where
368 put t = put (encodeUtf8 t)
454 put t = put (encodeUtf8 t)
369 get = do
455 get = do
@@ -397,8 +483,10 @@ instance Data Text where
397
483
398#if MIN_VERSION_base(4,7,0)
484#if MIN_VERSION_base(4,7,0)
399-- | Only defined for @base-4.7.0.0@ and later
485-- | Only defined for @base-4.7.0.0@ and later
486+--
487+-- @since 1.2.2.0
400instance PrintfArg Text where
488instance PrintfArg Text where
401− formatArg txt = formatString $ unpack txt
489+ formatArg t = formatString $ unpack t
402#endif
490#endif
403
491
404packConstr :: Constr
492packConstr :: Constr
@@ -407,19 +495,19 @@ packConstr = mkConstr textDataType "pack" [] Prefix
407textDataType :: DataType
495textDataType :: DataType
408textDataType = mkDataType "Data.Text.Text" [packConstr]
496textDataType = mkDataType "Data.Text.Text" [packConstr]
409
497
410−-- | /O(n)/ Compare two 'Text' values lexicographically.
498+-- -- | /O(n)/ Compare two 'Text' values lexicographically.
411−compareText :: Text -> Text -> Ordering
499+-- compareText :: Text -> Text -> Ordering
412−compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
500+-- compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
413− | lenA == 0 && lenB == 0 = EQ
501+-- | lenA == 0 && lenB == 0 = EQ
414− | otherwise = go 0 0
502+-- | otherwise = go 0 0
415− where
503+-- where
416− go !i !j
504+-- go !i !j
417− | i >= lenA || j >= lenB = compare lenA lenB
505+-- | i >= lenA || j >= lenB = compare lenA lenB
418− | a < b = LT
506+-- | a < b = LT
419− | a > b = GT
507+-- | a > b = GT
420− | otherwise = go (i+di) (j+dj)
508+-- | otherwise = go (i+di) (j+dj)
421− where Iter a di = iter ta i
509+-- where Iter a di = iter ta i
422− Iter b dj = iter tb j
510+-- Iter b dj = iter tb j
423
511
424-- -----------------------------------------------------------------------------
512-- -----------------------------------------------------------------------------
425-- * Conversion to/from 'Text'
513-- * Conversion to/from 'Text'
@@ -427,7 +515,8 @@ compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
427-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
515-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
428-- fusion. Performs replacement on invalid scalar values.
516-- fusion. Performs replacement on invalid scalar values.
429pack :: String -> Text
517pack :: String -> Text
518+pack = coerce JSS.pack
430−pack = unstream . S.map safe . S.streamList
519+-- pack = unstream . S.map safe . S.streamList
431{-# INLINE [1] pack #-}
520{-# INLINE [1] pack #-}
432
521
433-- -----------------------------------------------------------------------------
522-- -----------------------------------------------------------------------------
@@ -438,7 +527,8 @@ pack = unstream . S.map safe . S.streamList
438-- copying a new array. Subject to fusion. Performs replacement on
527-- copying a new array. Subject to fusion. Performs replacement on
439-- invalid scalar values.
528-- invalid scalar values.
440cons :: Char -> Text -> Text
529cons :: Char -> Text -> Text
530+cons = coerce JSS.cons
441−cons c t = unstream (S.cons (safe c) (stream t))
531+-- cons c t = unstream (S.cons (safe c) (stream t))
442{-# INLINE cons #-}
532{-# INLINE cons #-}
443
533
444infixr 5 `cons`
534infixr 5 `cons`
@@ -447,25 +537,27 @@ infixr 5 `cons`
447-- entire array in the process, unless fused. Subject to fusion.
537-- entire array in the process, unless fused. Subject to fusion.
448-- Performs replacement on invalid scalar values.
538-- Performs replacement on invalid scalar values.
449snoc :: Text -> Char -> Text
539snoc :: Text -> Char -> Text
540+snoc = coerce JSS.snoc
450−snoc t c = unstream (S.snoc (stream t) (safe c))
541+-- snoc t c = unstream (S.snoc (stream t) (safe c))
451{-# INLINE snoc #-}
542{-# INLINE snoc #-}
452
543
453-- | /O(n)/ Appends one 'Text' to the other by copying both of them
544-- | /O(n)/ Appends one 'Text' to the other by copying both of them
454-- into a new 'Text'. Subject to fusion.
545-- into a new 'Text'. Subject to fusion.
455append :: Text -> Text -> Text
546append :: Text -> Text -> Text
547+append = coerce JSS.append
456−append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
548+-- append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
457− | len1 == 0 = b
549+-- | len1 == 0 = b
458− | len2 == 0 = a
550+-- | len2 == 0 = a
459− | len > 0 = Text (A.run x) 0 len
551+-- | len > 0 = Text (A.run x) 0 len
460− | otherwise = overflowError "append"
552+-- | otherwise = overflowError "append"
461− where
553+-- where
462− len = len1+len2
554+-- len = len1+len2
463− x :: ST s (A.MArray s)
555+-- x :: ST s (A.MArray s)
464− x = do
556+-- x = do
465− arr <- A.new len
557+-- arr <- A.new len
466− A.copyI arr 0 arr1 off1 len1
558+-- A.copyI arr 0 arr1 off1 len1
467− A.copyI arr len1 arr2 off2 len
559+-- A.copyI arr len1 arr2 off2 len
468− return arr
560+-- return arr
469{-# NOINLINE append #-}
561{-# NOINLINE append #-}
470
562
471{-# RULES
563{-# RULES
@@ -478,16 +570,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
570-- | /O(1)/ Returns the first character of a 'Text', which must be
479-- non-empty. Subject to fusion.
571-- non-empty. Subject to fusion.
480head :: Text -> Char
572head :: Text -> Char
573+head = coerce JSS.head
481−head t = S.head (stream t)
574+-- head t = S.head (stream t)
482{-# INLINE head #-}
575{-# INLINE head #-}
483
576
484-- | /O(1)/ Returns the first character and rest of a 'Text', or
577-- | /O(1)/ Returns the first character and rest of a 'Text', or
485-- 'Nothing' if empty. Subject to fusion.
578-- 'Nothing' if empty. Subject to fusion.
486uncons :: Text -> Maybe (Char, Text)
579uncons :: Text -> Maybe (Char, Text)
580+uncons = coerce JSS.uncons
487−uncons t@(Text arr off len)
581+-- uncons t@(Text arr off len)
488− | len <= 0 = Nothing
582+-- | len <= 0 = Nothing
489− | otherwise = Just $ let !(Iter c d) = iter t 0
583+-- | otherwise = Just $ let !(Iter c d) = iter t 0
490− in (c, text arr (off+d) (len-d))
584+-- in (c, text arr (off+d) (len-d))
491{-# INLINE [1] uncons #-}
585{-# INLINE [1] uncons #-}
492
586
493-- | Lifted from Control.Arrow and specialized.
587-- | Lifted from Control.Arrow and specialized.
@@ -497,12 +591,13 @@ second f (a, b) = (a, f b)
497-- | /O(1)/ Returns the last character of a 'Text', which must be
591-- | /O(1)/ Returns the last character of a 'Text', which must be
498-- non-empty. Subject to fusion.
592-- non-empty. Subject to fusion.
499last :: Text -> Char
593last :: Text -> Char
594+last = coerce JSS.last
500−last (Text arr off len)
595+-- last (Text arr off len)
501− | len <= 0 = emptyError "last"
596+-- | len <= 0 = emptyError "last"
502− | n < 0xDC00 || n > 0xDFFF = unsafeChr n
597+-- | n < 0xDC00 || n > 0xDFFF = unsafeChr n
503− | otherwise = U16.chr2 n0 n
598+-- | otherwise = U16.chr2 n0 n
504− where n = A.unsafeIndex arr (off+len-1)
599+-- where n = A.unsafeIndex arr (off+len-1)
505− n0 = A.unsafeIndex arr (off+len-2)
600+-- n0 = A.unsafeIndex arr (off+len-2)
506{-# INLINE [1] last #-}
601{-# INLINE [1] last #-}
507
602
508{-# RULES
603{-# RULES
@@ -515,10 +610,11 @@ last (Text arr off len)
515-- | /O(1)/ Returns all characters after the head of a 'Text', which
610-- | /O(1)/ Returns all characters after the head of a 'Text', which
516-- must be non-empty. Subject to fusion.
611-- must be non-empty. Subject to fusion.
517tail :: Text -> Text
612tail :: Text -> Text
613+tail = coerce JSS.tail
518−tail t@(Text arr off len)
614+-- tail t@(Text arr off len)
519− | len <= 0 = emptyError "tail"
615+-- | len <= 0 = emptyError "tail"
520− | otherwise = text arr (off+d) (len-d)
616+-- | otherwise = text arr (off+d) (len-d)
521− where d = iter_ t 0
617+-- where d = iter_ t 0
522{-# INLINE [1] tail #-}
618{-# INLINE [1] tail #-}
523
619
524{-# RULES
620{-# RULES
@@ -531,11 +627,12 @@ tail t@(Text arr off len)
531-- | /O(1)/ Returns all but the last character of a 'Text', which must
627-- | /O(1)/ Returns all but the last character of a 'Text', which must
532-- be non-empty. Subject to fusion.
628-- be non-empty. Subject to fusion.
533init :: Text -> Text
629init :: Text -> Text
630+init = coerce JSS.init
534−init (Text arr off len) | len <= 0 = emptyError "init"
631+-- init (Text arr off len) | len <= 0 = emptyError "init"
535− | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
632+-- | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
536− | otherwise = text arr off (len-1)
633+-- | otherwise = text arr off (len-1)
537− where
634+-- where
538− n = A.unsafeIndex arr (off+len-1)
635+-- n = A.unsafeIndex arr (off+len-1)
539{-# INLINE [1] init #-}
636{-# INLINE [1] init #-}
540
637
541{-# RULES
638{-# RULES
@@ -545,14 +642,29 @@ init (Text arr off len) | len <= 0 = emptyError "init"
545 unstream (S.init (stream t)) = init t
642 unstream (S.init (stream t)) = init t
546 #-}
643 #-}
547
644
645+-- | /O(1)/ Returns all but the last character and the last character of a
646+-- 'Text', or 'Nothing' if empty.
647+--
648+-- @since 1.2.3.0
649+unsnoc :: Text -> Maybe (Text, Char)
650+unsnoc = coerce JSS.unsnoc
651+-- unsnoc (Text arr off len)
652+-- | len <= 0 = Nothing
653+-- | n < 0xDC00 || n > 0xDFFF = Just (text arr off (len-1), unsafeChr n)
654+-- | otherwise = Just (text arr off (len-2), U16.chr2 n0 n)
655+-- where n = A.unsafeIndex arr (off+len-1)
656+-- n0 = A.unsafeIndex arr (off+len-2)
657+{-# INLINE [1] unsnoc #-}
658+
548-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
659-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
549-- fusion.
660-- fusion.
550null :: Text -> Bool
661null :: Text -> Bool
662+null = coerce JSS.null
551−null (Text _arr _off len) =
663+-- null (Text _arr _off len) =
552−#if defined(ASSERTS)
664+-- #if defined(ASSERTS)
553− assert (len >= 0) $
665+-- assert (len >= 0) $
554−#endif
666+-- #endif
555− len <= 0
667+-- len <= 0
556{-# INLINE [1] null #-}
668{-# INLINE [1] null #-}
557
669
558{-# RULES
670{-# RULES
@@ -564,14 +676,15 @@ null (Text _arr _off len) =
564
676
565-- | /O(1)/ Tests whether a 'Text' contains exactly one character.
677-- | /O(1)/ Tests whether a 'Text' contains exactly one character.
566-- Subject to fusion.
678-- Subject to fusion.
567−isSingleton :: Text -> Bool
679+-- isSingleton :: Text -> Bool
568−isSingleton = S.isSingleton . stream
680+-- isSingleton = S.isSingleton . stream
569−{-# INLINE isSingleton #-}
681+-- {-# INLINE isSingleton #-}
570
682
571-- | /O(n)/ Returns the number of characters in a 'Text'.
683-- | /O(n)/ Returns the number of characters in a 'Text'.
572-- Subject to fusion.
684-- Subject to fusion.
573length :: Text -> Int
685length :: Text -> Int
686+length = coerce JSS.length
574−length t = S.length (stream t)
687+-- length t = S.length (stream t)
575{-# INLINE [0] length #-}
688{-# INLINE [0] length #-}
576-- length needs to be phased after the compareN/length rules otherwise
689-- length needs to be phased after the compareN/length rules otherwise
577-- it may inline before the rules have an opportunity to fire.
690-- it may inline before the rules have an opportunity to fire.
@@ -624,29 +737,58 @@ compareLength t n = S.compareLengthI (stream t) n
624-- -----------------------------------------------------------------------------
737-- -----------------------------------------------------------------------------
625-- * Transformations
738-- * Transformations
626-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
739-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
740+-- each element of @t@.
741+--
742+-- Example:
743+--
744+-- >>> let message = pack "I am not angry. Not at all."
745+-- >>> T.map (\c -> if c == '.' then '!' else c) message
746+-- "I am not angry! Not at all!"
747+--
627−-- each element of @t@. Subject to fusion. Performs replacement on
748+-- Subject to fusion. Performs replacement on invalid scalar values.
628−-- invalid scalar values.
629map :: (Char -> Char) -> Text -> Text
749map :: (Char -> Char) -> Text -> Text
750+map = coerce JSS.map
630−map f t = unstream (S.map (safe . f) (stream t))
751+-- map f t = unstream (S.map (safe . f) (stream t))
631{-# INLINE [1] map #-}
752{-# INLINE [1] map #-}
632
753
633-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
754-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
634-- 'Text's and concatenates the list after interspersing the first
755-- 'Text's and concatenates the list after interspersing the first
635-- argument between each element of the list.
756-- argument between each element of the list.
757+--
758+-- Example:
759+--
760+-- >>> T.intercalate "NI!" ["We", "seek", "the", "Holy", "Grail"]
761+-- "WeNI!seekNI!theNI!HolyNI!Grail"
636intercalate :: Text -> [Text] -> Text
762intercalate :: Text -> [Text] -> Text
763+intercalate = coerce JSS.intercalate
637−intercalate t = concat . (F.intersperse t)
764+-- intercalate t = concat . (F.intersperse t)
638{-# INLINE intercalate #-}
765{-# INLINE intercalate #-}
639
766
640-- | /O(n)/ The 'intersperse' function takes a character and places it
767-- | /O(n)/ The 'intersperse' function takes a character and places it
641−-- between the characters of a 'Text'. Subject to fusion. Performs
768+-- between the characters of a 'Text'.
769+--
770+-- Example:
771+--
772+-- >>> T.intersperse '.' "SHIELD"
773+-- "S.H.I.E.L.D"
774+--
642−-- replacement on invalid scalar values.
775+-- Subject to fusion. Performs replacement on invalid scalar values.
643intersperse :: Char -> Text -> Text
776intersperse :: Char -> Text -> Text
777+intersperse = coerce JSS.intersperse
644−intersperse c t = unstream (S.intersperse (safe c) (stream t))
778+-- intersperse c t = unstream (S.intersperse (safe c) (stream t))
645{-# INLINE intersperse #-}
779{-# INLINE intersperse #-}
646
780
647−-- | /O(n)/ Reverse the characters of a string. Subject to fusion.
781+-- | /O(n)/ Reverse the characters of a string.
782+--
783+-- Example:
784+--
785+-- >>> T.reverse "desrever"
786+-- "reversed"
787+--
788+-- Subject to fusion.
648reverse :: Text -> Text
789reverse :: Text -> Text
790+reverse = coerce JSS.reverse
649−reverse t = S.reverse (stream t)
791+-- reverse t = S.reverse (stream t)
650{-# INLINE reverse #-}
792{-# INLINE reverse #-}
651
793
652-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
794-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
@@ -663,12 +805,14 @@ reverse t = S.reverse (stream t)
663-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
805-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
664-- be replaced recursively:
806-- be replaced recursively:
665--
807--
666−-- > replace "oo" "foo" "oo" == "foo"
808+-- >>> replace "oo" "foo" "oo"
809+-- "foo"
667--
810--
668-- In cases where several instances of @needle@ overlap, only the
811-- In cases where several instances of @needle@ overlap, only the
669-- first one will be replaced:
812-- first one will be replaced:
670--
813--
671−-- > replace "ofo" "bar" "ofofo" == "barfo"
814+-- >>> replace "ofo" "bar" "ofofo"
815+-- "barfo"
672--
816--
673-- In (unlikely) bad cases, this function's time complexity degrades
817-- In (unlikely) bad cases, this function's time complexity degrades
674-- towards /O(n*m)/.
818-- towards /O(n*m)/.
@@ -680,28 +824,29 @@ replace :: Text
680 -> Text
824 -> Text
681 -- ^ @haystack@ in which to search.
825 -- ^ @haystack@ in which to search.
682 -> Text
826 -> Text
827+replace = coerce JSS.replace
683−replace needle@(Text _ _ neeLen)
828+-- replace needle@(Text _ _ neeLen)
684− (Text repArr repOff repLen)
829+-- (Text repArr repOff repLen)
685− haystack@(Text hayArr hayOff hayLen)
830+-- haystack@(Text hayArr hayOff hayLen)
686− | neeLen == 0 = emptyError "replace"
831+-- | neeLen == 0 = emptyError "replace"
687− | L.null ixs = haystack
832+-- | L.null ixs = haystack
688− | len > 0 = Text (A.run x) 0 len
833+-- | len > 0 = Text (A.run x) 0 len
689− | otherwise = empty
834+-- | otherwise = empty
690− where
835+-- where
691− ixs = indices needle haystack
836+-- ixs = indices needle haystack
692− len = hayLen - (neeLen - repLen) `mul` L.length ixs
837+-- len = hayLen - (neeLen - repLen) `mul` L.length ixs
693− x :: ST s (A.MArray s)
838+-- x :: ST s (A.MArray s)
694− x = do
839+-- x = do
695− marr <- A.new len
840+-- marr <- A.new len
696− let loop (i:is) o d = do
841+-- let loop (i:is) o d = do
697− let d0 = d + i - o
842+-- let d0 = d + i - o
698− d1 = d0 + repLen
843+-- d1 = d0 + repLen
699− A.copyI marr d hayArr (hayOff+o) d0
844+-- A.copyI marr d hayArr (hayOff+o) d0
700− A.copyI marr d0 repArr repOff d1
845+-- A.copyI marr d0 repArr repOff d1
701− loop is (i + neeLen) d1
846+-- loop is (i + neeLen) d1
702− loop [] o d = A.copyI marr d hayArr (hayOff+o) len
847+-- loop [] o d = A.copyI marr d hayArr (hayOff+o) len
703− loop ixs 0 0
848+-- loop ixs 0 0
704− return marr
849+-- return marr
705
850
706-- ----------------------------------------------------------------------------
851-- ----------------------------------------------------------------------------
707-- ** Case conversions (folds)
852-- ** Case conversions (folds)
@@ -740,7 +885,8 @@ replace needle@(Text _ _ neeLen)
740-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)
885-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)
741-- instead of itself.
886-- instead of itself.
742toCaseFold :: Text -> Text
887toCaseFold :: Text -> Text
743−toCaseFold t = unstream (S.toCaseFold (stream t))
888+-- toCaseFold t = unstream (S.toCaseFold (stream t))
889+toCaseFold = coerce JSS.toCaseFold
744{-# INLINE toCaseFold #-}
890{-# INLINE toCaseFold #-}
745
891
746-- | /O(n)/ Convert a string to lower case, using simple case
892-- | /O(n)/ Convert a string to lower case, using simple case
@@ -751,7 +897,8 @@ toCaseFold t = unstream (S.toCaseFold (stream t))
751-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
897-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
752-- followed by \" &#x307;\" (combining dot above, U+0307).
898-- followed by \" &#x307;\" (combining dot above, U+0307).
753toLower :: Text -> Text
899toLower :: Text -> Text
754−toLower t = unstream (S.toLower (stream t))
900+-- toLower t = unstream (S.toLower (stream t))
901+toLower = coerce JSS.toLower
755{-# INLINE toLower #-}
902{-# INLINE toLower #-}
756
903
757-- | /O(n)/ Convert a string to upper case, using simple case
904-- | /O(n)/ Convert a string to upper case, using simple case
@@ -761,7 +908,8 @@ toLower t = unstream (S.toLower (stream t))
761-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
908-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
762-- two-letter sequence \"SS\".
909-- two-letter sequence \"SS\".
763toUpper :: Text -> Text
910toUpper :: Text -> Text
764−toUpper t = unstream (S.toUpper (stream t))
911+-- toUpper t = unstream (S.toUpper (stream t))
912+toUpper = coerce JSS.toUpper
765{-# INLINE toUpper #-}
913{-# INLINE toUpper #-}
766
914
767-- | /O(n)/ Convert a string to title case, using simple case
915-- | /O(n)/ Convert a string to title case, using simple case
@@ -782,8 +930,11 @@ toUpper t = unstream (S.toUpper (stream t))
782-- guides disagree on whether the book name \"The Hill of the Red
930-- guides disagree on whether the book name \"The Hill of the Red
783-- Fox\" is correctly title cased&#x2014;but this function will
931-- Fox\" is correctly title cased&#x2014;but this function will
784-- capitalize /every/ word.
932-- capitalize /every/ word.
933+--
934+-- @since 1.0.0.0
785toTitle :: Text -> Text
935toTitle :: Text -> Text
936+toTitle = coerce JSS.toTitle
786−toTitle t = unstream (S.toTitle (stream t))
937+-- toTitle t = unstream (S.toTitle (stream t))
787{-# INLINE toTitle #-}
938{-# INLINE toTitle #-}
788
939
789-- | /O(n)/ Left-justify a string to the given length, using the
940-- | /O(n)/ Left-justify a string to the given length, using the
@@ -792,13 +943,17 @@ toTitle t = unstream (S.toTitle (stream t))
792--
943--
793-- Examples:
944-- Examples:
794--
945--
795−-- > justifyLeft 7 'x' "foo" == "fooxxxx"
946+-- >>> justifyLeft 7 'x' "foo"
947+-- "fooxxxx"
948+--
796−-- > justifyLeft 3 'x' "foobar" == "foobar"
949+-- >>> justifyLeft 3 'x' "foobar"
950+-- "foobar"
797justifyLeft :: Int -> Char -> Text -> Text
951justifyLeft :: Int -> Char -> Text -> Text
798−justifyLeft k c t
952+justifyLeft = coerce JSS.justifyLeft
953+-- justifyLeft k c t
799− | len >= k = t
954+-- | len >= k = t
800− | otherwise = t `append` replicateChar (k-len) c
955+-- | otherwise = t `append` replicateChar (k-len) c
801− where len = length t
956+-- where len = length t
802{-# INLINE [1] justifyLeft #-}
957{-# INLINE [1] justifyLeft #-}
803
958
804{-# RULES
959{-# RULES
@@ -814,13 +969,17 @@ justifyLeft k c t
814--
969--
815-- Examples:
970-- Examples:
816--
971--
817−-- > justifyRight 7 'x' "bar" == "xxxxbar"
972+-- >>> justifyRight 7 'x' "bar"
973+-- "xxxxbar"
974+--
818−-- > justifyRight 3 'x' "foobar" == "foobar"
975+-- >>> justifyRight 3 'x' "foobar"
976+-- "foobar"
819justifyRight :: Int -> Char -> Text -> Text
977justifyRight :: Int -> Char -> Text -> Text
820−justifyRight k c t
978+justifyRight = coerce JSS.justifyRight
979+-- justifyRight k c t
821− | len >= k = t
980+-- | len >= k = t
822− | otherwise = replicateChar (k-len) c `append` t
981+-- | otherwise = replicateChar (k-len) c `append` t
823− where len = length t
982+-- where len = length t
824{-# INLINE justifyRight #-}
983{-# INLINE justifyRight #-}
825
984
826-- | /O(n)/ Center a string to the given length, using the specified
985-- | /O(n)/ Center a string to the given length, using the specified
@@ -829,23 +988,34 @@ justifyRight k c t
829--
988--
830-- Examples:
989-- Examples:
831--
990--
832−-- > center 8 'x' "HS" = "xxxHSxxx"
991+-- >>> center 8 'x' "HS"
992+-- "xxxHSxxx"
833center :: Int -> Char -> Text -> Text
993center :: Int -> Char -> Text -> Text
834−center k c t
994+center = coerce JSS.center
995+-- center k c t
835− | len >= k = t
996+-- | len >= k = t
836− | otherwise = replicateChar l c `append` t `append` replicateChar r c
997+-- | otherwise = replicateChar l c `append` t `append` replicateChar r c
837− where len = length t
998+-- where len = length t
838− d = k - len
999+-- d = k - len
839− r = d `quot` 2
1000+-- r = d `quot` 2
840− l = d - r
1001+-- l = d - r
841{-# INLINE center #-}
1002{-# INLINE center #-}
842
1003
843-- | /O(n)/ The 'transpose' function transposes the rows and columns
1004-- | /O(n)/ The 'transpose' function transposes the rows and columns
844-- of its 'Text' argument. Note that this function uses 'pack',
1005-- of its 'Text' argument. Note that this function uses 'pack',
845-- 'unpack', and the list version of transpose, and is thus not very
1006-- 'unpack', and the list version of transpose, and is thus not very
846-- efficient.
1007-- efficient.
1008+--
1009+-- Examples:
1010+--
1011+-- >>> transpose ["green","orange"]
1012+-- ["go","rr","ea","en","ng","e"]
1013+--
1014+-- >>> transpose ["blue","red"]
1015+-- ["br","le","ud","e"]
847transpose :: [Text] -> [Text]
1016transpose :: [Text] -> [Text]
1017+transpose = coerce JSS.transpose
848−transpose ts = P.map pack (L.transpose (P.map unpack ts))
1018+-- transpose ts = P.map pack (L.transpose (P.map unpack ts))
849
1019
850-- -----------------------------------------------------------------------------
1020-- -----------------------------------------------------------------------------
851-- * Reducing 'Text's (folds)
1021-- * Reducing 'Text's (folds)
@@ -855,23 +1025,27 @@ transpose ts = P.map pack (L.transpose (P.map unpack ts))
855-- reduces the 'Text' using the binary operator, from left to right.
1025-- reduces the 'Text' using the binary operator, from left to right.
856-- Subject to fusion.
1026-- Subject to fusion.
857foldl :: (a -> Char -> a) -> a -> Text -> a
1027foldl :: (a -> Char -> a) -> a -> Text -> a
1028+foldl f a0 (Text t) = JSS.foldl f a0 t
858−foldl f z t = S.foldl f z (stream t)
1029+-- foldl f z t = S.foldl f z (stream t)
859{-# INLINE foldl #-}
1030{-# INLINE foldl #-}
860
1031
861-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.
1032-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.
862foldl' :: (a -> Char -> a) -> a -> Text -> a
1033foldl' :: (a -> Char -> a) -> a -> Text -> a
1034+foldl' f a0 (Text t) = JSS.foldl' f a0 t
863−foldl' f z t = S.foldl' f z (stream t)
1035+-- foldl' f z t = S.foldl' f z (stream t)
864{-# INLINE foldl' #-}
1036{-# INLINE foldl' #-}
865
1037
866-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
1038-- | /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.
1039-- and thus must be applied to a non-empty 'Text'. Subject to fusion.
868foldl1 :: (Char -> Char -> Char) -> Text -> Char
1040foldl1 :: (Char -> Char -> Char) -> Text -> Char
1041+foldl1 = coerce JSS.foldl1
869−foldl1 f t = S.foldl1 f (stream t)
1042+-- foldl1 f t = S.foldl1 f (stream t)
870{-# INLINE foldl1 #-}
1043{-# INLINE foldl1 #-}
871
1044
872-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.
1045-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.
873foldl1' :: (Char -> Char -> Char) -> Text -> Char
1046foldl1' :: (Char -> Char -> Char) -> Text -> Char
1047+foldl1' = coerce JSS.foldl1'
874−foldl1' f t = S.foldl1' f (stream t)
1048+-- foldl1' f t = S.foldl1' f (stream t)
875{-# INLINE foldl1' #-}
1049{-# INLINE foldl1' #-}
876
1050
877-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
1051-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
@@ -879,14 +1053,16 @@ foldl1' f t = S.foldl1' f (stream t)
879-- reduces the 'Text' using the binary operator, from right to left.
1053-- reduces the 'Text' using the binary operator, from right to left.
880-- Subject to fusion.
1054-- Subject to fusion.
881foldr :: (Char -> a -> a) -> a -> Text -> a
1055foldr :: (Char -> a -> a) -> a -> Text -> a
1056+foldr f a0 (Text t) = JSS.foldr f a0 t
882−foldr f z t = S.foldr f z (stream t)
1057+-- foldr f z t = S.foldr f z (stream t)
883{-# INLINE foldr #-}
1058{-# INLINE foldr #-}
884
1059
885-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
1060-- | /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
1061-- and thus must be applied to a non-empty 'Text'. Subject to
887-- fusion.
1062-- fusion.
888foldr1 :: (Char -> Char -> Char) -> Text -> Char
1063foldr1 :: (Char -> Char -> Char) -> Text -> Char
1064+foldr1 = coerce JSS.foldr1
889−foldr1 f t = S.foldr1 f (stream t)
1065+-- foldr1 f t = S.foldr1 f (stream t)
890{-# INLINE foldr1 #-}
1066{-# INLINE foldr1 #-}
891
1067
892-- -----------------------------------------------------------------------------
1068-- -----------------------------------------------------------------------------
@@ -894,48 +1070,54 @@ foldr1 f t = S.foldr1 f (stream t)
894
1070
895-- | /O(n)/ Concatenate a list of 'Text's.
1071-- | /O(n)/ Concatenate a list of 'Text's.
896concat :: [Text] -> Text
1072concat :: [Text] -> Text
1073+concat = coerce JSS.concat
897−concat ts = case ts' of
1074+-- concat ts = case ts' of
898− [] -> empty
1075+-- [] -> empty
899− [t] -> t
1076+-- [t] -> t
900− _ -> Text (A.run go) 0 len
1077+-- _ -> Text (A.run go) 0 len
901− where
1078+-- where
902− ts' = L.filter (not . null) ts
1079+-- ts' = L.filter (not . null) ts
903− len = sumP "concat" $ L.map lengthWord16 ts'
1080+-- len = sumP "concat" $ L.map lengthWord16 ts'
904− go :: ST s (A.MArray s)
1081+-- go :: ST s (A.MArray s)
905− go = do
1082+-- go = do
906− arr <- A.new len
1083+-- arr <- A.new len
907− let step i (Text a o l) =
1084+-- let step i (Text a o l) =
908− let !j = i + l in A.copyI arr i a o j >> return j
1085+-- let !j = i + l in A.copyI arr i a o j >> return j
909− foldM step 0 ts' >> return arr
1086+-- foldM step 0 ts' >> return arr
910
1087
911-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
1088-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
912-- concatenate the results.
1089-- concatenate the results.
913concatMap :: (Char -> Text) -> Text -> Text
1090concatMap :: (Char -> Text) -> Text -> Text
1091+concatMap = coerce JSS.concatMap
914−concatMap f = concat . foldr ((:) . f) []
1092+-- concatMap f = concat . foldr ((:) . f) []
915{-# INLINE concatMap #-}
1093{-# INLINE concatMap #-}
916
1094
917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
1095-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
918-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
1096-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
919any :: (Char -> Bool) -> Text -> Bool
1097any :: (Char -> Bool) -> Text -> Bool
1098+any = coerce JSS.any
920−any p t = S.any p (stream t)
1099+-- any p t = S.any p (stream t)
921{-# INLINE any #-}
1100{-# INLINE any #-}
922
1101
923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
1102-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
924-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
1103-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
925all :: (Char -> Bool) -> Text -> Bool
1104all :: (Char -> Bool) -> Text -> Bool
1105+all = coerce JSS.all
926−all p t = S.all p (stream t)
1106+-- all p t = S.all p (stream t)
927{-# INLINE all #-}
1107{-# INLINE all #-}
928
1108
929-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
1109-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
930-- must be non-empty. Subject to fusion.
1110-- must be non-empty. Subject to fusion.
931maximum :: Text -> Char
1111maximum :: Text -> Char
1112+maximum = coerce JSS.maximum
932−maximum t = S.maximum (stream t)
1113+-- maximum t = S.maximum (stream t)
933{-# INLINE maximum #-}
1114{-# INLINE maximum #-}
934
1115
935-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
1116-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
936-- must be non-empty. Subject to fusion.
1117-- must be non-empty. Subject to fusion.
937minimum :: Text -> Char
1118minimum :: Text -> Char
1119+minimum = coerce JSS.minimum
938−minimum t = S.minimum (stream t)
1120+-- minimum t = S.minimum (stream t)
939{-# INLINE minimum #-}
1121{-# INLINE minimum #-}
940
1122
941-- -----------------------------------------------------------------------------
1123-- -----------------------------------------------------------------------------
@@ -951,8 +1133,9 @@ minimum t = S.minimum (stream t)
951--
1133--
952-- > last (scanl f z xs) == foldl f z xs.
1134-- > last (scanl f z xs) == foldl f z xs.
953scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
1135scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
1136+scanl = coerce JSS.scanl
954−scanl f z t = unstream (S.scanl g z (stream t))
1137+-- scanl f z t = unstream (S.scanl g z (stream t))
955− where g a b = safe (f a b)
1138+-- where g a b = safe (f a b)
956{-# INLINE scanl #-}
1139{-# INLINE scanl #-}
957
1140
958-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
1141-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
@@ -961,8 +1144,9 @@ scanl f z t = unstream (S.scanl g z (stream t))
961--
1144--
962-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
1145-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
963scanl1 :: (Char -> Char -> Char) -> Text -> Text
1146scanl1 :: (Char -> Char -> Char) -> Text -> Text
1147+scanl1 = coerce JSS.scanl1
964−scanl1 f t | null t = empty
1148+-- scanl1 f t | null t = empty
965− | otherwise = scanl f (unsafeHead t) (unsafeTail t)
1149+-- | otherwise = scanl f (unsafeHead t) (unsafeTail t)
966{-# INLINE scanl1 #-}
1150{-# INLINE scanl1 #-}
967
1151
968-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
1152-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
@@ -970,16 +1154,18 @@ scanl1 f t | null t = empty
970--
1154--
971-- > scanr f v == reverse . scanl (flip f) v . reverse
1155-- > scanr f v == reverse . scanl (flip f) v . reverse
972scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
1156scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
1157+scanr = coerce JSS.scanr
973−scanr f z = S.reverse . S.reverseScanr g z . reverseStream
1158+-- scanr f z = S.reverse . S.reverseScanr g z . reverseStream
974− where g a b = safe (f a b)
1159+-- where g a b = safe (f a b)
975{-# INLINE scanr #-}
1160{-# INLINE scanr #-}
976
1161
977-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
1162-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
978-- value argument. Subject to fusion. Performs replacement on
1163-- value argument. Subject to fusion. Performs replacement on
979-- invalid scalar values.
1164-- invalid scalar values.
980scanr1 :: (Char -> Char -> Char) -> Text -> Text
1165scanr1 :: (Char -> Char -> Char) -> Text -> Text
1166+scanr1 = coerce JSS.scanr1
981−scanr1 f t | null t = empty
1167+-- scanr1 f t | null t = empty
982− | otherwise = scanr f (last t) (init t)
1168+-- | otherwise = scanr f (last t) (init t)
983{-# INLINE scanr1 #-}
1169{-# INLINE scanr1 #-}
984
1170
985-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
1171-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
@@ -987,8 +1173,11 @@ scanr1 f t | null t = empty
987-- parameter from left to right, and returns a final 'Text'. Performs
1173-- parameter from left to right, and returns a final 'Text'. Performs
988-- replacement on invalid scalar values.
1174-- replacement on invalid scalar values.
989mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1175mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1176+mapAccumL f z0 (Text a) =
1177+ let (a', t) = JSS.mapAccumL f z0 a
1178+ in (a', Text t)
990−mapAccumL f z0 = S.mapAccumL g z0 . stream
1179+-- mapAccumL f z0 = S.mapAccumL g z0 . stream
991− where g a b = second safe (f a b)
1180+-- where g a b = second safe (f a b)
992{-# INLINE mapAccumL #-}
1181{-# INLINE mapAccumL #-}
993
1182
994-- | The 'mapAccumR' function behaves like a combination of 'map' and
1183-- | The 'mapAccumR' function behaves like a combination of 'map' and
@@ -998,8 +1187,11 @@ mapAccumL f z0 = S.mapAccumL g z0 . stream
998-- 'Text'.
1187-- 'Text'.
999-- Performs replacement on invalid scalar values.
1188-- Performs replacement on invalid scalar values.
1000mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1189mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1190+mapAccumR f z0 (Text a) =
1191+ let (a', t) = JSS.mapAccumR f z0 a
1192+ in (a', Text t)
1001−mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1193+-- mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1002− where g a b = second safe (f a b)
1194+-- where g a b = second safe (f a b)
1003{-# INLINE mapAccumR #-}
1195{-# INLINE mapAccumR #-}
1004
1196
1005-- -----------------------------------------------------------------------------
1197-- -----------------------------------------------------------------------------
@@ -1008,20 +1200,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
1200-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
1009-- @t@ repeated @n@ times.
1201-- @t@ repeated @n@ times.
1010replicate :: Int -> Text -> Text
1202replicate :: Int -> Text -> Text
1203+replicate = coerce JSS.replicate
1011−replicate n t@(Text a o l)
1204+-- replicate n t@(Text a o l)
1012− | n <= 0 || l <= 0 = empty
1205+-- | n <= 0 || l <= 0 = empty
1013− | n == 1 = t
1206+-- | n == 1 = t
1014− | isSingleton t = replicateChar n (unsafeHead t)
1207+-- | isSingleton t = replicateChar n (unsafeHead t)
1015− | otherwise = Text (A.run x) 0 len
1208+-- | otherwise = Text (A.run x) 0 len
1016− where
1209+-- where
1017− len = l `mul` n
1210+-- len = l `mul` n
1018− x :: ST s (A.MArray s)
1211+-- x :: ST s (A.MArray s)
1019− x = do
1212+-- x = do
1020− arr <- A.new len
1213+-- arr <- A.new len
1021− let loop !d !i | i >= n = return arr
1214+-- let loop !d !i | i >= n = return arr
1022− | otherwise = let m = d + l
1215+-- | otherwise = let m = d + l
1023− in A.copyI arr d a o m >> loop m (i+1)
1216+-- in A.copyI arr d a o m >> loop m (i+1)
1024− loop 0 0
1217+-- loop 0 0
1025{-# INLINE [1] replicate #-}
1218{-# INLINE [1] replicate #-}
1026
1219
1027{-# RULES
1220{-# RULES
@@ -1032,8 +1225,19 @@ replicate n t@(Text a o l)
1032-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1225-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1033-- value of every element. Subject to fusion.
1226-- value of every element. Subject to fusion.
1034replicateChar :: Int -> Char -> Text
1227replicateChar :: Int -> Char -> Text
1228+#ifndef __GHCJS__
1035replicateChar n c = unstream (S.replicateCharI n (safe c))
1229replicateChar n c = unstream (S.replicateCharI n (safe c))
1036{-# INLINE replicateChar #-}
1230{-# INLINE replicateChar #-}
1231+#else
1232+replicateChar n c = Text $ js_replicateChar n c
1233+{-# INLINE [1] replicateChar #-}
1234+{-# RULES
1235+"JSSTRING replicateChar -> fused" [~1] forall n c.
1236+ replicateChar n c = unstream (S.replicateCharI n (safe c))
1237+"JSSTRING replicateChar -> unfused" [1] forall n c.
1238+ unstream (S.replicateCharI n (safe c)) = replicateChar n c
1239+ #-}
1240+#endif
1037
1241
1038-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
1242-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
1039-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
1243-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
@@ -1043,7 +1247,8 @@ replicateChar n c = unstream (S.replicateCharI n (safe c))
1043-- string, and @b@ is the seed value for further production. Subject
1247-- string, and @b@ is the seed value for further production. Subject
1044-- to fusion. Performs replacement on invalid scalar values.
1248-- to fusion. Performs replacement on invalid scalar values.
1045unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1249unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1250+unfoldr f a = Text $ JSS.unfoldr f a
1046−unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1251+-- unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1047{-# INLINE unfoldr #-}
1252{-# INLINE unfoldr #-}
1048
1253
1049-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
1254-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
@@ -1053,7 +1258,8 @@ unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1053-- correct, otherwise its performance is similar to 'unfoldr'. Subject
1258-- correct, otherwise its performance is similar to 'unfoldr'. Subject
1054-- to fusion. Performs replacement on invalid scalar values.
1259-- to fusion. Performs replacement on invalid scalar values.
1055unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
1260unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
1261+unfoldrN n f a0 = Text $ JSS.unfoldrN n f a0
1056−unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)
1262+-- unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)
1057{-# INLINE unfoldrN #-}
1263{-# INLINE unfoldrN #-}
1058
1264
1059-- -----------------------------------------------------------------------------
1265-- -----------------------------------------------------------------------------
@@ -1063,18 +1269,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
1269-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than
1064-- the length of the Text. Subject to fusion.
1270-- the length of the Text. Subject to fusion.
1065take :: Int -> Text -> Text
1271take :: Int -> Text -> Text
1272+take = coerce JSS.take
1066−take n t@(Text arr off len)
1273+-- take n t@(Text arr off len)
1067− | n <= 0 = empty
1274+-- | n <= 0 = empty
1068− | n >= len = t
1275+-- | n >= len = t
1069− | otherwise = text arr off (iterN n t)
1276+-- | otherwise = text arr off (iterN n t)
1070{-# INLINE [1] take #-}
1277{-# INLINE [1] take #-}
1071
1278
1072−iterN :: Int -> Text -> Int
1279+-- iterN :: Int -> Text -> Int
1073−iterN n t@(Text _arr _off len) = loop 0 0
1280+-- iterN n t@(Text _arr _off len) = loop 0 0
1074− where loop !i !cnt
1281+-- where loop !i !cnt
1075− | i >= len || cnt >= n = i
1282+-- | i >= len || cnt >= n = i
1076− | otherwise = loop (i+d) (cnt+1)
1283+-- | otherwise = loop (i+d) (cnt+1)
1077− where d = iter_ t i
1284+-- where d = iter_ t i
1078
1285
1079{-# RULES
1286{-# RULES
1080"TEXT take -> fused" [~1] forall n t.
1287"TEXT take -> fused" [~1] forall n t.
@@ -1088,31 +1295,36 @@ iterN n t@(Text _arr _off len) = loop 0 0
1088--
1295--
1089-- Examples:
1296-- Examples:
1090--
1297--
1091−-- > takeEnd 3 "foobar" == "bar"
1298+-- >>> takeEnd 3 "foobar"
1299+-- "bar"
1300+--
1301+-- @since 1.1.1.0
1092takeEnd :: Int -> Text -> Text
1302takeEnd :: Int -> Text -> Text
1303+takeEnd = coerce JSS.takeEnd
1093−takeEnd n t@(Text arr off len)
1304+-- takeEnd n t@(Text arr off len)
1094− | n <= 0 = empty
1305+-- | n <= 0 = empty
1095− | n >= len = t
1306+-- | n >= len = t
1096− | otherwise = text arr (off+i) (len-i)
1307+-- | otherwise = text arr (off+i) (len-i)
1097− where i = iterNEnd n t
1308+-- where i = iterNEnd n t
1098−
1309+
1099−iterNEnd :: Int -> Text -> Int
1310+-- iterNEnd :: Int -> Text -> Int
1100−iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1311+-- iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1101− where loop i !m
1312+-- where loop i !m
1102− | i <= 0 = 0
1313+-- | i <= 0 = 0
1103− | m <= 1 = i
1314+-- | m <= 1 = i
1104− | otherwise = loop (i+d) (m-1)
1315+-- | otherwise = loop (i+d) (m-1)
1105− where d = reverseIter_ t i
1316+-- where d = reverseIter_ t i
1106
1317
1107-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1318-- | /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@
1319-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1109-- is greater than the length of the 'Text'. Subject to fusion.
1320-- is greater than the length of the 'Text'. Subject to fusion.
1110drop :: Int -> Text -> Text
1321drop :: Int -> Text -> Text
1322+drop = coerce JSS.drop
1111−drop n t@(Text arr off len)
1323+-- drop n t@(Text arr off len)
1112− | n <= 0 = t
1324+-- | n <= 0 = t
1113− | n >= len = empty
1325+-- | n >= len = empty
1114− | otherwise = text arr (off+i) (len-i)
1326+-- | otherwise = text arr (off+i) (len-i)
1115− where i = iterN n t
1327+-- where i = iterN n t
1116{-# INLINE [1] drop #-}
1328{-# INLINE [1] drop #-}
1117
1329
1118{-# RULES
1330{-# RULES
@@ -1127,22 +1339,27 @@ drop n t@(Text arr off len)
1127--
1339--
1128-- Examples:
1340-- Examples:
1129--
1341--
1130−-- > dropEnd 3 "foobar" == "foo"
1342+-- >>> dropEnd 3 "foobar"
1343+-- "foo"
1344+--
1345+-- @since 1.1.1.0
1131dropEnd :: Int -> Text -> Text
1346dropEnd :: Int -> Text -> Text
1347+dropEnd = coerce JSS.dropEnd
1132−dropEnd n t@(Text arr off len)
1348+-- dropEnd n t@(Text arr off len)
1133− | n <= 0 = t
1349+-- | n <= 0 = t
1134− | n >= len = empty
1350+-- | n >= len = empty
1135− | otherwise = text arr off (iterNEnd n t)
1351+-- | otherwise = text arr off (iterNEnd n t)
1136
1352
1137-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1353-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1138-- returns the longest prefix (possibly empty) of elements that
1354-- returns the longest prefix (possibly empty) of elements that
1139-- satisfy @p@. Subject to fusion.
1355-- satisfy @p@. Subject to fusion.
1140takeWhile :: (Char -> Bool) -> Text -> Text
1356takeWhile :: (Char -> Bool) -> Text -> Text
1357+takeWhile = coerce JSS.takeWhile
1141−takeWhile p t@(Text arr off len) = loop 0
1358+-- takeWhile p t@(Text arr off len) = loop 0
1142− where loop !i | i >= len = t
1359+-- where loop !i | i >= len = t
1143− | p c = loop (i+d)
1360+-- | p c = loop (i+d)
1144− | otherwise = text arr off i
1361+-- | otherwise = text arr off i
1145− where Iter c d = iter t i
1362+-- where Iter c d = iter t i
1146{-# INLINE [1] takeWhile #-}
1363{-# INLINE [1] takeWhile #-}
1147
1364
1148{-# RULES
1365{-# RULES
@@ -1157,13 +1374,25 @@ takeWhile p t@(Text arr off len) = loop 0
1157-- satisfy @p@. Subject to fusion.
1374-- satisfy @p@. Subject to fusion.
1158-- Examples:
1375-- Examples:
1159--
1376--
1160−-- > takeWhileEnd (=='o') "foo" == "oo"
1377+-- >>> takeWhileEnd (=='o') "foo"
1378+-- "oo"
1379+--
1380+-- @since 1.2.2.0
1161takeWhileEnd :: (Char -> Bool) -> Text -> Text
1381takeWhileEnd :: (Char -> Bool) -> Text -> Text
1382+#ifndef __GHCJS__
1162takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1383takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1163 where loop !i !l | l <= 0 = t
1384 where loop !i !l | l <= 0 = t
1164 | p c = loop (i+d) (l+d)
1385 | p c = loop (i+d) (l+d)
1165 | otherwise = text arr (off+l) (len-l)
1386 | otherwise = text arr (off+l) (len-l)
1166 where (c,d) = reverseIter t i
1387 where (c,d) = reverseIter t i
1388+#else
1389+takeWhileEnd p t@(Text jst) = loop (len-1) len
1390+ where loop !i !l | l <= 0 = t
1391+ | p c = loop (i+d) (l+d)
1392+ | otherwise = Text $ js_substr1 l jst
1393+ where (c,d) = reverseIter t i
1394+ len = length t
1395+#endif
1167{-# INLINE [1] takeWhileEnd #-}
1396{-# INLINE [1] takeWhileEnd #-}
1168
1397
1169{-# RULES
1398{-# RULES
@@ -1176,11 +1405,12 @@ takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1176-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1405-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1177-- 'takeWhile' @p@ @t@. Subject to fusion.
1406-- 'takeWhile' @p@ @t@. Subject to fusion.
1178dropWhile :: (Char -> Bool) -> Text -> Text
1407dropWhile :: (Char -> Bool) -> Text -> Text
1408+dropWhile = coerce JSS.dropWhile
1179−dropWhile p t@(Text arr off len) = loop 0 0
1409+-- dropWhile p t@(Text arr off len) = loop 0 0
1180− where loop !i !l | l >= len = empty
1410+-- where loop !i !l | l >= len = empty
1181− | p c = loop (i+d) (l+d)
1411+-- | p c = loop (i+d) (l+d)
1182− | otherwise = Text arr (off+i) (len-l)
1412+-- | otherwise = Text arr (off+i) (len-l)
1183− where Iter c d = iter t i
1413+
1184{-# INLINE [1] dropWhile #-}
1414{-# INLINE [1] dropWhile #-}
1185
1415
1186{-# RULES
1416{-# RULES
@@ -1196,13 +1426,15 @@ dropWhile p t@(Text arr off len) = loop 0 0
1196--
1426--
1197-- Examples:
1427-- Examples:
1198--
1428--
1199−-- > dropWhileEnd (=='.') "foo..." == "foo"
1429+-- >>> dropWhileEnd (=='.') "foo..."
1430+-- "foo"
1200dropWhileEnd :: (Char -> Bool) -> Text -> Text
1431dropWhileEnd :: (Char -> Bool) -> Text -> Text
1432+dropWhileEnd = coerce JSS.dropWhileEnd
1201−dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1433+-- dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1202− where loop !i !l | l <= 0 = empty
1434+-- where loop !i !l | l <= 0 = empty
1203− | p c = loop (i+d) (l+d)
1435+-- | p c = loop (i+d) (l+d)
1204− | otherwise = Text arr off l
1436+-- | otherwise = Text arr off l
1205− where (c,d) = reverseIter t i
1437+-- where (c,d) = reverseIter t i
1206{-# INLINE [1] dropWhileEnd #-}
1438{-# INLINE [1] dropWhileEnd #-}
1207
1439
1208{-# RULES
1440{-# RULES
@@ -1245,45 +1477,49 @@ strip = dropAround isSpace
1245-- prefix of @t@ of length @n@, and whose second is the remainder of
1477-- 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)@.
1478-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
1247splitAt :: Int -> Text -> (Text, Text)
1479splitAt :: Int -> Text -> (Text, Text)
1480+splitAt = coerce JSS.splitAt
1248−splitAt n t@(Text arr off len)
1481+-- splitAt n t@(Text arr off len)
1249− | n <= 0 = (empty, t)
1482+-- | n <= 0 = (empty, t)
1250− | n >= len = (t, empty)
1483+-- | n >= len = (t, empty)
1251− | otherwise = let k = iterN n t
1484+-- | otherwise = let k = iterN n t
1252− in (text arr off k, text arr (off+k) (len-k))
1485+-- in (text arr off k, text arr (off+k) (len-k))
1253
1486
1254-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1487-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1255-- a pair whose first element is the longest prefix (possibly empty)
1488-- a pair whose first element is the longest prefix (possibly empty)
1256-- of @t@ of elements that satisfy @p@, and whose second is the
1489-- of @t@ of elements that satisfy @p@, and whose second is the
1257-- remainder of the list.
1490-- remainder of the list.
1258span :: (Char -> Bool) -> Text -> (Text, Text)
1491span :: (Char -> Bool) -> Text -> (Text, Text)
1492+span = coerce JSS.span
1259−span p t = case span_ p t of
1493+-- span p t = case span_ p t of
1260− (# hd,tl #) -> (hd,tl)
1494+-- (# hd,tl #) -> (hd,tl)
1261{-# INLINE span #-}
1495{-# INLINE span #-}
1262
1496
1263-- | /O(n)/ 'break' is like 'span', but the prefix returned is
1497-- | /O(n)/ 'break' is like 'span', but the prefix returned is
1264-- over elements that fail the predicate @p@.
1498-- over elements that fail the predicate @p@.
1265break :: (Char -> Bool) -> Text -> (Text, Text)
1499break :: (Char -> Bool) -> Text -> (Text, Text)
1500+break = coerce JSS.break
1266−break p = span (not . p)
1501+-- break p = span (not . p)
1267{-# INLINE break #-}
1502{-# INLINE break #-}
1268
1503
1269-- | /O(n)/ Group characters in a string according to a predicate.
1504-- | /O(n)/ Group characters in a string according to a predicate.
1270groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
1505groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
1506+groupBy = coerce JSS.groupBy
1271−groupBy p = loop
1507+-- groupBy p = loop
1272− where
1508+-- where
1273− loop t@(Text arr off len)
1509+-- loop t@(Text arr off len)
1274− | null t = []
1510+-- | null t = []
1275− | otherwise = text arr off n : loop (text arr (off+n) (len-n))
1511+-- | otherwise = text arr off n : loop (text arr (off+n) (len-n))
1276− where Iter c d = iter t 0
1512+-- where Iter c d = iter t 0
1277− n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
1513+-- n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
1278
1514
1279-- | Returns the /array/ index (in units of 'Word16') at which a
1515-- | Returns the /array/ index (in units of 'Word16') at which a
1280-- character may be found. This is /not/ the same as the logical
1516-- character may be found. This is /not/ the same as the logical
1281-- index returned by e.g. 'findIndex'.
1517-- index returned by e.g. 'findIndex'.
1282−findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
1518+-- findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
1283−findAIndexOrEnd q t@(Text _arr _off len) = go 0
1519+-- findAIndexOrEnd q t@(Text _arr _off len) = go 0
1284− where go !i | i >= len || q c = i
1520+-- where go !i | i >= len || q c = i
1285− | otherwise = go (i+d)
1521+-- | otherwise = go (i+d)
1286− where Iter c d = iter t i
1522+-- where Iter c d = iter t i
1287
1523
1288-- | /O(n)/ Group characters in a string by equality.
1524-- | /O(n)/ Group characters in a string by equality.
1289group :: Text -> [Text]
1525group :: Text -> [Text]
@@ -1292,15 +1528,17 @@ group = groupBy (==)
1292-- | /O(n)/ Return all initial segments of the given 'Text', shortest
1528-- | /O(n)/ Return all initial segments of the given 'Text', shortest
1293-- first.
1529-- first.
1294inits :: Text -> [Text]
1530inits :: Text -> [Text]
1531+inits = coerce JSS.inits
1295−inits t@(Text arr off len) = loop 0
1532+-- inits t@(Text arr off len) = loop 0
1296− where loop i | i >= len = [t]
1533+-- where loop i | i >= len = [t]
1297− | otherwise = Text arr off i : loop (i + iter_ t i)
1534+-- | otherwise = Text arr off i : loop (i + iter_ t i)
1298
1535
1299-- | /O(n)/ Return all final segments of the given 'Text', longest
1536-- | /O(n)/ Return all final segments of the given 'Text', longest
1300-- first.
1537-- first.
1301tails :: Text -> [Text]
1538tails :: Text -> [Text]
1539+tails = coerce JSS.tails
1302−tails t | null t = [empty]
1540+-- tails t | null t = [empty]
1303− | otherwise = t : tails (unsafeTail t)
1541+-- | otherwise = t : tails (unsafeTail t)
1304
1542
1305-- $split
1543-- $split
1306--
1544--
@@ -1314,9 +1552,14 @@ tails t | null t = [empty]
1314--
1552--
1315-- Examples:
1553-- Examples:
1316--
1554--
1317−-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
1555+-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne"
1556+-- ["a","b","d","e"]
1557+--
1318−-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
1558+-- >>> splitOn "aaa" "aaaXaaaXaaaXaaa"
1559+-- ["","X","X","X",""]
1560+--
1319−-- > splitOn "x" "x" == ["",""]
1561+-- >>> splitOn "x" "x"
1562+-- ["",""]
1320--
1563--
1321-- and
1564-- and
1322--
1565--
@@ -1333,13 +1576,14 @@ splitOn :: Text
1333 -> Text
1576 -> Text
1334 -- ^ Input text.
1577 -- ^ Input text.
1335 -> [Text]
1578 -> [Text]
1579+splitOn = coerce JSS.splitOn
1336−splitOn pat@(Text _ _ l) src@(Text arr off len)
1580+-- splitOn pat@(Text _ _ l) src@(Text arr off len)
1337− | l <= 0 = emptyError "splitOn"
1581+-- | l <= 0 = emptyError "splitOn"
1338− | isSingleton pat = split (== unsafeHead pat) src
1582+-- | isSingleton pat = split (== unsafeHead pat) src
1339− | otherwise = go 0 (indices pat src)
1583+-- | otherwise = go 0 (indices pat src)
1340− where
1584+-- where
1341− go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1585+-- go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1342− go s _ = [text arr (s+off) (len-s)]
1586+-- go s _ = [text arr (s+off) (len-s)]
1343{-# INLINE [1] splitOn #-}
1587{-# INLINE [1] splitOn #-}
1344
1588
1345{-# RULES
1589{-# RULES
@@ -1352,28 +1596,36 @@ splitOn pat@(Text _ _ l) src@(Text arr off len)
1352-- resulting components do not contain the separators. Two adjacent
1596-- resulting components do not contain the separators. Two adjacent
1353-- separators result in an empty component in the output. eg.
1597-- separators result in an empty component in the output. eg.
1354--
1598--
1355−-- > split (=='a') "aabbaca" == ["","","bb","c",""]
1599+-- >>> split (=='a') "aabbaca"
1600+-- ["","","bb","c",""]
1601+--
1356−-- > split (=='a') "" == [""]
1602+-- >>> split (=='a') ""
1603+-- [""]
1357split :: (Char -> Bool) -> Text -> [Text]
1604split :: (Char -> Bool) -> Text -> [Text]
1605+split = coerce JSS.split
1358−split _ t@(Text _off _arr 0) = [t]
1606+-- split _ t@(Text _off _arr 0) = [t]
1359−split p t = loop t
1607+-- split p t = loop t
1360− where loop s | null s' = [l]
1608+-- where loop s | null s' = [l]
1361− | otherwise = l : loop (unsafeTail s')
1609+-- | otherwise = l : loop (unsafeTail s')
1362− where (# l, s' #) = span_ (not . p) s
1610+-- where (# l, s' #) = span_ (not . p) s
1363{-# INLINE split #-}
1611{-# INLINE split #-}
1364
1612
1365-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1613-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1366-- element may be shorter than the other chunks, depending on the
1614-- element may be shorter than the other chunks, depending on the
1367-- length of the input. Examples:
1615-- length of the input. Examples:
1368--
1616--
1369−-- > chunksOf 3 "foobarbaz" == ["foo","bar","baz"]
1617+-- >>> chunksOf 3 "foobarbaz"
1618+-- ["foo","bar","baz"]
1619+--
1370−-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]
1620+-- >>> chunksOf 4 "haskell.org"
1621+-- ["hask","ell.","org"]
1371chunksOf :: Int -> Text -> [Text]
1622chunksOf :: Int -> Text -> [Text]
1372−chunksOf k = go
1623+chunksOf = coerce JSS.chunksOf
1624+-- chunksOf k = go
1373− where
1625+-- where
1374− go t = case splitAt k t of
1626+-- go t = case splitAt k t of
1375− (a,b) | null a -> []
1627+-- (a,b) | null a -> []
1376− | otherwise -> a : go b
1628+-- | otherwise -> a : go b
1377{-# INLINE chunksOf #-}
1629{-# INLINE chunksOf #-}
1378
1630
1379-- ----------------------------------------------------------------------------
1631-- ----------------------------------------------------------------------------
@@ -1386,7 +1638,8 @@ chunksOf k = go
1386-- returns the first element matching the predicate, or 'Nothing' if
1638-- returns the first element matching the predicate, or 'Nothing' if
1387-- there is no such element.
1639-- there is no such element.
1388find :: (Char -> Bool) -> Text -> Maybe Char
1640find :: (Char -> Bool) -> Text -> Maybe Char
1641+find = coerce JSS.find
1389−find p t = S.findBy p (stream t)
1642+-- find p t = S.findBy p (stream t)
1390{-# INLINE find #-}
1643{-# INLINE find #-}
1391
1644
1392-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
1645-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
@@ -1395,14 +1648,16 @@ find p t = S.findBy p (stream t)
1395--
1648--
1396-- > partition p t == (filter p t, filter (not . p) t)
1649-- > partition p t == (filter p t, filter (not . p) t)
1397partition :: (Char -> Bool) -> Text -> (Text, Text)
1650partition :: (Char -> Bool) -> Text -> (Text, Text)
1651+partition = coerce JSS.partition
1398−partition p t = (filter p t, filter (not . p) t)
1652+-- partition p t = (filter p t, filter (not . p) t)
1399{-# INLINE partition #-}
1653{-# INLINE partition #-}
1400
1654
1401-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1655-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1402-- returns a 'Text' containing those characters that satisfy the
1656-- returns a 'Text' containing those characters that satisfy the
1403-- predicate.
1657-- predicate.
1404filter :: (Char -> Bool) -> Text -> Text
1658filter :: (Char -> Bool) -> Text -> Text
1659+filter = coerce JSS.filter
1405−filter p t = unstream (S.filter p (stream t))
1660+-- filter p t = unstream (S.filter p (stream t))
1406{-# INLINE filter #-}
1661{-# INLINE filter #-}
1407
1662
1408-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1663-- | /O(n+m)/ Find the first instance of @needle@ (which must be
@@ -1412,8 +1667,11 @@ filter p t = unstream (S.filter p (stream t))
1412--
1667--
1413-- Examples:
1668-- Examples:
1414--
1669--
1415−-- > breakOn "::" "a::b::c" ==> ("a", "::b::c")
1670+-- >>> breakOn "::" "a::b::c"
1671+-- ("a","::b::c")
1672+--
1416−-- > breakOn "/" "foobar" ==> ("foobar", "")
1673+-- >>> breakOn "/" "foobar"
1674+-- ("foobar","")
1417--
1675--
1418-- Laws:
1676-- Laws:
1419--
1677--
@@ -1427,11 +1685,12 @@ filter p t = unstream (S.filter p (stream t))
1427-- In (unlikely) bad cases, this function's time complexity degrades
1685-- In (unlikely) bad cases, this function's time complexity degrades
1428-- towards /O(n*m)/.
1686-- towards /O(n*m)/.
1429breakOn :: Text -> Text -> (Text, Text)
1687breakOn :: Text -> Text -> (Text, Text)
1688+breakOn = coerce JSS.breakOn
1430−breakOn pat src@(Text arr off len)
1689+-- breakOn pat src@(Text arr off len)
1431− | null pat = emptyError "breakOn"
1690+-- | null pat = emptyError "breakOn"
1432− | otherwise = case indices pat src of
1691+-- | otherwise = case indices pat src of
1433− [] -> (src, empty)
1692+-- [] -> (src, empty)
1434− (x:_) -> (text arr off x, text arr (off+x) (len-x))
1693+-- (x:_) -> (text arr off x, text arr (off+x) (len-x))
1435{-# INLINE breakOn #-}
1694{-# INLINE breakOn #-}
1436
1695
1437-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
1696-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
@@ -1441,10 +1700,12 @@ breakOn pat src@(Text arr off len)
1441-- up to and including the last match of @needle@. The second is the
1700-- up to and including the last match of @needle@. The second is the
1442-- remainder of @haystack@, following the match.
1701-- remainder of @haystack@, following the match.
1443--
1702--
1444−-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")
1703+-- >>> breakOnEnd "::" "a::b::c"
1704+-- ("a::b::","c")
1445breakOnEnd :: Text -> Text -> (Text, Text)
1705breakOnEnd :: Text -> Text -> (Text, Text)
1706+breakOnEnd = coerce JSS.breakOnEnd
1446−breakOnEnd pat src = (reverse b, reverse a)
1707+-- breakOnEnd pat src = (reverse b, reverse a)
1447− where (a,b) = breakOn (reverse pat) (reverse src)
1708+-- where (a,b) = breakOn (reverse pat) (reverse src)
1448{-# INLINE breakOnEnd #-}
1709{-# INLINE breakOnEnd #-}
1449
1710
1450-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
1711-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
@@ -1456,10 +1717,11 @@ breakOnEnd pat src = (reverse b, reverse a)
1456--
1717--
1457-- Examples:
1718-- Examples:
1458--
1719--
1459−-- > breakOnAll "::" ""
1720+-- >>> breakOnAll "::" ""
1460−-- > ==> []
1721+-- []
1722+--
1461−-- > breakOnAll "/" "a/b/c/"
1723+-- >>> breakOnAll "/" "a/b/c/"
1462−-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
1724+-- [("a","/b/c/"),("a/b","/c/"),("a/b/c","/")]
1463--
1725--
1464-- In (unlikely) bad cases, this function's time complexity degrades
1726-- In (unlikely) bad cases, this function's time complexity degrades
1465-- towards /O(n*m)/.
1727-- towards /O(n*m)/.
@@ -1468,12 +1730,13 @@ breakOnEnd pat src = (reverse b, reverse a)
1468breakOnAll :: Text -- ^ @needle@ to search for
1730breakOnAll :: Text -- ^ @needle@ to search for
1469 -> Text -- ^ @haystack@ in which to search
1731 -> Text -- ^ @haystack@ in which to search
1470 -> [(Text, Text)]
1732 -> [(Text, Text)]
1733+breakOnAll = coerce JSS.breakOnAll
1471−breakOnAll pat src@(Text arr off slen)
1734+-- breakOnAll pat src@(Text arr off slen)
1472− | null pat = emptyError "breakOnAll"
1735+-- | null pat = emptyError "breakOnAll"
1473− | otherwise = L.map step (indices pat src)
1736+-- | otherwise = L.map step (indices pat src)
1474− where
1737+-- where
1475− step x = (chunk 0 x, chunk x (slen-x))
1738+-- step x = (chunk 0 x, chunk x (slen-x))
1476− chunk !n !l = text arr (n+off) l
1739+-- chunk !n !l = text arr (n+off) l
1477{-# INLINE breakOnAll #-}
1740{-# INLINE breakOnAll #-}
1478
1741
1479-------------------------------------------------------------------------------
1742-------------------------------------------------------------------------------
@@ -1497,14 +1760,16 @@ breakOnAll pat src@(Text arr off slen)
1497
1760
1498-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1761-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1499index :: Text -> Int -> Char
1762index :: Text -> Int -> Char
1763+index = coerce JSS.index
1500−index t n = S.index (stream t) n
1764+-- index t n = S.index (stream t) n
1501{-# INLINE index #-}
1765{-# INLINE index #-}
1502
1766
1503-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
1767-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
1504-- and returns the index of the first element in the 'Text' satisfying
1768-- and returns the index of the first element in the 'Text' satisfying
1505-- the predicate. Subject to fusion.
1769-- the predicate. Subject to fusion.
1506findIndex :: (Char -> Bool) -> Text -> Maybe Int
1770findIndex :: (Char -> Bool) -> Text -> Maybe Int
1771+findIndex = coerce JSS.findIndex
1507−findIndex p t = S.findIndex p (stream t)
1772+-- findIndex p t = S.findIndex p (stream t)
1508{-# INLINE findIndex #-}
1773{-# INLINE findIndex #-}
1509
1774
1510-- | /O(n+m)/ The 'count' function returns the number of times the
1775-- | /O(n+m)/ The 'count' function returns the number of times the
@@ -1514,10 +1779,11 @@ findIndex p t = S.findIndex p (stream t)
1514-- In (unlikely) bad cases, this function's time complexity degrades
1779-- In (unlikely) bad cases, this function's time complexity degrades
1515-- towards /O(n*m)/.
1780-- towards /O(n*m)/.
1516count :: Text -> Text -> Int
1781count :: Text -> Text -> Int
1782+count = coerce JSS.count
1517−count pat src
1783+-- count pat src
1518− | null pat = emptyError "count"
1784+-- | null pat = emptyError "count"
1519− | isSingleton pat = countChar (unsafeHead pat) src
1785+-- | isSingleton pat = countChar (unsafeHead pat) src
1520− | otherwise = L.length (indices pat src)
1786+-- | otherwise = L.length (indices pat src)
1521{-# INLINE [1] count #-}
1787{-# INLINE [1] count #-}
1522
1788
1523{-# RULES
1789{-# RULES
@@ -1539,42 +1805,46 @@ countChar c t = S.countChar c (stream t)
1539-- excess elements of the longer 'Text' are discarded. This is
1805-- excess elements of the longer 'Text' are discarded. This is
1540-- equivalent to a pair of 'unpack' operations.
1806-- equivalent to a pair of 'unpack' operations.
1541zip :: Text -> Text -> [(Char,Char)]
1807zip :: Text -> Text -> [(Char,Char)]
1808+zip = coerce JSS.zip
1542−zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1809+-- zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1543{-# INLINE zip #-}
1810{-# INLINE zip #-}
1544
1811
1545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1812-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1546-- given as the first argument, instead of a tupling function.
1813-- given as the first argument, instead of a tupling function.
1547-- Performs replacement on invalid scalar values.
1814-- Performs replacement on invalid scalar values.
1548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1815zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1816+zipWith = coerce JSS.zipWith
1549−zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1817+-- zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1550− where g a b = safe (f a b)
1818+-- where g a b = safe (f a b)
1551{-# INLINE zipWith #-}
1819{-# INLINE zipWith #-}
1552
1820
1553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1821-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1554-- representing white space.
1822-- representing white space.
1555words :: Text -> [Text]
1823words :: Text -> [Text]
1824+words = coerce JSS.words
1556−words t@(Text arr off len) = loop 0 0
1825+-- words t@(Text arr off len) = loop 0 0
1557− where
1826+-- where
1558− loop !start !n
1827+-- loop !start !n
1559− | n >= len = if start == n
1828+-- | n >= len = if start == n
1560− then []
1829+-- then []
1561− else [Text arr (start+off) (n-start)]
1830+-- else [Text arr (start+off) (n-start)]
1562− | isSpace c =
1831+-- | isSpace c =
1563− if start == n
1832+-- if start == n
1564− then loop (start+1) (start+1)
1833+-- then loop (start+1) (start+1)
1565− else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1834+-- else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1566− | otherwise = loop start (n+d)
1835+-- | otherwise = loop start (n+d)
1567− where Iter c d = iter t n
1836+-- where Iter c d = iter t n
1568{-# INLINE words #-}
1837{-# INLINE words #-}
1569
1838
1570-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
1839-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
1571-- newline 'Char's. The resulting strings do not contain newlines.
1840-- newline 'Char's. The resulting strings do not contain newlines.
1572lines :: Text -> [Text]
1841lines :: Text -> [Text]
1842+lines = coerce JSS.lines
1573−lines ps | null ps = []
1843+-- lines ps | null ps = []
1574− | otherwise = h : if null t
1844+-- | otherwise = h : if null t
1575− then []
1845+-- then []
1576− else lines (unsafeTail t)
1846+-- else lines (unsafeTail t)
1577− where (# h,t #) = span_ (/= '\n') ps
1847+-- where (# h,t #) = span_ (/= '\n') ps
1578{-# INLINE lines #-}
1848{-# INLINE lines #-}
1579
1849
1580{-
1850{-
@@ -1602,34 +1872,40 @@ lines' ps | null ps = []
1602-- | /O(n)/ Joins lines, after appending a terminating newline to
1872-- | /O(n)/ Joins lines, after appending a terminating newline to
1603-- each.
1873-- each.
1604unlines :: [Text] -> Text
1874unlines :: [Text] -> Text
1875+unlines = coerce JSS.unlines
1605−unlines = concat . L.map (`snoc` '\n')
1876+-- unlines = concat . L.map (`snoc` '\n')
1606{-# INLINE unlines #-}
1877{-# INLINE unlines #-}
1607
1878
1608-- | /O(n)/ Joins words using single space characters.
1879-- | /O(n)/ Joins words using single space characters.
1609unwords :: [Text] -> Text
1880unwords :: [Text] -> Text
1881+unwords = coerce JSS.unwords
1610−unwords = intercalate (singleton ' ')
1882+-- unwords = intercalate (singleton ' ')
1611{-# INLINE unwords #-}
1883{-# INLINE unwords #-}
1612
1884
1613-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1885-- | /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.
1886-- 'True' iff the first is a prefix of the second. Subject to fusion.
1615isPrefixOf :: Text -> Text -> Bool
1887isPrefixOf :: Text -> Text -> Bool
1888+isPrefixOf = coerce JSS.isPrefixOf
1616−isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1889+-- isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1617− alen <= blen && S.isPrefixOf (stream a) (stream b)
1890+-- alen <= blen && S.isPrefixOf (stream a) (stream b)
1618{-# INLINE [1] isPrefixOf #-}
1891{-# INLINE [1] isPrefixOf #-}
1619
1892
1620{-# RULES
1893{-# RULES
1621"TEXT isPrefixOf -> fused" [~1] forall s t.
1894"TEXT isPrefixOf -> fused" [~1] forall s t.
1622 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1895 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1896+"JSSTRING isPrefixOf -> unfused" [1] forall x y.
1897+ S.isPrefixOf (stream x) (stream y) = isPrefixOf x y
1623 #-}
1898 #-}
1624
1899
1625-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
1900-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
1626-- 'True' iff the first is a suffix of the second.
1901-- 'True' iff the first is a suffix of the second.
1627isSuffixOf :: Text -> Text -> Bool
1902isSuffixOf :: Text -> Text -> Bool
1903+isSuffixOf = coerce JSS.isSuffixOf
1628−isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1904+-- isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1629− d >= 0 && a == b'
1905+-- d >= 0 && a == b'
1630− where d = blen - alen
1906+-- where d = blen - alen
1631− b' | d == 0 = b
1907+-- b' | d == 0 = b
1632− | otherwise = Text barr (boff+d) alen
1908+-- | otherwise = Text barr (boff+d) alen
1633{-# INLINE isSuffixOf #-}
1909{-# INLINE isSuffixOf #-}
1634
1910
1635-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns
1911-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns
@@ -1639,10 +1915,11 @@ isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1639-- In (unlikely) bad cases, this function's time complexity degrades
1915-- In (unlikely) bad cases, this function's time complexity degrades
1640-- towards /O(n*m)/.
1916-- towards /O(n*m)/.
1641isInfixOf :: Text -> Text -> Bool
1917isInfixOf :: Text -> Text -> Bool
1918+isInfixOf = coerce JSS.isInfixOf
1642−isInfixOf needle haystack
1919+-- isInfixOf needle haystack
1643− | null needle = True
1920+-- | null needle = True
1644− | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack
1921+-- | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack
1645− | otherwise = not . L.null . indices needle $ haystack
1922+-- | otherwise = not . L.null . indices needle $ haystack
1646{-# INLINE [1] isInfixOf #-}
1923{-# INLINE [1] isInfixOf #-}
1647
1924
1648{-# RULES
1925{-# RULES
@@ -1658,9 +1935,14 @@ isInfixOf needle haystack
1658--
1935--
1659-- Examples:
1936-- Examples:
1660--
1937--
1661−-- > stripPrefix "foo" "foobar" == Just "bar"
1938+-- >>> stripPrefix "foo" "foobar"
1939+-- Just "bar"
1940+--
1662−-- > stripPrefix "" "baz" == Just "baz"
1941+-- >>> stripPrefix "" "baz"
1942+-- Just "baz"
1943+--
1663−-- > stripPrefix "foo" "quux" == Nothing
1944+-- >>> stripPrefix "foo" "quux"
1945+-- Nothing
1664--
1946--
1665-- This is particularly useful with the @ViewPatterns@ extension to
1947-- This is particularly useful with the @ViewPatterns@ extension to
1666-- GHC, as follows:
1948-- GHC, as follows:
@@ -1672,9 +1954,10 @@ isInfixOf needle haystack
1672-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
1954-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
1673-- > fnordLength _ = -1
1955-- > fnordLength _ = -1
1674stripPrefix :: Text -> Text -> Maybe Text
1956stripPrefix :: Text -> Text -> Maybe Text
1957+stripPrefix = coerce JSS.stripPrefix
1675−stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1958+-- stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1676− | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1959+-- | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1677− | otherwise = Nothing
1960+-- | otherwise = Nothing
1678
1961
1679-- | /O(n)/ Find the longest non-empty common prefix of two strings
1962-- | /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
1963-- and return it, along with the suffixes of each string at which they
@@ -1685,28 +1968,39 @@ stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1685--
1968--
1686-- Examples:
1969-- Examples:
1687--
1970--
1688−-- > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux")
1971+-- >>> commonPrefixes "foobar" "fooquux"
1972+-- Just ("foo","bar","quux")
1973+--
1689−-- > commonPrefixes "veeble" "fetzer" == Nothing
1974+-- >>> commonPrefixes "veeble" "fetzer"
1975+-- Nothing
1976+--
1690−-- > commonPrefixes "" "baz" == Nothing
1977+-- >>> commonPrefixes "" "baz"
1978+-- Nothing
1691commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1979commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1980+commonPrefixes = coerce JSS.commonPrefixes
1692−commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1981+-- commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1693− where
1982+-- where
1694− go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1983+-- go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1695− | i > 0 = Just (Text arr0 off0 i,
1984+-- | i > 0 = Just (Text arr0 off0 i,
1696− text arr0 (off0+i) (len0-i),
1985+-- text arr0 (off0+i) (len0-i),
1697− text arr1 (off1+j) (len1-j))
1986+-- text arr1 (off1+j) (len1-j))
1698− | otherwise = Nothing
1987+-- | otherwise = Nothing
1699− where Iter a d0 = iter t0 i
1988+-- where Iter a d0 = iter t0 i
1700− Iter b d1 = iter t1 j
1989+-- Iter b d1 = iter t1 j
1701
1990
1702-- | /O(n)/ Return the prefix of the second string if its suffix
1991-- | /O(n)/ Return the prefix of the second string if its suffix
1703-- matches the entire first string.
1992-- matches the entire first string.
1704--
1993--
1705-- Examples:
1994-- Examples:
1706--
1995--
1707−-- > stripSuffix "bar" "foobar" == Just "foo"
1996+-- >>> stripSuffix "bar" "foobar"
1997+-- Just "foo"
1998+--
1708−-- > stripSuffix "" "baz" == Just "baz"
1999+-- >>> stripSuffix "" "baz"
2000+-- Just "baz"
2001+--
1709−-- > stripSuffix "foo" "quux" == Nothing
2002+-- >>> stripSuffix "foo" "quux"
2003+-- Nothing
1710--
2004--
1711-- This is particularly useful with the @ViewPatterns@ extension to
2005-- This is particularly useful with the @ViewPatterns@ extension to
1712-- GHC, as follows:
2006-- GHC, as follows:
@@ -1718,21 +2012,22 @@ commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1718-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
2012-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
1719-- > quuxLength _ = -1
2013-- > quuxLength _ = -1
1720stripSuffix :: Text -> Text -> Maybe Text
2014stripSuffix :: Text -> Text -> Maybe Text
2015+stripSuffix = coerce JSS.stripSuffix
1721−stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
2016+-- stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1722− | p `isSuffixOf` t = Just $! text arr off (len-plen)
2017+-- | p `isSuffixOf` t = Just $! text arr off (len-plen)
1723− | otherwise = Nothing
2018+-- | otherwise = Nothing
1724−
2019+
1725−-- | Add a list of non-negative numbers. Errors out on overflow.
2020+-- -- | Add a list of non-negative numbers. Errors out on overflow.
1726−sumP :: String -> [Int] -> Int
2021+-- sumP :: String -> [Int] -> Int
1727−sumP fun = go 0
2022+-- sumP fun = go 0
1728− where go !a (x:xs)
2023+-- where go !a (x:xs)
1729− | ax >= 0 = go ax xs
2024+-- | ax >= 0 = go ax xs
1730− | otherwise = overflowError fun
2025+-- | otherwise = overflowError fun
1731− where ax = a + x
2026+-- where ax = a + x
1732− go a _ = a
2027+-- go a _ = a
1733−
2028+
1734−emptyError :: String -> a
2029+-- emptyError :: String -> a
1735−emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
2030+-- emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
1736
2031
1737overflowError :: String -> a
2032overflowError :: String -> a
1738overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
2033overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
@@ -1746,10 +2041,22 @@ overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
1746-- copy \"breaks the link\" to the original array, allowing it to be
2041-- copy \"breaks the link\" to the original array, allowing it to be
1747-- garbage collected if there are no other live references to it.
2042-- garbage collected if there are no other live references to it.
1748copy :: Text -> Text
2043copy :: Text -> Text
2044+copy = P.id -- TODO
1749−copy (Text arr off len) = Text (A.run go) 0 len
2045+-- copy (Text arr off len) = Text (A.run go) 0 len
1750− where
2046+-- where
1751− go :: ST s (A.MArray s)
2047+-- go :: ST s (A.MArray s)
1752− go = do
2048+-- go = do
1753− marr <- A.new len
2049+-- marr <- A.new len
1754− A.copyI marr 0 arr off len
2050+
1755− return marr
2051+foreign import javascript unsafe
2052+ "h$jsstringReplicateChar" js_replicateChar :: Int -> Char -> JSString
2053+foreign import javascript unsafe
2054+ "$2.substr($1)" js_substr1 :: Int -> JSString -> JSString
2055+
2056+-------------------------------------------------
2057+-- NOTE: the named chunk below used by doctest;
2058+-- verify the doctests via `doctest -fobject-code Data/Text.hs`
2059+
2060+-- $setup
2061+-- >>> :set -XOverloadedStrings
2062+-- >>> 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+101−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,24 @@ 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+#if defined(ASSERTS)
405+ in ( A.Array ba (I# len')
406+#else
407+ in ( A.Array ba
408+#endif
409+ , I# len'
410+ )
411+#endif
332 iend = off + len
412 iend = off + len
333
413
334 outerLoop !i0 !br@(B.BufferRange op0 ope)
414 outerLoop !i0 !br@(B.BufferRange op0 ope)
@@ -370,10 +450,11 @@ encodeUtf8BuilderEscaped be =
370
450
371-- | Encode text using UTF-8 encoding.
451-- | Encode text using UTF-8 encoding.
372encodeUtf8 :: Text -> ByteString
452encodeUtf8 :: Text -> ByteString
453+#ifndef __GHCJS__
373encodeUtf8 (Text arr off len)
454encodeUtf8 (Text arr off len)
374 | len == 0 = B.empty
455 | len == 0 = B.empty
375 | otherwise = unsafeDupablePerformIO $ do
456 | otherwise = unsafeDupablePerformIO $ do
376− fp <- mallocByteString (len*4)
457+ fp <- mallocByteString (len*3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough
377 withForeignPtr fp $ \ptr ->
458 withForeignPtr fp $ \ptr ->
378 with ptr $ \destPtr -> do
459 with ptr $ \destPtr -> do
379 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
460 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
@@ -386,6 +467,10 @@ encodeUtf8 (Text arr off len)
386 withForeignPtr fp' $ \ptr' -> do
467 withForeignPtr fp' $ \ptr' -> do
387 memcpy ptr' ptr (fromIntegral utf8len)
468 memcpy ptr' ptr (fromIntegral utf8len)
388 return (PS fp' 0 utf8len)
469 return (PS fp' 0 utf8len)
470+#else
471+encodeUtf8 (Text txt) = toByteString 0 (Just (byteLength buf - 1)) buf
472+ where buf = js_encodeUtf8 txt
473+#endif
389
474
390-- | Decode text from little endian UTF-16 encoding.
475-- | Decode text from little endian UTF-16 encoding.
391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
476decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
@@ -475,5 +560,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
560foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
476 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
561 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
477
562
563+#ifndef __GHCJS__
478foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
564foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
479 :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
565 :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
566+#else
567+foreign import javascript unsafe "h$textFromString" js_fromString :: JSString -> (# ByteArray#, Int# #)
568+foreign import javascript unsafe "h$encodeUtf8($1)" js_encodeUtf8 :: JSString -> Buffer
569+#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+92−3
@@ -1,11 +1,11 @@
1{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving #-}
1{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving #-}
2+{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes, MagicHash #-}
2-- |
3-- |
3-- Module : Data.Text.Foreign
4-- Module : Data.Text.Foreign
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
5-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
5--
6--
6-- License : BSD-style
7-- License : BSD-style
7-- Maintainer : bos@serpentine.com
8-- Maintainer : bos@serpentine.com
8−-- Stability : experimental
9-- Portability : GHC
9-- Portability : GHC
10--
10--
11-- Support for using 'Text' data with native code via the Haskell
11-- Support for using 'Text' data with native code via the Haskell
@@ -51,6 +51,13 @@ import Foreign.Marshal.Alloc (allocaBytes)
51import Foreign.Ptr (Ptr, castPtr, plusPtr)
51import Foreign.Ptr (Ptr, castPtr, plusPtr)
52import Foreign.Storable (peek, poke)
52import Foreign.Storable (peek, poke)
53import qualified Data.Text.Array as A
53import qualified Data.Text.Array as A
54+#ifdef __GHCJS__
55+import Data.JSString (JSString)
56+import GHC.Exts (ByteArray#, Int#)
57+import GHC.Prim (int2Word#)
58+import GHC.Int (Int(..))
59+import GHC.Word (Word16(..))
60+#endif
54
61
55-- $interop
62-- $interop
56--
63--
@@ -75,11 +82,15 @@ fromPtr :: Ptr Word16 -- ^ source array
75 -> I16 -- ^ length of source array (in 'Word16' units)
82 -> I16 -- ^ length of source array (in 'Word16' units)
76 -> IO Text
83 -> IO Text
77fromPtr _ (I16 0) = return empty
84fromPtr _ (I16 0) = return empty
78−fromPtr ptr (I16 len) =
85+fromPtr ptr (I16 (len@(I# len#))) =
79#if defined(ASSERTS)
86#if defined(ASSERTS)
80 assert (len > 0) $
87 assert (len > 0) $
81#endif
88#endif
89+#if defined(__GHCJS__)
90+ return $! Text (js_toString (A.aBA arr) 0# len#)
91+#else
82 return $! Text arr 0 len
92 return $! Text arr 0 len
93+#endif
83 where
94 where
84 arr = A.run (A.new len >>= copy)
95 arr = A.run (A.new len >>= copy)
85 copy marr = loop ptr 0
96 copy marr = loop ptr 0
@@ -103,14 +114,30 @@ fromPtr ptr (I16 len) =
103-- end of the prefix will be advanced by one additional 'Word16' unit
114-- end of the prefix will be advanced by one additional 'Word16' unit
104-- to maintain its validity.
115-- to maintain its validity.
105takeWord16 :: I16 -> Text -> Text
116takeWord16 :: I16 -> Text -> Text
117+#ifdef __GHCJS__
118+takeWord16 (I16 n@(I# n#)) t@(Text jss)
119+ | n <= 0 = empty
120+ | n >= len || m >= len = t
121+ | otherwise = Text (js_substr 0# n# jss)
122+#else
106takeWord16 (I16 n) t@(Text arr off len)
123takeWord16 (I16 n) t@(Text arr off len)
107 | n <= 0 = empty
124 | n <= 0 = empty
108 | n >= len || m >= len = t
125 | n >= len || m >= len = t
109 | otherwise = Text arr off m
126 | otherwise = Text arr off m
127+#endif
110 where
128 where
111− m | w < 0xDB00 || w > 0xD8FF = n
129+#ifdef __GHCJS__
130+ len = js_length jss
131+ arr = js_length jss
132+ m@(I# m#) | w < 0xD800 || w > 0xDBFF = n
133+ | otherwise = n+1
134+ w = I# w#
135+ w# = js_charCodeAt (n-1) jss
136+#else
137+ m | w < 0xD800 || w > 0xDBFF = n
112 | otherwise = n+1
138 | otherwise = n+1
113 w = A.unsafeIndex arr (off+n-1)
139 w = A.unsafeIndex arr (off+n-1)
140+#endif
114
141
115-- | /O(1)/ Return the suffix of the 'Text', with @n@ 'Word16' units
142-- | /O(1)/ Return the suffix of the 'Text', with @n@ 'Word16' units
116-- dropped from its beginning.
143-- dropped from its beginning.
@@ -119,18 +146,45 @@ takeWord16 (I16 n) t@(Text arr off len)
119-- beginning of the suffix will be advanced by one additional 'Word16'
146-- beginning of the suffix will be advanced by one additional 'Word16'
120-- unit to maintain its validity.
147-- unit to maintain its validity.
121dropWord16 :: I16 -> Text -> Text
148dropWord16 :: I16 -> Text -> Text
149+#ifdef __GHCJS__
150+dropWord16 (I16 n@(I# n#)) t@(Text jss)
151+ | n <= 0 = t
152+ | n >= len || m >= len = empty
153+ | otherwise = Text (js_substr1 n# jss)
154+#else
122dropWord16 (I16 n) t@(Text arr off len)
155dropWord16 (I16 n) t@(Text arr off len)
123 | n <= 0 = t
156 | n <= 0 = t
124 | n >= len || m >= len = empty
157 | n >= len || m >= len = empty
125 | otherwise = Text arr (off+m) (len-m)
158 | otherwise = Text arr (off+m) (len-m)
159+#endif
126 where
160 where
161+#ifdef __GHCJS__
162+ len = js_length jss
163+ arr = js_length jss
164+ m@(I# m#) | w < 0xD800 || w > 0xDBFF = n
165+ | otherwise = n+1
166+ w = I# w#
167+ w# = js_charCodeAt (n-1) jss
168+#else
127 m | w < 0xD800 || w > 0xDBFF = n
169 m | w < 0xD800 || w > 0xDBFF = n
128 | otherwise = n+1
170 | otherwise = n+1
129 w = A.unsafeIndex arr (off+n-1)
171 w = A.unsafeIndex arr (off+n-1)
172+#endif
130
173
131-- | /O(n)/ Copy a 'Text' to an array. The array is assumed to be big
174-- | /O(n)/ Copy a 'Text' to an array. The array is assumed to be big
132-- enough to hold the contents of the entire 'Text'.
175-- enough to hold the contents of the entire 'Text'.
133unsafeCopyToPtr :: Text -> Ptr Word16 -> IO ()
176unsafeCopyToPtr :: Text -> Ptr Word16 -> IO ()
177+#ifdef __GHCJS__
178+unsafeCopyToPtr (Text jst) ptr = loop ptr off
179+ where
180+ end = off + len
181+ loop !p !i | i == end = return ()
182+ | otherwise = do
183+ poke p (W16# (int2Word# (js_charCodeAt i jst)))
184+ loop (p `plusPtr` 2) (i + 1)
185+ off = 0
186+ len = js_length jst
187+#else
134unsafeCopyToPtr (Text arr off len) ptr = loop ptr off
188unsafeCopyToPtr (Text arr off len) ptr = loop ptr off
135 where
189 where
136 end = off + len
190 end = off + len
@@ -138,25 +192,44 @@ unsafeCopyToPtr (Text arr off len) ptr = loop ptr off
138 | otherwise = do
192 | otherwise = do
139 poke p (A.unsafeIndex arr i)
193 poke p (A.unsafeIndex arr i)
140 loop (p `plusPtr` 2) (i + 1)
194 loop (p `plusPtr` 2) (i + 1)
195+#endif
141
196
142-- | /O(n)/ Perform an action on a temporary, mutable copy of a
197-- | /O(n)/ Perform an action on a temporary, mutable copy of a
143-- 'Text'. The copy is freed as soon as the action returns.
198-- 'Text'. The copy is freed as soon as the action returns.
144useAsPtr :: Text -> (Ptr Word16 -> I16 -> IO a) -> IO a
199useAsPtr :: Text -> (Ptr Word16 -> I16 -> IO a) -> IO a
200+#ifdef __GHCJS__
201+useAsPtr t@(Text jst) action =
202+ allocaBytes (len * 2) $ \buf -> do
203+ unsafeCopyToPtr t buf
204+ action (castPtr buf) (fromIntegral len)
205+ where len = js_length jst
206+#else
145useAsPtr t@(Text _arr _off len) action =
207useAsPtr t@(Text _arr _off len) action =
146 allocaBytes (len * 2) $ \buf -> do
208 allocaBytes (len * 2) $ \buf -> do
147 unsafeCopyToPtr t buf
209 unsafeCopyToPtr t buf
148 action (castPtr buf) (fromIntegral len)
210 action (castPtr buf) (fromIntegral len)
211+#endif
149
212
150-- | /O(n)/ Make a mutable copy of a 'Text'.
213-- | /O(n)/ Make a mutable copy of a 'Text'.
151asForeignPtr :: Text -> IO (ForeignPtr Word16, I16)
214asForeignPtr :: Text -> IO (ForeignPtr Word16, I16)
215+#ifdef __GHCJS__
216+asForeignPtr t@(Text jst) = do
217+ fp <- mallocForeignPtrArray len
218+ withForeignPtr fp $ unsafeCopyToPtr t
219+ return (fp, I16 len)
220+ where len = js_length jst
221+#else
152asForeignPtr t@(Text _arr _off len) = do
222asForeignPtr t@(Text _arr _off len) = do
153 fp <- mallocForeignPtrArray len
223 fp <- mallocForeignPtrArray len
154 withForeignPtr fp $ unsafeCopyToPtr t
224 withForeignPtr fp $ unsafeCopyToPtr t
155 return (fp, I16 len)
225 return (fp, I16 len)
226+#endif
156
227
157-- | /O(n)/ Decode a C string with explicit length, which is assumed
228-- | /O(n)/ Decode a C string with explicit length, which is assumed
158-- to have been encoded as UTF-8. If decoding fails, a
229-- to have been encoded as UTF-8. If decoding fails, a
159-- 'UnicodeException' is thrown.
230-- 'UnicodeException' is thrown.
231+--
232+-- @since 1.0.0.0
160peekCStringLen :: CStringLen -> IO Text
233peekCStringLen :: CStringLen -> IO Text
161peekCStringLen cs = do
234peekCStringLen cs = do
162 bs <- unsafePackCStringLen cs
235 bs <- unsafePackCStringLen cs
@@ -169,5 +242,21 @@ peekCStringLen cs = do
169-- The temporary storage is freed when the subcomputation terminates
242-- The temporary storage is freed when the subcomputation terminates
170-- (either normally or via an exception), so the pointer to the
243-- (either normally or via an exception), so the pointer to the
171-- temporary storage must /not/ be used after this function returns.
244-- temporary storage must /not/ be used after this function returns.
245+--
246+-- @since 1.0.0.0
172withCStringLen :: Text -> (CStringLen -> IO a) -> IO a
247withCStringLen :: Text -> (CStringLen -> IO a) -> IO a
173withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act
248withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act
249+
250+#ifdef __GHCJS__
251+foreign import javascript unsafe
252+ "h$textToString($1,$2,$3)"
253+ js_toString :: ByteArray# -> Int# -> Int# -> JSString
254+foreign import javascript unsafe
255+ "$3.substr($1,$2)" js_substr :: Int# -> Int# -> JSString -> JSString
256+foreign import javascript unsafe
257+ "$2.substr($1)" js_substr1 :: Int# -> JSString -> JSString
258+foreign import javascript unsafe
259+ "$1.length" js_length :: JSString -> Int
260+foreign import javascript unsafe
261+ "$2.charCodeAt($1)" js_charCodeAt :: Int -> JSString -> Int#
262+#endif
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+53−125
@@ -1,127 +1,72 @@
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($1,$2,$3)"
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+#if defined(ASSERTS)
96−
64+text (A.Array ba _) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty
97−textP :: A.Array -> Int -> Int -> Text
65+ | otherwise = Text $ js_textToString ba off# len#
98−{-# DEPRECATED textP "Use text instead" #-}
66+#else
99−textP = text
67+text (A.Array ba) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty
100−
68+ | otherwise = Text $ js_textToString ba off# len#
101−-- | A useful 'show'-like function for debugging purposes.
69+#endif
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
70
126-- | Checked multiplication. Calls 'error' if the result would
71-- | Checked multiplication. Calls 'error' if the result would
127-- overflow.
72-- overflow.
@@ -168,21 +113,4 @@ mul32 a b = case fromIntegral a * fromIntegral b of
168{-# INLINE mul32 #-}
113{-# INLINE mul32 #-}
169infixl 7 `mul32`
114infixl 7 `mul32`
170
115
171−-- $internals
116+--------------------------------------
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+51−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,21 @@ 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+#if defined(ASSERTS)
178+ (arr, off, l) = (A.Array ba (I# len), 0, I# len)
179+#else
180+ (arr, off, l) = (A.Array ba, 0, I# len)
181+#endif
182+-- fromText t@(Text arr off l)
183+-- | S.null t = empty
184+-- | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
185+-- | otherwise = flush `append` mapBuilder (t :)
171{-# INLINE [1] fromText #-}
186{-# INLINE [1] fromText #-}
172
187
173{-# RULES
188{-# RULES
@@ -182,10 +197,10 @@ fromText t@(Text arr off l)
182fromString :: String -> Builder
197fromString :: String -> Builder
183fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
198fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
184 let loop !marr !o !u !l [] = k (Buffer marr o u l)
199 let loop !marr !o !u !l [] = k (Buffer marr o u l)
185− loop marr o u l s@(c:cs)
200+ loop marr o@(I# o#) u@(I# u#) l s@(c:cs)
186 | l <= 1 = do
201 | l <= 1 = do
187 arr <- A.unsafeFreeze marr
202 arr <- A.unsafeFreeze marr
188− let !t = Text arr o u
203+ let !t = Text $ js_toString (A.aBA arr) o# u#
189 marr' <- A.new chunkSize
204 marr' <- A.new chunkSize
190 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
205 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
191 return $ t : ts
206 return $ t : ts
@@ -195,6 +210,21 @@ fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
195 in loop p0 o0 u0 l0 str
210 in loop p0 o0 u0 l0 str
196 where
211 where
197 chunkSize = smallChunkSize
212 chunkSize = smallChunkSize
213+-- fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
214+-- let loop !marr !o !u !l [] = k (Buffer marr o u l)
215+-- loop marr o u l s@(c:cs)
216+-- | l <= 1 = do
217+-- arr <- A.unsafeFreeze marr
218+-- let !t = Text arr o u
219+-- marr' <- A.new chunkSize
220+-- ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
221+-- return $ t : ts
222+-- | otherwise = do
223+-- n <- unsafeWrite marr (o+u) c
224+-- loop marr o (u+n) (l-n) cs
225+-- in loop p0 o0 u0 l0 str
226+-- where
227+-- chunkSize = smallChunkSize
198{-# INLINE fromString #-}
228{-# INLINE fromString #-}
199
229
200-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
230-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
@@ -234,16 +264,24 @@ toLazyTextWith chunkSize m = L.fromChunks (runST $
234-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
264-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
235-- yielding a new chunk in the result lazy @Text@.
265-- yielding a new chunk in the result lazy @Text@.
236flush :: Builder
266flush :: Builder
237−flush = Builder $ \ k buf@(Buffer p o u l) ->
267+flush = Builder $ \ k buf@(Buffer p o@(I# o#) u@(I# u#) l) ->
238 if u == 0
268 if u == 0
239 then k buf
269 then k buf
240 else do arr <- A.unsafeFreeze p
270 else do arr <- A.unsafeFreeze p
241 let !b = Buffer p (o+u) 0 l
271 let !b = Buffer p (o+u) 0 l
242− !t = Text arr o u
272+ !t = Text $ js_toString (A.aBA arr) o# u#
243 ts <- inlineInterleaveST (k b)
273 ts <- inlineInterleaveST (k b)
244 return $! t : ts
274 return $! t : ts
245{-# INLINE [1] flush #-}
275{-# INLINE [1] flush #-}
246-- defer inlining so that flush/flush rule may fire.
276-- defer inlining so that flush/flush rule may fire.
277+-- flush = Builder $ \ k buf@(Buffer p o u l) ->
278+-- if u == 0
279+-- then k buf
280+-- else do arr <- A.unsafeFreeze p
281+-- let !b = Buffer p (o+u) 0 l
282+-- !t = Text arr o u
283+-- ts <- inlineInterleaveST (k b)
284+-- return $! t : ts
247
285
248------------------------------------------------------------------------
286------------------------------------------------------------------------
249
287
@@ -327,3 +365,11 @@ append' (Builder f) (Builder g) = Builder (f . g)
327 append flush flush = flush
365 append flush flush = flush
328
366
329 #-}
367 #-}
368+
369+foreign import javascript unsafe
370+ "h$textFromString"
371+ js_fromString :: JSString -> (# ByteArray#, Int# #)
372+
373+foreign import javascript unsafe
374+ "h$textToString($1,$2,$3)"
375+ 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+39−165
@@ -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
138length = S.lengthI
87length = S.lengthI
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+66
@@ -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
@@ -50,10 +64,25 @@ stream text = Stream next (text :*: 0) unknownSize
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
52{-# INLINE [0] stream #-}
66{-# INLINE [0] stream #-}
67+#else
68+stream text = Stream next (text :*: 0) -- unknownSize
69+ where
70+ next (Empty :*: _) = Done
71+ next (txt@(Chunk t@(I.Text jst) ts) :*: i)
72+ | i >= I# (js_length jst) = next (ts :*: 0)
73+ | otherwise = Yield c (txt :*: i+d)
74+ where Iter c d = iter t i
75+{-# INLINE [0] stream #-}
53
76
77+foreign import javascript unsafe
78+ "$1.length" js_length :: JSString -> Int#
79+#endif
80+
81+-- TODO
54-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
82-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
55-- chunk size.
83-- chunk size.
56unstreamChunks :: Int -> Stream Char -> Text
84unstreamChunks :: Int -> Stream Char -> Text
85+#ifndef __GHCJS__
57unstreamChunks !chunkSize (Stream next s0 len0)
86unstreamChunks !chunkSize (Stream next s0 len0)
58 | isEmpty len0 = Empty
87 | isEmpty len0 = Empty
59 | otherwise = outer s0
88 | otherwise = outer s0
@@ -84,6 +113,36 @@ unstreamChunks !chunkSize (Stream next s0 len0)
84 finish marr len s' = do
113 finish marr len s' = do
85 arr <- A.unsafeFreeze marr
114 arr <- A.unsafeFreeze marr
86 return (I.Text arr 0 len `Chunk` outer s')
115 return (I.Text arr 0 len `Chunk` outer s')
116+#else
117+unstreamChunks !chunkSize (Stream next s0) = outer s0
118+ where
119+ outer so = {-# SCC "unstreamChunks/outer" #-}
120+ case next so of
121+ Done -> Empty
122+ Skip s' -> outer s'
123+ Yield x s' -> runST $ do
124+ a <- A.new unknownLength
125+ unsafeWrite a 0 x >>= inner a unknownLength s'
126+ where unknownLength = 4
127+ where
128+ inner marr !len s !i
129+ | i + 1 >= chunkSize = finish marr i s
130+ | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do
131+ let newLen = min (len `shiftL` 1) chunkSize
132+ marr' <- A.new newLen
133+ A.copyM marr' 0 marr 0 len
134+ inner marr' newLen s i
135+ | otherwise =
136+ {-# SCC "unstreamChunks/inner" #-}
137+ case next s of
138+ Done -> finish marr i s
139+ Skip s' -> inner marr len s' i
140+ Yield x s' -> do d <- unsafeWrite marr i x
141+ inner marr len s' (i+d)
142+ finish marr (I# len#) s' = do
143+ arr <- A.unsafeFreeze marr
144+ return (I.Text (js_toString (A.aBA arr) 0# len#) `Chunk` outer s')
145+#endif
87{-# INLINE [0] unstreamChunks #-}
146{-# INLINE [0] unstreamChunks #-}
88
147
89-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
148-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
@@ -118,3 +177,10 @@ index = S.indexI
118countChar :: Char -> Stream Char -> Int64
177countChar :: Char -> Stream Char -> Int64
119countChar = S.countCharI
178countChar = S.countCharI
120{-# INLINE [0] countChar #-}
179{-# INLINE [0] countChar #-}
180+
181+#ifdef __GHCJS__
182+foreign import javascript unsafe
183+ "h$textToString($1,$2,$3)"
184+ js_toString :: ByteArray# -> Int# -> Int# -> JSString
185+#endif
186+
Data/Text/Internal/Lazy/Search.hs+71−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,31 @@ 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+#if defined(ASSERTS)
98+ in (A.Array ba (I# len), I# len)
99+#else
100+ in (A.Array ba, I# len)
101+#endif
75− where fin _ (T.Text farr foff flen) = A.unsafeIndex farr (foff+flen-1)
102+ in A.unsafeIndex farr (foff+flen-1)
76 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)
103 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)
77 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)
104 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)
78− buildTable (T.Text xarr xoff xlen) xs = go
105+ -- buildTable (T.Text xarr xoff xlen) xs = go
106+ buildTable t xs = go
79 where
107 where
108+ xoff = 0
109+ (xarr, xlen) =
110+ let (# ba, len #) = fromString t
111+#if defined(ASSERTS)
112+ in (A.Array ba (I# len), I# len)
113+#else
114+ in (A.Array ba, I# len)
115+#endif
80 go !(g::Int64) !i !msk !skp
116 go !(g::Int64) !i !msk !skp
81 | i >= xlast = case xs of
117 | i >= xlast = case xs of
82 Empty -> (msk .|. swizzle z) :*: skp
118 Empty -> (msk .|. swizzle z) :*: skp
@@ -91,17 +127,22 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
91 -- given offset would fail.
127 -- given offset would fail.
92 lackingHay q = go 0
128 lackingHay q = go 0
93 where
129 where
94− go p (T.Text _ _ l) ps = p' < q && case ps of
130+ -- go p (T.Text _ _ l) ps = p' < q && case ps of
131+ go p t ps = p' < q && case ps of
95− Empty -> True
132+ Empty -> True
96− Chunk r rs -> go p' r rs
133+ Chunk r rs -> go p' r rs
134+ where
135+ l = TT.length t
97− where p' = p + fromIntegral l
136+ p' = p + fromIntegral l
137+
98indices _ _ = []
138indices _ _ = []
99
139
100-- | Fast index into a partly unpacked 'Text'. We take into account
140-- | Fast index into a partly unpacked 'Text'. We take into account
101-- the possibility that the caller might try to access one element
141-- the possibility that the caller might try to access one element
102-- past the end.
142-- past the end.
103index :: T.Text -> Text -> Int64 -> Word16
143index :: T.Text -> Text -> Int64 -> Word16
104−index (T.Text arr off len) xs !i
144+-- index (T.Text arr off len) xs !i
145+index t xs !i
105 | j < len = A.unsafeIndex arr (off+j)
146 | j < len = A.unsafeIndex arr (off+j)
106 | otherwise = case xs of
147 | otherwise = case xs of
107 Empty
148 Empty
@@ -110,14 +151,32 @@ index (T.Text arr off len) xs !i
110 -- should never happen, due to lackingHay above
151 -- should never happen, due to lackingHay above
111 | otherwise -> emptyError "index"
152 | otherwise -> emptyError "index"
112 Chunk c cs -> index c cs (i-fromIntegral len)
153 Chunk c cs -> index c cs (i-fromIntegral len)
154+ where
113− where j = fromIntegral i
155+ j = fromIntegral i
156+ off = 0
157+ (arr, len) =
158+ let (# ba, len' #) = fromString t
159+#if defined(ASSERTS)
160+ in (A.Array ba (I# len'), I# len')
161+#else
162+ in (A.Array ba, I# len')
163+#endif
114
164
115-- | A variant of 'indices' that scans linearly for a single 'Word16'.
165-- | A variant of 'indices' that scans linearly for a single 'Word16'.
116indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]
166indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]
117indicesOne c = chunk
167indicesOne c = chunk
118 where
168 where
119− chunk !i (T.Text oarr ooff olen) os = go 0
169+ -- chunk !i (T.Text oarr ooff olen) os = go 0
170+ chunk !i t os = go 0
120 where
171 where
172+ ooff = 0
173+ (oarr, olen) =
174+ let (# ba, len #) = fromString t
175+#if defined(ASSERTS)
176+ in (A.Array ba (I# len), I# len)
177+#else
178+ in (A.Array ba, I# len)
179+#endif
121 go h | h >= olen = case os of
180 go h | h >= olen = case os of
122 Empty -> []
181 Empty -> []
123 Chunk y ys -> chunk (i+fromIntegral olen) y ys
182 Chunk y ys -> chunk (i+fromIntegral olen) y ys
@@ -128,7 +187,8 @@ indicesOne c = chunk
128-- | The number of 'Word16' values in a 'Text'.
187-- | The number of 'Word16' values in a 'Text'.
129wordLength :: Text -> Int64
188wordLength :: Text -> Int64
130wordLength = foldlChunks sumLength 0
189wordLength = foldlChunks sumLength 0
190+ where sumLength i t = i + fromIntegral (TT.length t)
131− where sumLength i (T.Text _ _ l) = i + fromIntegral l
191+ -- where sumLength i (T.Text _ _ l) = i + fromIntegral l
132
192
133emptyError :: String -> a
193emptyError :: String -> a
134emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")
194emptyError 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+41−37
@@ -31,12 +31,15 @@ module Data.Text.Internal.Search
31 indices
31 indices
32 ) where
32 ) where
33
33
34+import Data.Coerce
34import qualified Data.Text.Array as A
35import qualified Data.Text.Array as A
35import Data.Word (Word64)
36import Data.Word (Word64)
36import Data.Text.Internal (Text(..))
37import Data.Text.Internal (Text(..))
37import Data.Bits ((.|.), (.&.))
38import Data.Bits ((.|.), (.&.))
38import Data.Text.Internal.Unsafe.Shift (shiftL)
39import Data.Text.Internal.Unsafe.Shift (shiftL)
39
40
41+import qualified Data.JSString.Internal.Search as JSS
42+
40data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
43data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
41
44
42-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
45-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
@@ -49,41 +52,42 @@ data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
49indices :: Text -- ^ Substring to search for (@needle@)
52indices :: Text -- ^ Substring to search for (@needle@)
50 -> Text -- ^ Text to search in (@haystack@)
53 -> Text -- ^ Text to search in (@haystack@)
51 -> [Int]
54 -> [Int]
55+indices = coerce JSS.indices
52−indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
56+-- indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
53− | nlen == 1 = scanOne (nindex 0)
57+-- | nlen == 1 = scanOne (nindex 0)
54− | nlen <= 0 || ldiff < 0 = []
58+-- | nlen <= 0 || ldiff < 0 = []
55− | otherwise = scan 0
59+-- | otherwise = scan 0
56− where
60+-- where
57− ldiff = hlen - nlen
61+-- ldiff = hlen - nlen
58− nlast = nlen - 1
62+-- nlast = nlen - 1
59− z = nindex nlast
63+-- z = nindex nlast
60− nindex k = A.unsafeIndex narr (noff+k)
64+-- nindex k = A.unsafeIndex narr (noff+k)
61− hindex k = A.unsafeIndex harr (hoff+k)
65+-- hindex k = A.unsafeIndex harr (hoff+k)
62− hindex' k | k == hlen = 0
66+-- hindex' k | k == hlen = 0
63− | otherwise = A.unsafeIndex harr (hoff+k)
67+-- | otherwise = A.unsafeIndex harr (hoff+k)
64− buildTable !i !msk !skp
68+-- buildTable !i !msk !skp
65− | i >= nlast = (msk .|. swizzle z) :* skp
69+-- | i >= nlast = (msk .|. swizzle z) :* skp
66− | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
70+-- | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
67− where c = nindex i
71+-- where c = nindex i
68− skp' | c == z = nlen - i - 2
72+-- skp' | c == z = nlen - i - 2
69− | otherwise = skp
73+-- | otherwise = skp
70− swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)
74+-- swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)
71− scan !i
75+-- scan !i
72− | i > ldiff = []
76+-- | i > ldiff = []
73− | c == z && candidateMatch 0 = i : scan (i + nlen)
77+-- | c == z && candidateMatch 0 = i : scan (i + nlen)
74− | otherwise = scan (i + delta)
78+-- | otherwise = scan (i + delta)
75− where c = hindex (i + nlast)
79+-- where c = hindex (i + nlast)
76− candidateMatch !j
80+-- candidateMatch !j
77− | j >= nlast = True
81+-- | j >= nlast = True
78− | hindex (i+j) /= nindex j = False
82+-- | hindex (i+j) /= nindex j = False
79− | otherwise = candidateMatch (j+1)
83+-- | otherwise = candidateMatch (j+1)
80− delta | nextInPattern = nlen + 1
84+-- delta | nextInPattern = nlen + 1
81− | c == z = skip + 1
85+-- | c == z = skip + 1
82− | otherwise = 1
86+-- | otherwise = 1
83− where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
87+-- where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
84− !(mask :* skip) = buildTable 0 0 (nlen-2)
88+-- !(mask :* skip) = buildTable 0 0 (nlen-2)
85− scanOne c = loop 0
89+-- scanOne c = loop 0
86− where loop !i | i >= hlen = []
90+-- where loop !i | i >= hlen = []
87− | hindex i == c = i : loop (i+1)
91+-- | hindex i == c = i : loop (i+1)
88− | otherwise = loop (i+1)
92+-- | otherwise = loop (i+1)
89{-# INLINE indices #-}
93{-# INLINE indices #-}
Data/Text/Lazy.hs+108−21
@@ -6,14 +6,17 @@
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+{-# LANGUAGE MagicHash #-}
12+{-# LANGUAGE UnliftedFFITypes #-}
13+#endif
10-- |
14-- |
11-- Module : Data.Text.Lazy
15-- Module : Data.Text.Lazy
12-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
16-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
13--
17--
14-- License : BSD-style
18-- License : BSD-style
15-- Maintainer : bos@serpentine.com
19-- Maintainer : bos@serpentine.com
16−-- Stability : experimental
17-- Portability : GHC
20-- Portability : GHC
18--
21--
19-- A time and space-efficient implementation of Unicode text using
22-- A time and space-efficient implementation of Unicode text using
@@ -68,6 +71,7 @@ module Data.Text.Lazy
68 , snoc
71 , snoc
69 , append
72 , append
70 , uncons
73 , uncons
74+ , unsnoc
71 , head
75 , head
72 , last
76 , last
73 , tail
77 , tail
@@ -244,6 +248,11 @@ import GHC.Prim (Addr#)
244#if MIN_VERSION_base(4,7,0)
248#if MIN_VERSION_base(4,7,0)
245import Text.Printf (PrintfArg, formatArg, formatString)
249import Text.Printf (PrintfArg, formatArg, formatString)
246#endif
250#endif
251+#ifdef __GHCJS__
252+import Data.JSString (JSString)
253+import GHC.Base (Int(..))
254+import GHC.Exts (Int#)
255+#endif
247
256
248-- $fusion
257-- $fusion
249--
258--
@@ -273,14 +282,16 @@ import Text.Printf (PrintfArg, formatArg, formatString)
273-- $replacement
282-- $replacement
274--
283--
275-- A 'Text' value is a sequence of Unicode scalar values, as defined
284-- A 'Text' value is a sequence of Unicode scalar values, as defined
285+-- in
276−-- in &#xa7;3.9, definition D76 of the Unicode 5.2 standard:
286+-- <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
287+-- As such, a 'Text' cannot contain values in the range U+D800 to
279−-- inclusive. Haskell implementations admit all Unicode code points
288+-- U+DFFF inclusive. Haskell implementations admit all Unicode code
289+-- points
290+-- (<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
291+-- as 'Char' values, including code points from this invalid range.
281−-- from this invalid range. This means that there are some 'Char'
292+-- This means that there are some 'Char' values that are not valid
282−-- values that are not valid Unicode scalar values, and the functions
293+-- Unicode scalar values, and the functions in this module must handle
283−-- in this module must handle those cases.
294+-- those cases.
284--
295--
285-- Within this module, many functions construct a 'Text' from one or
296-- Within this module, many functions construct a 'Text' from one or
286-- more 'Char' values. Those functions will substitute 'Char' values
297-- more 'Char' values. Those functions will substitute 'Char' values
@@ -294,8 +305,8 @@ import Text.Printf (PrintfArg, formatArg, formatString)
294-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
305-- 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
306-- code points, and so cannot be represented. The functions replace
296-- invalid scalar values, instead of dropping them, as a security
307-- invalid scalar values, instead of dropping them, as a security
297−-- measure. For details, see Unicode Technical Report 36, &#xa7;3.5:
308+-- measure. For details, see
298−-- <http://unicode.org/reports/tr36#Deletion_of_Noncharacters>)
309+-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)
299
310
300equal :: Text -> Text -> Bool
311equal :: Text -> Text -> Bool
301equal Empty Empty = True
312equal Empty Empty = True
@@ -324,6 +335,7 @@ compareText Empty _ = LT
324compareText _ Empty = GT
335compareText _ Empty = GT
325compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
336compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
326 where
337 where
338+#ifndef __GHCJS__
327 outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
339 outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
328 where
340 where
329 go !i !j
341 go !i !j
@@ -334,6 +346,20 @@ compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
334 | otherwise = go (i+di) (j+dj)
346 | otherwise = go (i+di) (j+dj)
335 where T.Iter a di = T.iter ta i
347 where T.Iter a di = T.iter ta i
336 T.Iter b dj = T.iter tb j
348 T.Iter b dj = T.iter tb j
349+#else
350+ outer ta@(T.Text jsa) tb@(T.Text jsb) = go 0 0
351+ where
352+ go !i !j
353+ | i >= lenA = compareText as (chunk (T.Text (js_substr1 j jsb)) bs)
354+ | j >= lenB = compareText (chunk (T.Text (js_substr1 i jsa)) as) bs
355+ | a < b = LT
356+ | a > b = GT
357+ | otherwise = go (i+di) (j+dj)
358+ where T.Iter a di = T.iter ta i
359+ T.Iter b dj = T.iter tb j
360+ lenA = I# (js_length jsa)
361+ lenB = I# (js_length jsb)
362+#endif
337
363
338instance Show Text where
364instance Show Text where
339 showsPrec p ps r = showsPrec p (unpack ps) r
365 showsPrec p ps r = showsPrec p (unpack ps) r
@@ -342,9 +368,13 @@ instance Read Text where
342 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
368 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
343
369
344#if MIN_VERSION_base(4,9,0)
370#if MIN_VERSION_base(4,9,0)
371+-- | Non-orphan 'Semigroup' instance only defined for
345−-- Semigroup orphan instances for older GHCs are provided by
372+-- @base-4.9.0.0@ and later; orphan instances for older GHCs are
373+-- provided by
374+-- the [semigroups](http://hackage.haskell.org/package/semigroups)
346−-- 'semigroups` package
375+-- package
347−
376+--
377+-- @since 1.2.2.0
348instance Semigroup Text where
378instance Semigroup Text where
349 (<>) = append
379 (<>) = append
350#endif
380#endif
@@ -362,6 +392,7 @@ instance IsString Text where
362 fromString = pack
392 fromString = pack
363
393
364#if __GLASGOW_HASKELL__ >= 708
394#if __GLASGOW_HASKELL__ >= 708
395+-- | @since 1.2.0.0
365instance Exts.IsList Text where
396instance Exts.IsList Text where
366 type Item Text = Char
397 type Item Text = Char
367 fromList = pack
398 fromList = pack
@@ -374,6 +405,7 @@ instance NFData Text where
374 rnf (Chunk _ ts) = rnf ts
405 rnf (Chunk _ ts) = rnf ts
375#endif
406#endif
376
407
408+-- | @since 1.2.1.0
377instance Binary Text where
409instance Binary Text where
378 put t = put (encodeUtf8 t)
410 put t = put (encodeUtf8 t)
379 get = do
411 get = do
@@ -397,6 +429,8 @@ instance Data Text where
397
429
398#if MIN_VERSION_base(4,7,0)
430#if MIN_VERSION_base(4,7,0)
399-- | Only defined for @base-4.7.0.0@ and later
431-- | Only defined for @base-4.7.0.0@ and later
432+--
433+-- @since 1.2.2.0
400instance PrintfArg Text where
434instance PrintfArg Text where
401 formatArg txt = formatString $ unpack txt
435 formatArg txt = formatString $ unpack txt
402#endif
436#endif
@@ -475,9 +509,7 @@ fromStrict t = chunk t Empty
475-- -----------------------------------------------------------------------------
509-- -----------------------------------------------------------------------------
476-- * Basic functions
510-- * Basic functions
477
511
478−-- | /O(n)/ Adds a character to the front of a 'Text'. This function
512+-- | /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
513cons :: Char -> Text -> Text
482cons c t = Chunk (T.singleton c) t
514cons c t = Chunk (T.singleton c) t
483{-# INLINE [1] cons #-}
515{-# INLINE [1] cons #-}
@@ -561,6 +593,17 @@ init Empty = emptyError "init"
561 unstream (S.init (stream t)) = init t
593 unstream (S.init (stream t)) = init t
562 #-}
594 #-}
563
595
596+-- | /O(n\/c)/ Returns the 'init' and 'last' of a 'Text', or 'Nothing' if
597+-- empty.
598+--
599+-- * It is no faster than using 'init' and 'last'.
600+--
601+-- @since 1.2.3.0
602+unsnoc :: Text -> Maybe (Text, Char)
603+unsnoc Empty = Nothing
604+unsnoc ts@(Chunk _ _) = Just (init ts, last ts)
605+{-# INLINE unsnoc #-}
606+
564-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
607-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
565-- fusion.
608-- fusion.
566null :: Text -> Bool
609null :: Text -> Bool
@@ -820,6 +863,8 @@ toUpper t = unstream (S.toUpper (stream t))
820-- guides disagree on whether the book name \"The Hill of the Red
863-- guides disagree on whether the book name \"The Hill of the Red
821-- Fox\" is correctly title cased&#x2014;but this function will
864-- Fox\" is correctly title cased&#x2014;but this function will
822-- capitalize /every/ word.
865-- capitalize /every/ word.
866+--
867+-- @since 1.0.0.0
823toTitle :: Text -> Text
868toTitle :: Text -> Text
824toTitle t = unstream (S.toTitle (stream t))
869toTitle t = unstream (S.toTitle (stream t))
825{-# INLINE toTitle #-}
870{-# INLINE toTitle #-}
@@ -972,6 +1017,8 @@ mapAccumR f = go
972
1017
973-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every
1018-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every
974-- element.
1019-- element.
1020+--
1021+-- @since 1.2.0.5
975repeat :: Char -> Text
1022repeat :: Char -> Text
976repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t
1023repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t
977 in t
1024 in t
@@ -989,6 +1036,8 @@ replicate n t
989
1036
990-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or
1037-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or
991-- equivalently, the infinite repetition of the original 'Text'.
1038-- equivalently, the infinite repetition of the original 'Text'.
1039+--
1040+-- @since 1.2.0.5
992cycle :: Text -> Text
1041cycle :: Text -> Text
993cycle Empty = emptyError "cycle"
1042cycle Empty = emptyError "cycle"
994cycle t = let t' = foldrChunks Chunk t' t
1043cycle t = let t' = foldrChunks Chunk t' t
@@ -998,6 +1047,8 @@ cycle t = let t' = foldrChunks Chunk t' t
998-- of @f@ to @x@:
1047-- of @f@ to @x@:
999--
1048--
1000-- > iterate f x == [x, f x, f (f x), ...]
1049-- > iterate f x == [x, f x, f (f x), ...]
1050+--
1051+-- @since 1.2.0.5
1001iterate :: (Char -> Char) -> Char -> Text
1052iterate :: (Char -> Char) -> Char -> Text
1002iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))
1053iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))
1003 in t c
1054 in t c
@@ -1061,6 +1112,8 @@ take i t0 = take' i t0
1061-- Examples:
1112-- Examples:
1062--
1113--
1063-- > takeEnd 3 "foobar" == "bar"
1114-- > takeEnd 3 "foobar" == "bar"
1115+--
1116+-- @since 1.1.1.0
1064takeEnd :: Int64 -> Text -> Text
1117takeEnd :: Int64 -> Text -> Text
1065takeEnd n t0
1118takeEnd n t0
1066 | n <= 0 = empty
1119 | n <= 0 = empty
@@ -1099,6 +1152,8 @@ drop i t0
1099-- Examples:
1152-- Examples:
1100--
1153--
1101-- > dropEnd 3 "foobar" == "foo"
1154-- > dropEnd 3 "foobar" == "foo"
1155+--
1156+-- @since 1.1.1.0
1102dropEnd :: Int64 -> Text -> Text
1157dropEnd :: Int64 -> Text -> Text
1103dropEnd n t0
1158dropEnd n t0
1104 | n <= 0 = t0
1159 | n <= 0 = t0
@@ -1119,11 +1174,20 @@ dropWords i t0
1119 | otherwise = drop' i t0
1174 | otherwise = drop' i t0
1120 where drop' 0 ts = ts
1175 where drop' 0 ts = ts
1121 drop' _ Empty = Empty
1176 drop' _ Empty = Empty
1177+#ifndef __GHCJS__
1122 drop' n (Chunk (T.Text arr off len) ts)
1178 drop' n (Chunk (T.Text arr off len) ts)
1123 | n < len' = chunk (text arr (off+n') (len-n')) ts
1179 | n < len' = chunk (text arr (off+n') (len-n')) ts
1124 | otherwise = drop' (n - len') ts
1180 | otherwise = drop' (n - len') ts
1125 where len' = fromIntegral len
1181 where len' = fromIntegral len
1126 n' = fromIntegral n
1182 n' = fromIntegral n
1183+#else
1184+ drop' n (Chunk t@(T.Text jst) ts)
1185+ | n < len' = chunk (T.Text $ js_substr1 n' jst) ts
1186+ | otherwise = drop' (n - len') ts
1187+ where len' = fromIntegral len
1188+ len = I# (js_length jst)
1189+ n' = fromIntegral n
1190+#endif
1127
1191
1128-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1192-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1129-- returns the longest prefix (possibly empty) of elements that
1193-- returns the longest prefix (possibly empty) of elements that
@@ -1150,12 +1214,15 @@ takeWhile p t0 = takeWhile' t0
1150-- Examples:
1214-- Examples:
1151--
1215--
1152-- > takeWhileEnd (=='o') "foo" == "oo"
1216-- > takeWhileEnd (=='o') "foo" == "oo"
1217+--
1218+-- @since 1.2.2.0
1153takeWhileEnd :: (Char -> Bool) -> Text -> Text
1219takeWhileEnd :: (Char -> Bool) -> Text -> Text
1154takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1220takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1155 where takeChunk acc [] = acc
1221 where takeChunk acc [] = acc
1156− takeChunk acc (t:ts) = if T.length t' < T.length t
1222+ takeChunk acc (t:ts)
1157− then (Chunk t' acc)
1223+ | T.lengthWord16 t' < T.lengthWord16 t
1224+ = chunk t' acc
1158− else takeChunk (Chunk t' acc) ts
1225+ | otherwise = takeChunk (Chunk t' acc) ts
1159 where t' = T.takeWhileEnd p t
1226 where t' = T.takeWhileEnd p t
1160{-# INLINE takeWhileEnd #-}
1227{-# INLINE takeWhileEnd #-}
1161
1228
@@ -1244,12 +1311,22 @@ splitAt = loop
1244-- values, and whose second is the remainder of the string.
1311-- values, and whose second is the remainder of the string.
1245splitAtWord :: Int64 -> Text -> PairS Text Text
1312splitAtWord :: Int64 -> Text -> PairS Text Text
1246splitAtWord _ Empty = empty :*: empty
1313splitAtWord _ Empty = empty :*: empty
1314+#ifndef __GHCJS__
1247splitAtWord x (Chunk c@(T.Text arr off len) cs)
1315splitAtWord x (Chunk c@(T.Text arr off len) cs)
1248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1316 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1249 in Chunk c h :*: t
1317 in Chunk c h :*: t
1250 | otherwise = chunk (text arr off y) empty :*:
1318 | otherwise = chunk (text arr off y) empty :*:
1251 chunk (text arr (off+y) (len-y)) cs
1319 chunk (text arr (off+y) (len-y)) cs
1252 where y = fromIntegral x
1320 where y = fromIntegral x
1321+#else
1322+splitAtWord x (Chunk c@(T.Text jst) cs)
1323+ | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1324+ in Chunk c h :*: t
1325+ | otherwise = chunk (T.Text (js_substr 0 (y-1) jst)) empty :*:
1326+ chunk (T.Text (js_substr1 y jst)) cs
1327+ where y = fromIntegral x
1328+ len = I# (js_length jst)
1329+#endif
1253
1330
1254-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1331-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1255-- non-'null') in @haystack@. The first element of the returned tuple
1332-- non-'null') in @haystack@. The first element of the returned tuple
@@ -1429,7 +1506,11 @@ splitOn pat src
1429 go _ [] cs = [cs]
1506 go _ [] cs = [cs]
1430 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1507 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1431 in h : go (x+l) xs (dropWords l t)
1508 in h : go (x+l) xs (dropWords l t)
1509+#ifndef __GHCJS__
1432 l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1510 l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1511+#else
1512+ l = foldlChunks (\a (T.Text t) -> a + fromIntegral (I# (js_length t))) 0 pat
1513+#endif
1433{-# INLINE [1] splitOn #-}
1514{-# INLINE [1] splitOn #-}
1434
1515
1435{-# RULES
1516{-# RULES
@@ -1693,3 +1774,9 @@ emptyError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": empty input")
1693
1774
1694impossibleError :: String -> a
1775impossibleError :: String -> a
1695impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")
1776impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")
1777+
1778+#ifdef __GHCJS__
1779+foreign import javascript unsafe "$2.substr($1)" js_substr1 :: Exts.Int -> JSString -> JSString
1780+foreign import javascript unsafe "$3.substr($1,$2)" js_substr :: Exts.Int -> Exts.Int -> JSString -> JSString
1781+foreign import javascript unsafe "$1.length" js_length :: JSString -> Int#
1782+#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+3−1
@@ -9,7 +9,6 @@
9-- (c) 2011 MailRank, Inc.
9-- (c) 2011 MailRank, Inc.
10-- License: BSD-style
10-- License: BSD-style
11-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
11-- Maintainer: Bryan O'Sullivan <bos@serpentine.com>
12−-- Stability: experimental
13-- Portability: portable
12-- Portability: portable
14--
13--
15-- Efficiently write an integral value to a 'Builder'.
14-- Efficiently write an integral value to a 'Builder'.
@@ -32,6 +31,9 @@ import GHC.Base (quotInt, remInt)
32import GHC.Num (quotRemInteger)
31import GHC.Num (quotRemInteger)
33import GHC.Types (Int(..))
32import GHC.Types (Int(..))
34import Control.Monad.ST
33import Control.Monad.ST
34+#if MIN_VERSION_base(4,11,0)
35+import Prelude hiding ((<>))
36+#endif
35
37
36#ifdef __GLASGOW_HASKELL__
38#ifdef __GLASGOW_HASKELL__
37# if defined(INTEGER_GMP)
39# if defined(INTEGER_GMP)
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+90−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,81 @@ 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 (I# k) (Text txt) = Text $ js_substr 0# 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 (I# k) (Text txt) = Text $ js_substr1 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+ "$1.length" js_length :: JSString -> Int
205+
206+foreign import javascript unsafe
207+ "$3.substr($1,$2)" js_substr :: Int# -> Int# -> JSString -> JSString
208+
209+foreign import javascript unsafe
210+ "$2.substr($1)" js_substr1 :: Int# -> JSString -> JSString
211+
212+#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.hs+1−1
@@ -10,4 +10,4 @@ import qualified Tests.Properties as Properties
10import qualified Tests.Regressions as Regressions
10import qualified Tests.Regressions as Regressions
11
11
12main :: IO ()
12main :: IO ()
13−main = defaultMain [Properties.tests, Regressions.tests]
13+main = defaultMain [Properties.tests {-, Regressions.tests -}]
tests/Tests/Properties.hs+99−20
@@ -2,6 +2,7 @@
2
2
3{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
3{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
4 ScopedTypeVariables, TypeSynonymInstances #-}
4 ScopedTypeVariables, TypeSynonymInstances #-}
5+{-# LANGUAGE CPP #-}
5{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
6{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
6module Tests.Properties
7module Tests.Properties
7 (
8 (
@@ -9,9 +10,9 @@ module Tests.Properties
9 ) where
10 ) where
10
11
11import Control.Applicative ((<$>), (<*>))
12import Control.Applicative ((<$>), (<*>))
12−import Control.Arrow ((***), second)
13+import Control.Arrow ((***), first, second)
13import Data.Bits ((.&.))
14import Data.Bits ((.&.))
14−import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
15+import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isLetter, isUpper, ord)
15import Data.Int (Int8, Int16, Int32, Int64)
16import Data.Int (Int8, Int16, Int32, Int64)
16import Data.Monoid (Monoid(..))
17import Data.Monoid (Monoid(..))
17import Data.String (IsString(fromString))
18import Data.String (IsString(fromString))
@@ -23,6 +24,7 @@ import Data.Text.Internal.Search (indices)
23import Data.Text.Lazy.Read as TL
24import Data.Text.Lazy.Read as TL
24import Data.Text.Read as T
25import Data.Text.Read as T
25import Data.Word (Word, Word8, Word16, Word32, Word64)
26import Data.Word (Word, Word8, Word16, Word32, Word64)
27+import Data.Maybe (mapMaybe)
26import Numeric (showEFloat, showFFloat, showGFloat, showHex)
28import Numeric (showEFloat, showFFloat, showGFloat, showHex)
27import Prelude hiding (replicate)
29import Prelude hiding (replicate)
28import Test.Framework (Test, testGroup)
30import Test.Framework (Test, testGroup)
@@ -30,6 +32,7 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
30import Test.QuickCheck hiding ((.&.))
32import Test.QuickCheck hiding ((.&.))
31import Test.QuickCheck.Monadic
33import Test.QuickCheck.Monadic
32import Test.QuickCheck.Property (Property(..))
34import Test.QuickCheck.Property (Property(..))
35+import Test.QuickCheck.Unicode (char)
33import Tests.QuickCheckUtils
36import Tests.QuickCheckUtils
34import Tests.Utils
37import Tests.Utils
35import Text.Show.Functions ()
38import Text.Show.Functions ()
@@ -37,6 +40,7 @@ import qualified Control.Exception as Exception
37import qualified Data.Bits as Bits (shiftL, shiftR)
40import qualified Data.Bits as Bits (shiftL, shiftR)
38import qualified Data.ByteString as B
41import qualified Data.ByteString as B
39import qualified Data.ByteString.Lazy as BL
42import qualified Data.ByteString.Lazy as BL
43+import qualified Data.Char as C
40import qualified Data.List as L
44import qualified Data.List as L
41import qualified Data.Text as T
45import qualified Data.Text as T
42import qualified Data.Text.Encoding as E
46import qualified Data.Text.Encoding as E
@@ -60,10 +64,10 @@ t_pack_unpack = (T.unpack . T.pack) `eq` id
60tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
64tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
61t_stream_unstream = (S.unstream . S.stream) `eq` id
65t_stream_unstream = (S.unstream . S.stream) `eq` id
62tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
66tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
63−t_reverse_stream t = (S.reverse . S.reverseStream) t == t
67+t_reverse_stream t = (S.reverse . S.reverseStream) t === t
64−t_singleton c = [c] == (T.unpack . T.singleton) c
68+t_singleton c = [c] === (T.unpack . T.singleton) c
65−tl_singleton c = [c] == (TL.unpack . TL.singleton) c
69+tl_singleton c = [c] === (TL.unpack . TL.singleton) c
66−tl_unstreamChunks x = f 11 x == f 1000 x
70+tl_unstreamChunks x = f 11 x === f 1000 x
67 where f n = SL.unstreamChunks n . S.streamList
71 where f n = SL.unstreamChunks n . S.streamList
68tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
72tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
69tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
73tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
@@ -74,13 +78,13 @@ encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
74encodeLazyL1 :: TL.Text -> BL.ByteString
78encodeLazyL1 :: TL.Text -> BL.ByteString
75encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
79encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
76
80
77−t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
81+t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a
78 where a = T.map (\c -> chr (ord c `mod` 128)) t
82 where a = T.map (\c -> chr (ord c `mod` 128)) t
79−tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
83+tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) === a
80 where a = TL.map (\c -> chr (ord c `mod` 128)) t
84 where a = TL.map (\c -> chr (ord c `mod` 128)) t
81−t_latin1 t = E.decodeLatin1 (encodeL1 a) == a
85+t_latin1 t = E.decodeLatin1 (encodeL1 a) === a
82 where a = T.map (\c -> chr (ord c `mod` 256)) t
86 where a = T.map (\c -> chr (ord c `mod` 256)) t
83−tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a
87+tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) === a
84 where a = TL.map (\c -> chr (ord c `mod` 256)) t
88 where a = TL.map (\c -> chr (ord c `mod` 256)) t
85t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
89t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
86t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
90t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
@@ -111,7 +115,7 @@ t_utf8_undecoded = forAll genUnicode $ \t ->
111 let b = E.encodeUtf8 t
115 let b = E.encodeUtf8 t
112 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
116 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
113 leftover = (++ [B.empty]) . init . tail . B.inits
117 leftover = (++ [B.empty]) . init . tail . B.inits
114− in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls
118+ in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b === ls
115
119
116data Badness = Solo | Leading | Trailing
120data Badness = Solo | Leading | Trailing
117 deriving (Eq, Show)
121 deriving (Eq, Show)
@@ -177,6 +181,33 @@ genInvalidUTF8 = B.pack <$> oneof [
177 k <- choose (0,n)
181 k <- choose (0,n)
178 vectorOf k gen
182 vectorOf k gen
179
183
184+-- See http://unicode.org/faq/utf_bom.html#gen8
185+-- A sequence such as <110xxxxx2 0xxxxxxx2> is illegal ...
186+-- When faced with this illegal byte sequence ... a UTF-8 conformant process
187+-- must treat the first byte 110xxxxx2 as an illegal termination error
188+-- (e.g. filter it out or replace by 0xFFFD) ...
189+-- ... and continue processing at the second byte 0xxxxxxx2
190+t_decode_with_error2 =
191+ E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97]) === "xa"
192+t_decode_with_error3 =
193+ E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xE0, 97, 97]) === "xaa"
194+t_decode_with_error4 =
195+ E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xF0, 97, 97, 97]) === "xaaa"
196+
197+t_decode_with_error2' =
198+ case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97]) of
199+ E.Some x _ _ -> x === "xa"
200+t_decode_with_error3' =
201+ case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97]) of
202+ E.Some x _ _ -> x === "xaa"
203+t_decode_with_error4' =
204+ case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97, 97]) of
205+ E.Some x _ _ -> x === "xaaa"
206+
207+t_infix_concat bs1 text bs2 rep =
208+ text `T.isInfixOf`
209+ E.decodeUtf8With (\_ _ -> rep) (B.concat [bs1, E.encodeUtf8 text, bs2])
210+
180s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
211s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
181 where _types = s :: String
212 where _types = s :: String
182sf_Eq p s =
213sf_Eq p s =
@@ -201,8 +232,8 @@ t_mconcat = unsquare $
201 mconcat `eq` (unpackS . mconcat . L.map T.pack)
232 mconcat `eq` (unpackS . mconcat . L.map T.pack)
202tl_mconcat = unsquare $
233tl_mconcat = unsquare $
203 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
234 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
204−t_mempty = mempty == (unpackS (mempty :: T.Text))
235+t_mempty = mempty === (unpackS (mempty :: T.Text))
205−tl_mempty = mempty == (unpackS (mempty :: TL.Text))
236+tl_mempty = mempty === (unpackS (mempty :: TL.Text))
206t_IsString = fromString `eqP` (T.unpack . fromString)
237t_IsString = fromString `eqP` (T.unpack . fromString)
207tl_IsString = fromString `eqP` (TL.unpack . fromString)
238tl_IsString = fromString `eqP` (TL.unpack . fromString)
208
239
@@ -229,6 +260,13 @@ sf_uncons p = (uncons . L.filter p) `eqP`
229 (fmap (second unpackS) . S.uncons . S.filter p)
260 (fmap (second unpackS) . S.uncons . S.filter p)
230t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
261t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
231tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
262tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
263+
264+unsnoc xs@(_:_) = Just (init xs, last xs)
265+unsnoc [] = Nothing
266+
267+t_unsnoc = unsnoc `eqP` (fmap (first unpackS) . T.unsnoc)
268+tl_unsnoc = unsnoc `eqP` (fmap (first unpackS) . TL.unsnoc)
269+
232s_head = head `eqP` S.head
270s_head = head `eqP` S.head
233sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
271sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
234t_head = head `eqP` T.head
272t_head = head `eqP` T.head
@@ -326,6 +364,19 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
326 where p = T.length . T.filter isUpper
364 where p = T.length . T.filter isUpper
327tl_toUpper_upper t = p (TL.toUpper t) >= p t
365tl_toUpper_upper t = p (TL.toUpper t) >= p t
328 where p = TL.length . TL.filter isUpper
366 where p = TL.length . TL.filter isUpper
367+t_toTitle_title t = all (<= 1) (caps w)
368+ where caps = fmap (T.length . T.filter isUpper) . T.words . T.toTitle
369+ -- TIL: there exist uppercase-only letters
370+ w = T.filter (\c -> if C.isUpper c then C.toLower c /= c else True) t
371+t_toTitle_1stNotLower = and . notLow . T.toTitle . T.filter stable
372+ where notLow = mapMaybe (fmap (not . isLower) . (T.find isLetter)) . T.words
373+ -- Surprise! The Spanish/Portuguese ordinal indicators changed
374+ -- from category Ll (letter, lowercase) to Lo (letter, other)
375+ -- in Unicode 7.0
376+ -- Oh, and there exist lowercase-only letters (see previous test)
377+ stable c = if isLower c
378+ then C.toUpper c /= c
379+ else c /= '\170' && c /= '\186'
329
380
330justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
381justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
331justifyRight m n xs = L.replicate (m - length xs) n ++ xs
382justifyRight m n xs = L.replicate (m - length xs) n ++ xs
@@ -514,12 +565,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)
565s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
515sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
566sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
516 (unpackS . S.takeWhile p . S.filter q)
567 (unpackS . S.takeWhile p . S.filter q)
568+noMatch = do
569+ c <- char
570+ d <- suchThat char (/= c)
571+ return (c,d)
517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
572t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
573tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
519t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
574t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
520 (unpackS . T.takeWhileEnd p)
575 (unpackS . T.takeWhileEnd p)
576+t_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> T.null $
577+ T.takeWhileEnd (==d) (T.snoc t c)
521tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
578tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
522 (unpackS . TL.takeWhileEnd p)
579 (unpackS . TL.takeWhileEnd p)
580+tl_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> TL.null $
581+ TL.takeWhileEnd (==d) (TL.snoc t c)
523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
582s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
583s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
584sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -720,7 +779,7 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
720 conc = T.concat . TL.toChunks
779 conc = T.concat . TL.toChunks
721t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
780t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
722 let s = T.intercalate t ts
781 let s = T.intercalate t ts
723− in Slow.indices t s == indices t s
782+ in Slow.indices t s === indices t s
724
783
725-- Bit shifts.
784-- Bit shifts.
726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
785shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -812,18 +871,18 @@ tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
812-- Reading.
871-- Reading.
813
872
814t_decimal (n::Int) s =
873t_decimal (n::Int) s =
815− T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)
874+ T.signed T.decimal (T.pack (show n) `T.append` t) === Right (n,t)
816 where t = T.dropWhile isDigit s
875 where t = T.dropWhile isDigit s
817tl_decimal (n::Int) s =
876tl_decimal (n::Int) s =
818− TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
877+ TL.signed TL.decimal (TL.pack (show n) `TL.append` t) === Right (n,t)
819 where t = TL.dropWhile isDigit s
878 where t = TL.dropWhile isDigit s
820t_hexadecimal m s ox =
879t_hexadecimal m s ox =
821− T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
880+ T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) === Right (n,t)
822 where t = T.dropWhile isHexDigit s
881 where t = T.dropWhile isHexDigit s
823 p = if ox then "0x" else ""
882 p = if ox then "0x" else ""
824 n = getPositive m :: Int
883 n = getPositive m :: Int
825tl_hexadecimal m s ox =
884tl_hexadecimal m s ox =
826− TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
885+ TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) === Right (n,t)
827 where t = TL.dropWhile isHexDigit s
886 where t = TL.dropWhile isHexDigit s
828 p = if ox then "0x" else ""
887 p = if ox then "0x" else ""
829 n = getPositive m :: Int
888 n = getPositive m :: Int
@@ -867,11 +926,11 @@ tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
867
926
868t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
927t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
869t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
928t_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
929+t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) === t
871 where n = small m
930 where n = small m
872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
931t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
873
932
874−t_copy t = T.copy t == t
933+t_copy t = T.copy t === t
875
934
876-- Regression tests.
935-- Regression tests.
877s_filter_eq s = S.filter p t == S.streamList (filter p s)
936s_filter_eq s = S.filter p t == S.streamList (filter p s)
@@ -882,8 +941,13 @@ s_filter_eq s = S.filter p t == S.streamList (filter p s)
882-- functions that consume inaccurately sized streams behave
941-- functions that consume inaccurately sized streams behave
883-- themselves.
942-- themselves.
884shorten :: Int -> S.Stream a -> S.Stream a
943shorten :: Int -> S.Stream a -> S.Stream a
944+#ifdef __GHCJS__
945+shorten n t@(S.Stream arr off)
946+ | n > 0 = S.Stream arr off -- TODO
947+#else
885shorten n t@(S.Stream arr off len)
948shorten n t@(S.Stream arr off len)
886 | n > 0 = S.Stream arr off (smaller (exactSize n) len)
949 | n > 0 = S.Stream arr off (smaller (exactSize n) len)
950+#endif
887 | otherwise = t
951 | otherwise = t
888
952
889tests :: Test
953tests :: Test
@@ -924,6 +988,15 @@ tests =
924 testGroup "errors" [
988 testGroup "errors" [
925 testProperty "t_utf8_err" t_utf8_err,
989 testProperty "t_utf8_err" t_utf8_err,
926 testProperty "t_utf8_err'" t_utf8_err'
990 testProperty "t_utf8_err'" t_utf8_err'
991+ ],
992+ testGroup "error recovery" [
993+ testProperty "t_decode_with_error2" t_decode_with_error2,
994+ testProperty "t_decode_with_error3" t_decode_with_error3,
995+ testProperty "t_decode_with_error4" t_decode_with_error4,
996+ testProperty "t_decode_with_error2'" t_decode_with_error2',
997+ testProperty "t_decode_with_error3'" t_decode_with_error3',
998+ testProperty "t_decode_with_error4'" t_decode_with_error4',
999+ testProperty "t_infix_concat" t_infix_concat
927 ]
1000 ]
928 ],
1001 ],
929
1002
@@ -967,6 +1040,8 @@ tests =
967 testProperty "sf_uncons" sf_uncons,
1040 testProperty "sf_uncons" sf_uncons,
968 testProperty "t_uncons" t_uncons,
1041 testProperty "t_uncons" t_uncons,
969 testProperty "tl_uncons" tl_uncons,
1042 testProperty "tl_uncons" tl_uncons,
1043+ testProperty "t_unsnoc" t_unsnoc,
1044+ testProperty "tl_unsnoc" tl_unsnoc,
970 testProperty "s_head" s_head,
1045 testProperty "s_head" s_head,
971 testProperty "sf_head" sf_head,
1046 testProperty "sf_head" sf_head,
972 testProperty "t_head" t_head,
1047 testProperty "t_head" t_head,
@@ -1031,6 +1106,8 @@ tests =
1031 testProperty "t_toUpper_length" t_toUpper_length,
1106 testProperty "t_toUpper_length" t_toUpper_length,
1032 testProperty "t_toUpper_upper" t_toUpper_upper,
1107 testProperty "t_toUpper_upper" t_toUpper_upper,
1033 testProperty "tl_toUpper_upper" tl_toUpper_upper
1108 testProperty "tl_toUpper_upper" tl_toUpper_upper
1109+ -- testProperty "t_toTitle_title" t_toTitle_title,
1110+ -- testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower
1034 ],
1111 ],
1035
1112
1036 testGroup "justification" [
1113 testGroup "justification" [
@@ -1147,7 +1224,9 @@ tests =
1147 testProperty "t_takeWhile" t_takeWhile,
1224 testProperty "t_takeWhile" t_takeWhile,
1148 testProperty "tl_takeWhile" tl_takeWhile,
1225 testProperty "tl_takeWhile" tl_takeWhile,
1149 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1226 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1227+ testProperty "t_takeWhileEnd_null" t_takeWhileEnd_null,
1150 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1228 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1229+ testProperty "tl_takeWhileEnd_null" tl_takeWhileEnd_null,
1151 testProperty "sf_dropWhile" sf_dropWhile,
1230 testProperty "sf_dropWhile" sf_dropWhile,
1152 testProperty "s_dropWhile" s_dropWhile,
1231 testProperty "s_dropWhile" s_dropWhile,
1153 testProperty "s_dropWhile_s" s_dropWhile_s,
1232 testProperty "s_dropWhile_s" s_dropWhile_s,
tests/Tests/QuickCheckUtils.hs+4−4
@@ -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
@@ -157,9 +157,9 @@ shrinkNotEmpty isNull (NotEmpty xs) =
157 [ NotEmpty xs' | xs' <- shrink xs, not (isNull xs') ]
157 [ NotEmpty xs' | xs' <- shrink xs, not (isNull xs') ]
158
158
159data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
159data Small = S0 | S1 | S2 | S3 | S4 | S5 | S6 | S7
160− | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
160+-- | S8 | S9 | S10 | S11 | S12 | S13 | S14 | S15
161− | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23
161+-- | S16 | S17 | S18 | S19 | S20 | S21 | S22 | S23
162− | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31
162+-- | S24 | S25 | S26 | S27 | S28 | S29 | S30 | S31
163 deriving (Eq, Ord, Enum, Bounded)
163 deriving (Eq, Ord, Enum, Bounded)
164
164
165small :: Integral a => Small -> a
165small :: Integral a => Small -> a
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/Tests/SlowFunctions.hs+22
@@ -1,4 +1,6 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2+{-# LANGUAGE CPP #-}
3+{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes, MagicHash #-}
2module Tests.SlowFunctions
4module Tests.SlowFunctions
3 (
5 (
4 indices
6 indices
@@ -8,18 +10,31 @@ module Tests.SlowFunctions
8import qualified Data.Text as T
10import qualified Data.Text as T
9import Data.Text.Internal (Text(..))
11import Data.Text.Internal (Text(..))
10import Data.Text.Unsafe (iter_, unsafeHead, unsafeTail)
12import Data.Text.Unsafe (iter_, unsafeHead, unsafeTail)
13+#ifdef __GHCJS__
14+import Data.JSString (JSString)
15+#endif
11
16
12indices :: T.Text -- ^ Substring to search for (@needle@)
17indices :: T.Text -- ^ Substring to search for (@needle@)
13 -> T.Text -- ^ Text to search in (@haystack@)
18 -> T.Text -- ^ Text to search in (@haystack@)
14 -> [Int]
19 -> [Int]
20+#ifdef __GHCJS__
21+indices needle@(Text njst) haystack@(Text hjst)
22+#else
15indices needle@(Text _narr _noff nlen) haystack@(Text harr hoff hlen)
23indices needle@(Text _narr _noff nlen) haystack@(Text harr hoff hlen)
24+#endif
16 | T.null needle = []
25 | T.null needle = []
17 | otherwise = scan 0
26 | otherwise = scan 0
18 where
27 where
19 scan i | i >= hlen = []
28 scan i | i >= hlen = []
20 | needle `T.isPrefixOf` t = i : scan (i+nlen)
29 | needle `T.isPrefixOf` t = i : scan (i+nlen)
21 | otherwise = scan (i+d)
30 | otherwise = scan (i+d)
31+#ifdef __GHCJS__
32+ where t = Text $ js_substr1 i hjst
33+ hlen = js_length hjst
34+ nlen = js_length njst
35+#else
22 where t = Text harr (hoff+i) (hlen-i)
36 where t = Text harr (hoff+i) (hlen-i)
37+#endif
23 d = iter_ haystack i
38 d = iter_ haystack i
24
39
25splitOn :: T.Text -- ^ Text to split on
40splitOn :: T.Text -- ^ Text to split on
@@ -37,3 +52,10 @@ splitOn pat src0
37 | T.null s = [src] -- not found
52 | T.null s = [src] -- not found
38 | pat `T.isPrefixOf` s = T.take n src : go (T.drop l s)
53 | pat `T.isPrefixOf` s = T.take n src : go (T.drop l s)
39 | otherwise = search (n+1) (unsafeTail s)
54 | otherwise = search (n+1) (unsafeTail s)
55+
56+#ifdef __GHCJS__
57+foreign import javascript unsafe
58+ "$2.substr($1)" js_substr1 :: Int -> JSString -> JSString
59+foreign import javascript unsafe
60+ "$1.length" js_length :: JSString -> Int
61+#endif
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+106−27
@@ -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
@@ -88,13 +97,13 @@ library
88 Data.Text.Array
97 Data.Text.Array
89 Data.Text.Encoding
98 Data.Text.Encoding
90 Data.Text.Encoding.Error
99 Data.Text.Encoding.Error
91− Data.Text.Foreign
100+ -- Data.Text.Foreign
92 Data.Text.IO
101 Data.Text.IO
93 Data.Text.Internal
102 Data.Text.Internal
94 Data.Text.Internal.Builder
103 Data.Text.Internal.Builder
95− Data.Text.Internal.Builder.Functions
104+ -- Data.Text.Internal.Builder.Functions
96− Data.Text.Internal.Builder.Int.Digits
105+ -- Data.Text.Internal.Builder.Int.Digits
97− Data.Text.Internal.Builder.RealFloat.Functions
106+ -- Data.Text.Internal.Builder.RealFloat.Functions
98 Data.Text.Internal.Encoding.Fusion
107 Data.Text.Internal.Encoding.Fusion
99 Data.Text.Internal.Encoding.Fusion.Common
108 Data.Text.Internal.Encoding.Fusion.Common
100 Data.Text.Internal.Encoding.Utf16
109 Data.Text.Internal.Encoding.Utf16
@@ -106,14 +115,14 @@ library
106 Data.Text.Internal.Fusion.Common
115 Data.Text.Internal.Fusion.Common
107 Data.Text.Internal.Fusion.Size
116 Data.Text.Internal.Fusion.Size
108 Data.Text.Internal.Fusion.Types
117 Data.Text.Internal.Fusion.Types
109− Data.Text.Internal.IO
118+ -- Data.Text.Internal.IO
110 Data.Text.Internal.Lazy
119 Data.Text.Internal.Lazy
111− Data.Text.Internal.Lazy.Encoding.Fusion
120+ -- Data.Text.Internal.Lazy.Encoding.Fusion
112 Data.Text.Internal.Lazy.Fusion
121 Data.Text.Internal.Lazy.Fusion
113 Data.Text.Internal.Lazy.Search
122 Data.Text.Internal.Lazy.Search
114 Data.Text.Internal.Private
123 Data.Text.Internal.Private
115 Data.Text.Internal.Read
124 Data.Text.Internal.Read
116− Data.Text.Internal.Search
125+ -- Data.Text.Internal.Search
117 Data.Text.Internal.Unsafe
126 Data.Text.Internal.Unsafe
118 Data.Text.Internal.Unsafe.Char
127 Data.Text.Internal.Unsafe.Char
119 Data.Text.Internal.Unsafe.Shift
128 Data.Text.Internal.Unsafe.Shift
@@ -124,18 +133,23 @@ library
124 Data.Text.Lazy.Encoding
133 Data.Text.Lazy.Encoding
125 Data.Text.Lazy.IO
134 Data.Text.Lazy.IO
126 Data.Text.Lazy.Internal
135 Data.Text.Lazy.Internal
127− Data.Text.Lazy.Read
136+ -- Data.Text.Lazy.Read
128 Data.Text.Read
137 Data.Text.Read
129 Data.Text.Unsafe
138 Data.Text.Unsafe
139+ -- moved from ghcjs-base
140+ -- reflex-dom depends in it
141+ Data.JSString.Text
130
142
131− other-modules:
143+ -- other-modules:
132− Data.Text.Show
144+ -- Data.Text.Show
133
145
134 build-depends:
146 build-depends:
135 array >= 0.3,
147 array >= 0.3,
136 base >= 4.2 && < 5,
148 base >= 4.2 && < 5,
137 binary,
149 binary,
138 deepseq >= 1.1.0.0,
150 deepseq >= 1.1.0.0,
151+ ghcjs-base,
152+ ghcjs-prim,
139 ghc-prim >= 0.2
153 ghc-prim >= 0.2
140
154
141 if flag(bytestring-builder)
155 if flag(bytestring-builder)
@@ -160,27 +174,92 @@ library
160
174
161test-suite tests
175test-suite tests
162 type: exitcode-stdio-1.0
176 type: exitcode-stdio-1.0
163− hs-source-dirs: tests .
164− main-is: Tests.hs
165 c-sources: cbits/cbits.c
177 c-sources: cbits/cbits.c
166 include-dirs: include
178 include-dirs: include
167
179
168 ghc-options:
180 ghc-options:
169− -Wall -threaded -O0 -rtsopts
181+ -Wall -threaded -rtsopts
170
182
171 cpp-options:
183 cpp-options:
172 -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
184 -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
173
185
186+ -- modules specific to test-suite
187+ hs-source-dirs: tests
188+ main-is: Tests.hs
189+ other-modules:
190+ Tests.Properties
191+ Tests.Properties.Mul
192+ Tests.QuickCheckUtils
193+ Tests.Regressions
194+ Tests.SlowFunctions
195+ Tests.Utils
196+
197+ -- Same as in `library` stanza; this is needed by cabal for accurate
198+ -- file-monitoring as well as to avoid `-Wmissing-home-modules`
199+ -- warnings We can't use an inter-package library dependency because
200+ -- of different `ghc-options`/`cpp-options` (as a side-benefitt,
201+ -- this enables per-component build parallelism in `cabal
202+ -- new-build`!); We could, however, use cabal-version:2.2's `common`
203+ -- blocks at some point in the future to reduce the duplication.
204+ hs-source-dirs: .
205+ other-modules:
206+ Data.Text
207+ Data.Text.Array
208+ Data.Text.Encoding
209+ Data.Text.Encoding.Error
210+ Data.Text.Foreign
211+ Data.Text.IO
212+ Data.Text.Internal
213+ Data.Text.Internal.Builder
214+ Data.Text.Internal.Builder.Functions
215+ Data.Text.Internal.Builder.Int.Digits
216+ Data.Text.Internal.Builder.RealFloat.Functions
217+ Data.Text.Internal.Encoding.Fusion
218+ Data.Text.Internal.Encoding.Fusion.Common
219+ Data.Text.Internal.Encoding.Utf16
220+ Data.Text.Internal.Encoding.Utf32
221+ Data.Text.Internal.Encoding.Utf8
222+ Data.Text.Internal.Functions
223+ Data.Text.Internal.Fusion
224+ Data.Text.Internal.Fusion.CaseMapping
225+ Data.Text.Internal.Fusion.Common
226+ Data.Text.Internal.Fusion.Size
227+ Data.Text.Internal.Fusion.Types
228+ Data.Text.Internal.IO
229+ Data.Text.Internal.Lazy
230+ Data.Text.Internal.Lazy.Encoding.Fusion
231+ Data.Text.Internal.Lazy.Fusion
232+ Data.Text.Internal.Lazy.Search
233+ Data.Text.Internal.Private
234+ Data.Text.Internal.Read
235+ Data.Text.Internal.Search
236+ Data.Text.Internal.Unsafe
237+ Data.Text.Internal.Unsafe.Char
238+ Data.Text.Internal.Unsafe.Shift
239+ Data.Text.Lazy
240+ Data.Text.Lazy.Builder
241+ Data.Text.Lazy.Builder.Int
242+ Data.Text.Lazy.Builder.RealFloat
243+ Data.Text.Lazy.Encoding
244+ Data.Text.Lazy.IO
245+ Data.Text.Lazy.Internal
246+ Data.Text.Lazy.Read
247+ Data.Text.Read
248+ Data.Text.Unsafe
249+ Data.Text.Show
250+
174 build-depends:
251 build-depends:
175 HUnit >= 1.2,
252 HUnit >= 1.2,
176− QuickCheck >= 2.7,
253+ QuickCheck >= 2.7 && < 2.12,
177 array,
254 array,
178 base,
255 base,
179 binary,
256 binary,
180 deepseq,
257 deepseq,
181 directory,
258 directory,
182 ghc-prim,
259 ghc-prim,
260+ ghcjs-prim,
261+ ghcjs-base,
183− quickcheck-unicode,
262+ quickcheck-unicode >= 1.0.1.0,
184 random,
263 random,
185 test-framework >= 0.4,
264 test-framework >= 0.4,
186 test-framework-hunit >= 0.2,
265 test-framework-hunit >= 0.2,
@@ -201,7 +280,7 @@ test-suite tests
201
280
202source-repository head
281source-repository head
203 type: git
282 type: git
204− location: https://github.com/bos/text
283+ location: https://github.com/haskell/text
205
284
206source-repository head
285source-repository head
207 type: mercurial
286 type: mercurial