on master help sign in
.gitignore+3−10
since splitsnapshots
unifiedsplit
@@ -1,10 +1,3 @@
1−/dist/
1+dist
2−/dist-boot/
3−/dist-install/
4−/dist-newstyle/
5−/cabal-dev/
2+cabal-dev
6−/cabal.sandbox.config
3+cabal.sandbox.config
7−/ghc.mk
8−/GNUmakefile
9−/.ghc.environment.*
10−/cabal.project.local
.hgtags−1
@@ -64,4 +64,3 @@ 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.ymldeleted−111
@@ -1,111 +0,0 @@
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.hsdeleted−64
@@ -1,64 +0,0 @@
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+391−698
@@ -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−{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, UnliftedFFITypes #-}
9+
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,6 +15,7 @@
15--
15--
16-- License : BSD-style
16-- License : BSD-style
17-- Maintainer : bos@serpentine.com
17-- Maintainer : bos@serpentine.com
18+-- Stability : experimental
18-- Portability : GHC
19-- Portability : GHC
19--
20--
20-- A time and space-efficient implementation of Unicode text.
21-- A time and space-efficient implementation of Unicode text.
@@ -31,9 +32,8 @@
31--
32--
32-- To use an extended and very rich family of functions for working
33-- To use an extended and very rich family of functions for working
33-- with Unicode text (including normalization, regular expressions,
34-- with Unicode text (including normalization, regular expressions,
34−-- non-standard encodings, text breaking, and locales), see the
35+-- non-standard encodings, text breaking, and locales), see
35−-- <http://hackage.haskell.org/package/text-icu text-icu package >.
36+-- <http://hackage.haskell.org/package/text-icu the text-icu package >.
36−--
37
37
38module Data.Text
38module Data.Text
39 (
39 (
@@ -43,9 +43,6 @@ module Data.Text
43 -- * Acceptable data
43 -- * Acceptable data
44 -- $replacement
44 -- $replacement
45
45
46− -- * Definition of character
47− -- $character_definition
48−
49 -- * Fusion
46 -- * Fusion
50 -- $fusion
47 -- $fusion
51
48
@@ -63,7 +60,6 @@ module Data.Text
63 , snoc
60 , snoc
64 , append
61 , append
65 , uncons
62 , uncons
66− , unsnoc
67 , head
63 , head
68 , last
64 , last
69 , tail
65 , tail
@@ -227,17 +223,16 @@ import qualified Data.Text.Internal.Fusion as S
227import qualified Data.Text.Internal.Fusion.Common as S
223import qualified Data.Text.Internal.Fusion.Common as S
228import Data.Text.Encoding (decodeUtf8', encodeUtf8)
224import Data.Text.Encoding (decodeUtf8', encodeUtf8)
229import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
225import Data.Text.Internal.Fusion (stream, reverseStream, unstream)
230−-- import Data.Text.Internal.Private (span_)
226+import Data.Text.Internal.Private (span_)
231−import Data.Text.Internal (Text(..), empty, empty_, firstf, mul, safe, text)
227+import Data.Text.Internal (Text(..), empty, firstf, mul, safe, text)
232−-- import Data.Text.Show (singleton, unpack, unpackCString#)
228+import Data.Text.Show (singleton, unpack, unpackCString#)
233import qualified Prelude as P
229import qualified Prelude as P
234import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
230import Data.Text.Unsafe (Iter(..), iter, iter_, lengthWord16, reverseIter,
235− reverseIter_, unsafeHead, unsafeTail,
231+ reverseIter_, unsafeHead, unsafeTail)
236− unsafeDupablePerformIO)
237import Data.Text.Internal.Unsafe.Char (unsafeChr)
232import Data.Text.Internal.Unsafe.Char (unsafeChr)
238import qualified Data.Text.Internal.Functions as F
233import qualified Data.Text.Internal.Functions as F
239import qualified Data.Text.Internal.Encoding.Utf16 as U16
234import qualified Data.Text.Internal.Encoding.Utf16 as U16
240−-- import Data.Text.Internal.Search (indices)
235+import Data.Text.Internal.Search (indices)
241#if defined(__HADDOCK__)
236#if defined(__HADDOCK__)
242import Data.ByteString (ByteString)
237import Data.ByteString (ByteString)
243import qualified Data.Text.Lazy as L
238import qualified Data.Text.Lazy as L
@@ -251,76 +246,6 @@ import qualified GHC.Exts as Exts
251import Text.Printf (PrintfArg, formatArg, formatString)
246import Text.Printf (PrintfArg, formatArg, formatString)
252#endif
247#endif
253
248
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−
324-- $strict
249-- $strict
325--
250--
326-- This package provides both strict and lazy 'Text' types. The
251-- This package provides both strict and lazy 'Text' types. The
@@ -396,31 +321,22 @@ unpackCString# addr# = Text $ SJS.unstream (SJS.streamCString# addr#)
396-- Functions that can be fused by the compiler are documented with the
321-- Functions that can be fused by the compiler are documented with the
397-- phrase \"Subject to fusion\".
322-- phrase \"Subject to fusion\".
398
323
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 (==) #-}
404instance Eq Text where
324instance Eq Text where
405− Text x == Text y = x == y
325+ Text arrA offA lenA == Text arrB offB lenB
406−
326+ | lenA == lenB = A.equal arrA offA arrB offB lenA
407−-- instance Ord Text where
327+ | otherwise = False
408−-- compare = compareText
328+ {-# INLINE (==) #-}
409
329
410instance Ord Text where
330instance Ord Text where
411− compare (Text x) (Text y) = compare x y
331+ compare = compareText
412
332
413instance Read Text where
333instance Read Text where
414 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
334 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
415
335
416#if MIN_VERSION_base(4,9,0)
336#if MIN_VERSION_base(4,9,0)
417−-- | Non-orphan 'Semigroup' instance only defined for
418−-- @base-4.9.0.0@ and later; orphan instances for older GHCs are
337+-- Semigroup orphan instances for older GHCs are provided by
419−-- provided by
420−-- the [semigroups](http://hackage.haskell.org/package/semigroups)
421−-- package
338+-- 'semigroups` package
422−--
339+
423−-- @since 1.2.2.0
424instance Semigroup Text where
340instance Semigroup Text where
425 (<>) = append
341 (<>) = append
426#endif
342#endif
@@ -438,7 +354,6 @@ instance IsString Text where
438 fromString = pack
354 fromString = pack
439
355
440#if __GLASGOW_HASKELL__ >= 708
356#if __GLASGOW_HASKELL__ >= 708
441−-- | @since 1.2.0.0
442instance Exts.IsList Text where
357instance Exts.IsList Text where
443 type Item Text = Char
358 type Item Text = Char
444 fromList = pack
359 fromList = pack
@@ -449,7 +364,6 @@ instance Exts.IsList Text where
449instance NFData Text where rnf !_ = ()
364instance NFData Text where rnf !_ = ()
450#endif
365#endif
451
366
452−-- | @since 1.2.1.0
453instance Binary Text where
367instance Binary Text where
454 put t = put (encodeUtf8 t)
368 put t = put (encodeUtf8 t)
455 get = do
369 get = do
@@ -483,10 +397,8 @@ instance Data Text where
483
397
484#if MIN_VERSION_base(4,7,0)
398#if MIN_VERSION_base(4,7,0)
485-- | Only defined for @base-4.7.0.0@ and later
399-- | Only defined for @base-4.7.0.0@ and later
486−--
487−-- @since 1.2.2.0
488instance PrintfArg Text where
400instance PrintfArg Text where
489− formatArg t = formatString $ unpack t
401+ formatArg txt = formatString $ unpack txt
490#endif
402#endif
491
403
492packConstr :: Constr
404packConstr :: Constr
@@ -495,19 +407,19 @@ packConstr = mkConstr textDataType "pack" [] Prefix
495textDataType :: DataType
407textDataType :: DataType
496textDataType = mkDataType "Data.Text.Text" [packConstr]
408textDataType = mkDataType "Data.Text.Text" [packConstr]
497
409
498−-- -- | /O(n)/ Compare two 'Text' values lexicographically.
410+-- | /O(n)/ Compare two 'Text' values lexicographically.
499−-- compareText :: Text -> Text -> Ordering
411+compareText :: Text -> Text -> Ordering
500−-- compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
412+compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB)
501−-- | lenA == 0 && lenB == 0 = EQ
413+ | lenA == 0 && lenB == 0 = EQ
502−-- | otherwise = go 0 0
414+ | otherwise = go 0 0
503−-- where
415+ where
504−-- go !i !j
416+ go !i !j
505−-- | i >= lenA || j >= lenB = compare lenA lenB
417+ | i >= lenA || j >= lenB = compare lenA lenB
506−-- | a < b = LT
418+ | a < b = LT
507−-- | a > b = GT
419+ | a > b = GT
508−-- | otherwise = go (i+di) (j+dj)
420+ | otherwise = go (i+di) (j+dj)
509−-- where Iter a di = iter ta i
421+ where Iter a di = iter ta i
510−-- Iter b dj = iter tb j
422+ Iter b dj = iter tb j
511
423
512-- -----------------------------------------------------------------------------
424-- -----------------------------------------------------------------------------
513-- * Conversion to/from 'Text'
425-- * Conversion to/from 'Text'
@@ -515,8 +427,7 @@ textDataType = mkDataType "Data.Text.Text" [packConstr]
515-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
427-- | /O(n)/ Convert a 'String' into a 'Text'. Subject to
516-- fusion. Performs replacement on invalid scalar values.
428-- fusion. Performs replacement on invalid scalar values.
517pack :: String -> Text
429pack :: String -> Text
518−pack = coerce JSS.pack
519−-- pack = unstream . S.map safe . S.streamList
430+pack = unstream . S.map safe . S.streamList
520{-# INLINE [1] pack #-}
431{-# INLINE [1] pack #-}
521
432
522-- -----------------------------------------------------------------------------
433-- -----------------------------------------------------------------------------
@@ -527,8 +438,7 @@ pack = coerce JSS.pack
527-- copying a new array. Subject to fusion. Performs replacement on
438-- copying a new array. Subject to fusion. Performs replacement on
528-- invalid scalar values.
439-- invalid scalar values.
529cons :: Char -> Text -> Text
440cons :: Char -> Text -> Text
530−cons = coerce JSS.cons
531−-- cons c t = unstream (S.cons (safe c) (stream t))
441+cons c t = unstream (S.cons (safe c) (stream t))
532{-# INLINE cons #-}
442{-# INLINE cons #-}
533
443
534infixr 5 `cons`
444infixr 5 `cons`
@@ -537,27 +447,25 @@ infixr 5 `cons`
537-- entire array in the process, unless fused. Subject to fusion.
447-- entire array in the process, unless fused. Subject to fusion.
538-- Performs replacement on invalid scalar values.
448-- Performs replacement on invalid scalar values.
539snoc :: Text -> Char -> Text
449snoc :: Text -> Char -> Text
540−snoc = coerce JSS.snoc
541−-- snoc t c = unstream (S.snoc (stream t) (safe c))
450+snoc t c = unstream (S.snoc (stream t) (safe c))
542{-# INLINE snoc #-}
451{-# INLINE snoc #-}
543
452
544-- | /O(n)/ Appends one 'Text' to the other by copying both of them
453-- | /O(n)/ Appends one 'Text' to the other by copying both of them
545-- into a new 'Text'. Subject to fusion.
454-- into a new 'Text'. Subject to fusion.
546append :: Text -> Text -> Text
455append :: Text -> Text -> Text
547−append = coerce JSS.append
548−-- append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
456+append a@(Text arr1 off1 len1) b@(Text arr2 off2 len2)
549−-- | len1 == 0 = b
457+ | len1 == 0 = b
550−-- | len2 == 0 = a
458+ | len2 == 0 = a
551−-- | len > 0 = Text (A.run x) 0 len
459+ | len > 0 = Text (A.run x) 0 len
552−-- | otherwise = overflowError "append"
460+ | otherwise = overflowError "append"
553−-- where
461+ where
554−-- len = len1+len2
462+ len = len1+len2
555−-- x :: ST s (A.MArray s)
463+ x :: ST s (A.MArray s)
556−-- x = do
464+ x = do
557−-- arr <- A.new len
465+ arr <- A.new len
558−-- A.copyI arr 0 arr1 off1 len1
466+ A.copyI arr 0 arr1 off1 len1
559−-- A.copyI arr len1 arr2 off2 len
467+ A.copyI arr len1 arr2 off2 len
560−-- return arr
468+ return arr
561{-# NOINLINE append #-}
469{-# NOINLINE append #-}
562
470
563{-# RULES
471{-# RULES
@@ -570,18 +478,16 @@ append = coerce JSS.append
570-- | /O(1)/ Returns the first character of a 'Text', which must be
478-- | /O(1)/ Returns the first character of a 'Text', which must be
571-- non-empty. Subject to fusion.
479-- non-empty. Subject to fusion.
572head :: Text -> Char
480head :: Text -> Char
573−head = coerce JSS.head
574−-- head t = S.head (stream t)
481+head t = S.head (stream t)
575{-# INLINE head #-}
482{-# INLINE head #-}
576
483
577-- | /O(1)/ Returns the first character and rest of a 'Text', or
484-- | /O(1)/ Returns the first character and rest of a 'Text', or
578-- 'Nothing' if empty. Subject to fusion.
485-- 'Nothing' if empty. Subject to fusion.
579uncons :: Text -> Maybe (Char, Text)
486uncons :: Text -> Maybe (Char, Text)
580−uncons = coerce JSS.uncons
581−-- uncons t@(Text arr off len)
487+uncons t@(Text arr off len)
582−-- | len <= 0 = Nothing
488+ | len <= 0 = Nothing
583−-- | otherwise = Just $ let !(Iter c d) = iter t 0
489+ | otherwise = Just $ let !(Iter c d) = iter t 0
584−-- in (c, text arr (off+d) (len-d))
490+ in (c, text arr (off+d) (len-d))
585{-# INLINE [1] uncons #-}
491{-# INLINE [1] uncons #-}
586
492
587-- | Lifted from Control.Arrow and specialized.
493-- | Lifted from Control.Arrow and specialized.
@@ -591,13 +497,12 @@ second f (a, b) = (a, f b)
591-- | /O(1)/ Returns the last character of a 'Text', which must be
497-- | /O(1)/ Returns the last character of a 'Text', which must be
592-- non-empty. Subject to fusion.
498-- non-empty. Subject to fusion.
593last :: Text -> Char
499last :: Text -> Char
594−last = coerce JSS.last
595−-- last (Text arr off len)
500+last (Text arr off len)
596−-- | len <= 0 = emptyError "last"
501+ | len <= 0 = emptyError "last"
597−-- | n < 0xDC00 || n > 0xDFFF = unsafeChr n
502+ | n < 0xDC00 || n > 0xDFFF = unsafeChr n
598−-- | otherwise = U16.chr2 n0 n
503+ | otherwise = U16.chr2 n0 n
599−-- where n = A.unsafeIndex arr (off+len-1)
504+ where n = A.unsafeIndex arr (off+len-1)
600−-- n0 = A.unsafeIndex arr (off+len-2)
505+ n0 = A.unsafeIndex arr (off+len-2)
601{-# INLINE [1] last #-}
506{-# INLINE [1] last #-}
602
507
603{-# RULES
508{-# RULES
@@ -610,11 +515,10 @@ last = coerce JSS.last
610-- | /O(1)/ Returns all characters after the head of a 'Text', which
515-- | /O(1)/ Returns all characters after the head of a 'Text', which
611-- must be non-empty. Subject to fusion.
516-- must be non-empty. Subject to fusion.
612tail :: Text -> Text
517tail :: Text -> Text
613−tail = coerce JSS.tail
614−-- tail t@(Text arr off len)
518+tail t@(Text arr off len)
615−-- | len <= 0 = emptyError "tail"
519+ | len <= 0 = emptyError "tail"
616−-- | otherwise = text arr (off+d) (len-d)
520+ | otherwise = text arr (off+d) (len-d)
617−-- where d = iter_ t 0
521+ where d = iter_ t 0
618{-# INLINE [1] tail #-}
522{-# INLINE [1] tail #-}
619
523
620{-# RULES
524{-# RULES
@@ -627,12 +531,11 @@ tail = coerce JSS.tail
627-- | /O(1)/ Returns all but the last character of a 'Text', which must
531-- | /O(1)/ Returns all but the last character of a 'Text', which must
628-- be non-empty. Subject to fusion.
532-- be non-empty. Subject to fusion.
629init :: Text -> Text
533init :: Text -> Text
630−init = coerce JSS.init
631−-- init (Text arr off len) | len <= 0 = emptyError "init"
534+init (Text arr off len) | len <= 0 = emptyError "init"
632−-- | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
535+ | n >= 0xDC00 && n <= 0xDFFF = text arr off (len-2)
633−-- | otherwise = text arr off (len-1)
536+ | otherwise = text arr off (len-1)
634−-- where
537+ where
635−-- n = A.unsafeIndex arr (off+len-1)
538+ n = A.unsafeIndex arr (off+len-1)
636{-# INLINE [1] init #-}
539{-# INLINE [1] init #-}
637
540
638{-# RULES
541{-# RULES
@@ -642,29 +545,14 @@ init = coerce JSS.init
642 unstream (S.init (stream t)) = init t
545 unstream (S.init (stream t)) = init t
643 #-}
546 #-}
644
547
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−
659-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
548-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
660-- fusion.
549-- fusion.
661null :: Text -> Bool
550null :: Text -> Bool
662−null = coerce JSS.null
663−-- null (Text _arr _off len) =
551+null (Text _arr _off len) =
664−-- #if defined(ASSERTS)
552+#if defined(ASSERTS)
665−-- assert (len >= 0) $
553+ assert (len >= 0) $
666−-- #endif
554+#endif
667−-- len <= 0
555+ len <= 0
668{-# INLINE [1] null #-}
556{-# INLINE [1] null #-}
669
557
670{-# RULES
558{-# RULES
@@ -676,15 +564,14 @@ null = coerce JSS.null
676
564
677-- | /O(1)/ Tests whether a 'Text' contains exactly one character.
565-- | /O(1)/ Tests whether a 'Text' contains exactly one character.
678-- Subject to fusion.
566-- Subject to fusion.
679−-- isSingleton :: Text -> Bool
567+isSingleton :: Text -> Bool
680−-- isSingleton = S.isSingleton . stream
568+isSingleton = S.isSingleton . stream
681−-- {-# INLINE isSingleton #-}
569+{-# INLINE isSingleton #-}
682
570
683-- | /O(n)/ Returns the number of characters in a 'Text'.
571-- | /O(n)/ Returns the number of characters in a 'Text'.
684-- Subject to fusion.
572-- Subject to fusion.
685length :: Text -> Int
573length :: Text -> Int
686−length = coerce JSS.length
687−-- length t = S.length (stream t)
574+length t = S.length (stream t)
688{-# INLINE [0] length #-}
575{-# INLINE [0] length #-}
689-- length needs to be phased after the compareN/length rules otherwise
576-- length needs to be phased after the compareN/length rules otherwise
690-- it may inline before the rules have an opportunity to fire.
577-- it may inline before the rules have an opportunity to fire.
@@ -737,58 +624,29 @@ compareLength t n = S.compareLengthI (stream t) n
737-- -----------------------------------------------------------------------------
624-- -----------------------------------------------------------------------------
738-- * Transformations
625-- * Transformations
739-- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to
626-- | /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−--
748−-- Subject to fusion. Performs replacement on invalid scalar values.
627+-- each element of @t@. Subject to fusion. Performs replacement on
628+-- invalid scalar values.
749map :: (Char -> Char) -> Text -> Text
629map :: (Char -> Char) -> Text -> Text
750−map = coerce JSS.map
751−-- map f t = unstream (S.map (safe . f) (stream t))
630+map f t = unstream (S.map (safe . f) (stream t))
752{-# INLINE [1] map #-}
631{-# INLINE [1] map #-}
753
632
754-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
633-- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of
755-- 'Text's and concatenates the list after interspersing the first
634-- 'Text's and concatenates the list after interspersing the first
756-- argument between each element of the list.
635-- 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"
762intercalate :: Text -> [Text] -> Text
636intercalate :: Text -> [Text] -> Text
763−intercalate = coerce JSS.intercalate
764−-- intercalate t = concat . (F.intersperse t)
637+intercalate t = concat . (F.intersperse t)
765{-# INLINE intercalate #-}
638{-# INLINE intercalate #-}
766
639
767-- | /O(n)/ The 'intersperse' function takes a character and places it
640-- | /O(n)/ The 'intersperse' function takes a character and places it
768−-- between the characters of a 'Text'.
641+-- between the characters of a 'Text'. Subject to fusion. Performs
769−--
770−-- Example:
771−--
772−-- >>> T.intersperse '.' "SHIELD"
773−-- "S.H.I.E.L.D"
774−--
775−-- Subject to fusion. Performs replacement on invalid scalar values.
642+-- replacement on invalid scalar values.
776intersperse :: Char -> Text -> Text
643intersperse :: Char -> Text -> Text
777−intersperse = coerce JSS.intersperse
778−-- intersperse c t = unstream (S.intersperse (safe c) (stream t))
644+intersperse c t = unstream (S.intersperse (safe c) (stream t))
779{-# INLINE intersperse #-}
645{-# INLINE intersperse #-}
780
646
781−-- | /O(n)/ Reverse the characters of a string.
647+-- | /O(n)/ Reverse the characters of a string. Subject to fusion.
782−--
783−-- Example:
784−--
785−-- >>> T.reverse "desrever"
786−-- "reversed"
787−--
788−-- Subject to fusion.
789reverse :: Text -> Text
648reverse :: Text -> Text
790−reverse = coerce JSS.reverse
791−-- reverse t = S.reverse (stream t)
649+reverse t = S.reverse (stream t)
792{-# INLINE reverse #-}
650{-# INLINE reverse #-}
793
651
794-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
652-- | /O(m+n)/ Replace every non-overlapping occurrence of @needle@ in
@@ -805,14 +663,12 @@ reverse = coerce JSS.reverse
805-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
663-- @needle@ occurs in @replacement@, that occurrence will /not/ itself
806-- be replaced recursively:
664-- be replaced recursively:
807--
665--
808−-- >>> replace "oo" "foo" "oo"
666+-- > replace "oo" "foo" "oo" == "foo"
809−-- "foo"
810--
667--
811-- In cases where several instances of @needle@ overlap, only the
668-- In cases where several instances of @needle@ overlap, only the
812-- first one will be replaced:
669-- first one will be replaced:
813--
670--
814−-- >>> replace "ofo" "bar" "ofofo"
671+-- > replace "ofo" "bar" "ofofo" == "barfo"
815−-- "barfo"
816--
672--
817-- In (unlikely) bad cases, this function's time complexity degrades
673-- In (unlikely) bad cases, this function's time complexity degrades
818-- towards /O(n*m)/.
674-- towards /O(n*m)/.
@@ -824,29 +680,28 @@ replace :: Text
824 -> Text
680 -> Text
825 -- ^ @haystack@ in which to search.
681 -- ^ @haystack@ in which to search.
826 -> Text
682 -> Text
827−replace = coerce JSS.replace
828−-- replace needle@(Text _ _ neeLen)
683+replace needle@(Text _ _ neeLen)
829−-- (Text repArr repOff repLen)
684+ (Text repArr repOff repLen)
830−-- haystack@(Text hayArr hayOff hayLen)
685+ haystack@(Text hayArr hayOff hayLen)
831−-- | neeLen == 0 = emptyError "replace"
686+ | neeLen == 0 = emptyError "replace"
832−-- | L.null ixs = haystack
687+ | L.null ixs = haystack
833−-- | len > 0 = Text (A.run x) 0 len
688+ | len > 0 = Text (A.run x) 0 len
834−-- | otherwise = empty
689+ | otherwise = empty
835−-- where
690+ where
836−-- ixs = indices needle haystack
691+ ixs = indices needle haystack
837−-- len = hayLen - (neeLen - repLen) `mul` L.length ixs
692+ len = hayLen - (neeLen - repLen) `mul` L.length ixs
838−-- x :: ST s (A.MArray s)
693+ x :: ST s (A.MArray s)
839−-- x = do
694+ x = do
840−-- marr <- A.new len
695+ marr <- A.new len
841−-- let loop (i:is) o d = do
696+ let loop (i:is) o d = do
842−-- let d0 = d + i - o
697+ let d0 = d + i - o
843−-- d1 = d0 + repLen
698+ d1 = d0 + repLen
844−-- A.copyI marr d hayArr (hayOff+o) d0
699+ A.copyI marr d hayArr (hayOff+o) d0
845−-- A.copyI marr d0 repArr repOff d1
700+ A.copyI marr d0 repArr repOff d1
846−-- loop is (i + neeLen) d1
701+ loop is (i + neeLen) d1
847−-- loop [] o d = A.copyI marr d hayArr (hayOff+o) len
702+ loop [] o d = A.copyI marr d hayArr (hayOff+o) len
848−-- loop ixs 0 0
703+ loop ixs 0 0
849−-- return marr
704+ return marr
850
705
851-- ----------------------------------------------------------------------------
706-- ----------------------------------------------------------------------------
852-- ** Case conversions (folds)
707-- ** Case conversions (folds)
@@ -885,8 +740,7 @@ replace = coerce JSS.replace
885-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)
740-- U+00B5) is case folded to \"&#x3bc;\" (small letter mu, U+03BC)
886-- instead of itself.
741-- instead of itself.
887toCaseFold :: Text -> Text
742toCaseFold :: Text -> Text
888−-- toCaseFold t = unstream (S.toCaseFold (stream t))
743+toCaseFold t = unstream (S.toCaseFold (stream t))
889−toCaseFold = coerce JSS.toCaseFold
890{-# INLINE toCaseFold #-}
744{-# INLINE toCaseFold #-}
891
745
892-- | /O(n)/ Convert a string to lower case, using simple case
746-- | /O(n)/ Convert a string to lower case, using simple case
@@ -897,8 +751,7 @@ toCaseFold = coerce JSS.toCaseFold
897-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
751-- U+0130) maps to the sequence \"i\" (Latin small letter i, U+0069)
898-- followed by \" &#x307;\" (combining dot above, U+0307).
752-- followed by \" &#x307;\" (combining dot above, U+0307).
899toLower :: Text -> Text
753toLower :: Text -> Text
900−-- toLower t = unstream (S.toLower (stream t))
754+toLower t = unstream (S.toLower (stream t))
901−toLower = coerce JSS.toLower
902{-# INLINE toLower #-}
755{-# INLINE toLower #-}
903
756
904-- | /O(n)/ Convert a string to upper case, using simple case
757-- | /O(n)/ Convert a string to upper case, using simple case
@@ -908,8 +761,7 @@ toLower = coerce JSS.toLower
908-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
761-- instance, the German \"&#xdf;\" (eszett, U+00DF) maps to the
909-- two-letter sequence \"SS\".
762-- two-letter sequence \"SS\".
910toUpper :: Text -> Text
763toUpper :: Text -> Text
911−-- toUpper t = unstream (S.toUpper (stream t))
764+toUpper t = unstream (S.toUpper (stream t))
912−toUpper = coerce JSS.toUpper
913{-# INLINE toUpper #-}
765{-# INLINE toUpper #-}
914
766
915-- | /O(n)/ Convert a string to title case, using simple case
767-- | /O(n)/ Convert a string to title case, using simple case
@@ -930,11 +782,8 @@ toUpper = coerce JSS.toUpper
930-- guides disagree on whether the book name \"The Hill of the Red
782-- guides disagree on whether the book name \"The Hill of the Red
931-- Fox\" is correctly title cased&#x2014;but this function will
783-- Fox\" is correctly title cased&#x2014;but this function will
932-- capitalize /every/ word.
784-- capitalize /every/ word.
933−--
934−-- @since 1.0.0.0
935toTitle :: Text -> Text
785toTitle :: Text -> Text
936−toTitle = coerce JSS.toTitle
937−-- toTitle t = unstream (S.toTitle (stream t))
786+toTitle t = unstream (S.toTitle (stream t))
938{-# INLINE toTitle #-}
787{-# INLINE toTitle #-}
939
788
940-- | /O(n)/ Left-justify a string to the given length, using the
789-- | /O(n)/ Left-justify a string to the given length, using the
@@ -943,17 +792,13 @@ toTitle = coerce JSS.toTitle
943--
792--
944-- Examples:
793-- Examples:
945--
794--
946−-- >>> justifyLeft 7 'x' "foo"
795+-- > justifyLeft 7 'x' "foo" == "fooxxxx"
947−-- "fooxxxx"
948−--
949−-- >>> justifyLeft 3 'x' "foobar"
796+-- > justifyLeft 3 'x' "foobar" == "foobar"
950−-- "foobar"
951justifyLeft :: Int -> Char -> Text -> Text
797justifyLeft :: Int -> Char -> Text -> Text
952−justifyLeft = coerce JSS.justifyLeft
798+justifyLeft k c t
953−-- justifyLeft k c t
954−-- | len >= k = t
799+ | len >= k = t
955−-- | otherwise = t `append` replicateChar (k-len) c
800+ | otherwise = t `append` replicateChar (k-len) c
956−-- where len = length t
801+ where len = length t
957{-# INLINE [1] justifyLeft #-}
802{-# INLINE [1] justifyLeft #-}
958
803
959{-# RULES
804{-# RULES
@@ -969,17 +814,13 @@ justifyLeft = coerce JSS.justifyLeft
969--
814--
970-- Examples:
815-- Examples:
971--
816--
972−-- >>> justifyRight 7 'x' "bar"
817+-- > justifyRight 7 'x' "bar" == "xxxxbar"
973−-- "xxxxbar"
974−--
975−-- >>> justifyRight 3 'x' "foobar"
818+-- > justifyRight 3 'x' "foobar" == "foobar"
976−-- "foobar"
977justifyRight :: Int -> Char -> Text -> Text
819justifyRight :: Int -> Char -> Text -> Text
978−justifyRight = coerce JSS.justifyRight
820+justifyRight k c t
979−-- justifyRight k c t
980−-- | len >= k = t
821+ | len >= k = t
981−-- | otherwise = replicateChar (k-len) c `append` t
822+ | otherwise = replicateChar (k-len) c `append` t
982−-- where len = length t
823+ where len = length t
983{-# INLINE justifyRight #-}
824{-# INLINE justifyRight #-}
984
825
985-- | /O(n)/ Center a string to the given length, using the specified
826-- | /O(n)/ Center a string to the given length, using the specified
@@ -988,34 +829,23 @@ justifyRight = coerce JSS.justifyRight
988--
829--
989-- Examples:
830-- Examples:
990--
831--
991−-- >>> center 8 'x' "HS"
832+-- > center 8 'x' "HS" = "xxxHSxxx"
992−-- "xxxHSxxx"
993center :: Int -> Char -> Text -> Text
833center :: Int -> Char -> Text -> Text
994−center = coerce JSS.center
834+center k c t
995−-- center k c t
996−-- | len >= k = t
835+ | len >= k = t
997−-- | otherwise = replicateChar l c `append` t `append` replicateChar r c
836+ | otherwise = replicateChar l c `append` t `append` replicateChar r c
998−-- where len = length t
837+ where len = length t
999−-- d = k - len
838+ d = k - len
1000−-- r = d `quot` 2
839+ r = d `quot` 2
1001−-- l = d - r
840+ l = d - r
1002{-# INLINE center #-}
841{-# INLINE center #-}
1003
842
1004-- | /O(n)/ The 'transpose' function transposes the rows and columns
843-- | /O(n)/ The 'transpose' function transposes the rows and columns
1005-- of its 'Text' argument. Note that this function uses 'pack',
844-- of its 'Text' argument. Note that this function uses 'pack',
1006-- 'unpack', and the list version of transpose, and is thus not very
845-- 'unpack', and the list version of transpose, and is thus not very
1007-- efficient.
846-- 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"]
1016transpose :: [Text] -> [Text]
847transpose :: [Text] -> [Text]
1017−transpose = coerce JSS.transpose
1018−-- transpose ts = P.map pack (L.transpose (P.map unpack ts))
848+transpose ts = P.map pack (L.transpose (P.map unpack ts))
1019
849
1020-- -----------------------------------------------------------------------------
850-- -----------------------------------------------------------------------------
1021-- * Reducing 'Text's (folds)
851-- * Reducing 'Text's (folds)
@@ -1025,27 +855,23 @@ transpose = coerce JSS.transpose
1025-- reduces the 'Text' using the binary operator, from left to right.
855-- reduces the 'Text' using the binary operator, from left to right.
1026-- Subject to fusion.
856-- Subject to fusion.
1027foldl :: (a -> Char -> a) -> a -> Text -> a
857foldl :: (a -> Char -> a) -> a -> Text -> a
1028−foldl f a0 (Text t) = JSS.foldl f a0 t
1029−-- foldl f z t = S.foldl f z (stream t)
858+foldl f z t = S.foldl f z (stream t)
1030{-# INLINE foldl #-}
859{-# INLINE foldl #-}
1031
860
1032-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.
861-- | /O(n)/ A strict version of 'foldl'. Subject to fusion.
1033foldl' :: (a -> Char -> a) -> a -> Text -> a
862foldl' :: (a -> Char -> a) -> a -> Text -> a
1034−foldl' f a0 (Text t) = JSS.foldl' f a0 t
1035−-- foldl' f z t = S.foldl' f z (stream t)
863+foldl' f z t = S.foldl' f z (stream t)
1036{-# INLINE foldl' #-}
864{-# INLINE foldl' #-}
1037
865
1038-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
866-- | /O(n)/ A variant of 'foldl' that has no starting value argument,
1039-- and thus must be applied to a non-empty 'Text'. Subject to fusion.
867-- and thus must be applied to a non-empty 'Text'. Subject to fusion.
1040foldl1 :: (Char -> Char -> Char) -> Text -> Char
868foldl1 :: (Char -> Char -> Char) -> Text -> Char
1041−foldl1 = coerce JSS.foldl1
1042−-- foldl1 f t = S.foldl1 f (stream t)
869+foldl1 f t = S.foldl1 f (stream t)
1043{-# INLINE foldl1 #-}
870{-# INLINE foldl1 #-}
1044
871
1045-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.
872-- | /O(n)/ A strict version of 'foldl1'. Subject to fusion.
1046foldl1' :: (Char -> Char -> Char) -> Text -> Char
873foldl1' :: (Char -> Char -> Char) -> Text -> Char
1047−foldl1' = coerce JSS.foldl1'
1048−-- foldl1' f t = S.foldl1' f (stream t)
874+foldl1' f t = S.foldl1' f (stream t)
1049{-# INLINE foldl1' #-}
875{-# INLINE foldl1' #-}
1050
876
1051-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
877-- | /O(n)/ 'foldr', applied to a binary operator, a starting value
@@ -1053,16 +879,14 @@ foldl1' = coerce JSS.foldl1'
1053-- reduces the 'Text' using the binary operator, from right to left.
879-- reduces the 'Text' using the binary operator, from right to left.
1054-- Subject to fusion.
880-- Subject to fusion.
1055foldr :: (Char -> a -> a) -> a -> Text -> a
881foldr :: (Char -> a -> a) -> a -> Text -> a
1056−foldr f a0 (Text t) = JSS.foldr f a0 t
1057−-- foldr f z t = S.foldr f z (stream t)
882+foldr f z t = S.foldr f z (stream t)
1058{-# INLINE foldr #-}
883{-# INLINE foldr #-}
1059
884
1060-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
885-- | /O(n)/ A variant of 'foldr' that has no starting value argument,
1061-- and thus must be applied to a non-empty 'Text'. Subject to
886-- and thus must be applied to a non-empty 'Text'. Subject to
1062-- fusion.
887-- fusion.
1063foldr1 :: (Char -> Char -> Char) -> Text -> Char
888foldr1 :: (Char -> Char -> Char) -> Text -> Char
1064−foldr1 = coerce JSS.foldr1
1065−-- foldr1 f t = S.foldr1 f (stream t)
889+foldr1 f t = S.foldr1 f (stream t)
1066{-# INLINE foldr1 #-}
890{-# INLINE foldr1 #-}
1067
891
1068-- -----------------------------------------------------------------------------
892-- -----------------------------------------------------------------------------
@@ -1070,54 +894,48 @@ foldr1 = coerce JSS.foldr1
1070
894
1071-- | /O(n)/ Concatenate a list of 'Text's.
895-- | /O(n)/ Concatenate a list of 'Text's.
1072concat :: [Text] -> Text
896concat :: [Text] -> Text
1073−concat = coerce JSS.concat
1074−-- concat ts = case ts' of
897+concat ts = case ts' of
1075−-- [] -> empty
898+ [] -> empty
1076−-- [t] -> t
899+ [t] -> t
1077−-- _ -> Text (A.run go) 0 len
900+ _ -> Text (A.run go) 0 len
1078−-- where
901+ where
1079−-- ts' = L.filter (not . null) ts
902+ ts' = L.filter (not . null) ts
1080−-- len = sumP "concat" $ L.map lengthWord16 ts'
903+ len = sumP "concat" $ L.map lengthWord16 ts'
1081−-- go :: ST s (A.MArray s)
904+ go :: ST s (A.MArray s)
1082−-- go = do
905+ go = do
1083−-- arr <- A.new len
906+ arr <- A.new len
1084−-- let step i (Text a o l) =
907+ let step i (Text a o l) =
1085−-- let !j = i + l in A.copyI arr i a o j >> return j
908+ let !j = i + l in A.copyI arr i a o j >> return j
1086−-- foldM step 0 ts' >> return arr
909+ foldM step 0 ts' >> return arr
1087
910
1088-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
911-- | /O(n)/ Map a function over a 'Text' that results in a 'Text', and
1089-- concatenate the results.
912-- concatenate the results.
1090concatMap :: (Char -> Text) -> Text -> Text
913concatMap :: (Char -> Text) -> Text -> Text
1091−concatMap = coerce JSS.concatMap
1092−-- concatMap f = concat . foldr ((:) . f) []
914+concatMap f = concat . foldr ((:) . f) []
1093{-# INLINE concatMap #-}
915{-# INLINE concatMap #-}
1094
916
1095-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
917-- | /O(n)/ 'any' @p@ @t@ determines whether any character in the
1096-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
918-- 'Text' @t@ satisfies the predicate @p@. Subject to fusion.
1097any :: (Char -> Bool) -> Text -> Bool
919any :: (Char -> Bool) -> Text -> Bool
1098−any = coerce JSS.any
1099−-- any p t = S.any p (stream t)
920+any p t = S.any p (stream t)
1100{-# INLINE any #-}
921{-# INLINE any #-}
1101
922
1102-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
923-- | /O(n)/ 'all' @p@ @t@ determines whether all characters in the
1103-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
924-- 'Text' @t@ satisfy the predicate @p@. Subject to fusion.
1104all :: (Char -> Bool) -> Text -> Bool
925all :: (Char -> Bool) -> Text -> Bool
1105−all = coerce JSS.all
1106−-- all p t = S.all p (stream t)
926+all p t = S.all p (stream t)
1107{-# INLINE all #-}
927{-# INLINE all #-}
1108
928
1109-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
929-- | /O(n)/ 'maximum' returns the maximum value from a 'Text', which
1110-- must be non-empty. Subject to fusion.
930-- must be non-empty. Subject to fusion.
1111maximum :: Text -> Char
931maximum :: Text -> Char
1112−maximum = coerce JSS.maximum
1113−-- maximum t = S.maximum (stream t)
932+maximum t = S.maximum (stream t)
1114{-# INLINE maximum #-}
933{-# INLINE maximum #-}
1115
934
1116-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
935-- | /O(n)/ 'minimum' returns the minimum value from a 'Text', which
1117-- must be non-empty. Subject to fusion.
936-- must be non-empty. Subject to fusion.
1118minimum :: Text -> Char
937minimum :: Text -> Char
1119−minimum = coerce JSS.minimum
1120−-- minimum t = S.minimum (stream t)
938+minimum t = S.minimum (stream t)
1121{-# INLINE minimum #-}
939{-# INLINE minimum #-}
1122
940
1123-- -----------------------------------------------------------------------------
941-- -----------------------------------------------------------------------------
@@ -1133,9 +951,8 @@ minimum = coerce JSS.minimum
1133--
951--
1134-- > last (scanl f z xs) == foldl f z xs.
952-- > last (scanl f z xs) == foldl f z xs.
1135scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
953scanl :: (Char -> Char -> Char) -> Char -> Text -> Text
1136−scanl = coerce JSS.scanl
1137−-- scanl f z t = unstream (S.scanl g z (stream t))
954+scanl f z t = unstream (S.scanl g z (stream t))
1138−-- where g a b = safe (f a b)
955+ where g a b = safe (f a b)
1139{-# INLINE scanl #-}
956{-# INLINE scanl #-}
1140
957
1141-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
958-- | /O(n)/ 'scanl1' is a variant of 'scanl' that has no starting
@@ -1144,9 +961,8 @@ scanl = coerce JSS.scanl
1144--
961--
1145-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
962-- > scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
1146scanl1 :: (Char -> Char -> Char) -> Text -> Text
963scanl1 :: (Char -> Char -> Char) -> Text -> Text
1147−scanl1 = coerce JSS.scanl1
1148−-- scanl1 f t | null t = empty
964+scanl1 f t | null t = empty
1149−-- | otherwise = scanl f (unsafeHead t) (unsafeTail t)
965+ | otherwise = scanl f (unsafeHead t) (unsafeTail t)
1150{-# INLINE scanl1 #-}
966{-# INLINE scanl1 #-}
1151
967
1152-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
968-- | /O(n)/ 'scanr' is the right-to-left dual of 'scanl'. Performs
@@ -1154,18 +970,16 @@ scanl1 = coerce JSS.scanl1
1154--
970--
1155-- > scanr f v == reverse . scanl (flip f) v . reverse
971-- > scanr f v == reverse . scanl (flip f) v . reverse
1156scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
972scanr :: (Char -> Char -> Char) -> Char -> Text -> Text
1157−scanr = coerce JSS.scanr
1158−-- scanr f z = S.reverse . S.reverseScanr g z . reverseStream
973+scanr f z = S.reverse . S.reverseScanr g z . reverseStream
1159−-- where g a b = safe (f a b)
974+ where g a b = safe (f a b)
1160{-# INLINE scanr #-}
975{-# INLINE scanr #-}
1161
976
1162-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
977-- | /O(n)/ 'scanr1' is a variant of 'scanr' that has no starting
1163-- value argument. Subject to fusion. Performs replacement on
978-- value argument. Subject to fusion. Performs replacement on
1164-- invalid scalar values.
979-- invalid scalar values.
1165scanr1 :: (Char -> Char -> Char) -> Text -> Text
980scanr1 :: (Char -> Char -> Char) -> Text -> Text
1166−scanr1 = coerce JSS.scanr1
1167−-- scanr1 f t | null t = empty
981+scanr1 f t | null t = empty
1168−-- | otherwise = scanr f (last t) (init t)
982+ | otherwise = scanr f (last t) (init t)
1169{-# INLINE scanr1 #-}
983{-# INLINE scanr1 #-}
1170
984
1171-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
985-- | /O(n)/ Like a combination of 'map' and 'foldl''. Applies a
@@ -1173,11 +987,8 @@ scanr1 = coerce JSS.scanr1
1173-- parameter from left to right, and returns a final 'Text'. Performs
987-- parameter from left to right, and returns a final 'Text'. Performs
1174-- replacement on invalid scalar values.
988-- replacement on invalid scalar values.
1175mapAccumL :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
989mapAccumL :: (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)
1179−-- mapAccumL f z0 = S.mapAccumL g z0 . stream
990+mapAccumL f z0 = S.mapAccumL g z0 . stream
1180−-- where g a b = second safe (f a b)
991+ where g a b = second safe (f a b)
1181{-# INLINE mapAccumL #-}
992{-# INLINE mapAccumL #-}
1182
993
1183-- | The 'mapAccumR' function behaves like a combination of 'map' and
994-- | The 'mapAccumR' function behaves like a combination of 'map' and
@@ -1187,11 +998,8 @@ mapAccumL f z0 (Text a) =
1187-- 'Text'.
998-- 'Text'.
1188-- Performs replacement on invalid scalar values.
999-- Performs replacement on invalid scalar values.
1189mapAccumR :: (a -> Char -> (a,Char)) -> a -> Text -> (a, Text)
1000mapAccumR :: (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)
1193−-- mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1001+mapAccumR f z0 = second reverse . S.mapAccumL g z0 . reverseStream
1194−-- where g a b = second safe (f a b)
1002+ where g a b = second safe (f a b)
1195{-# INLINE mapAccumR #-}
1003{-# INLINE mapAccumR #-}
1196
1004
1197-- -----------------------------------------------------------------------------
1005-- -----------------------------------------------------------------------------
@@ -1200,21 +1008,20 @@ mapAccumR f z0 (Text a) =
1200-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
1008-- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input
1201-- @t@ repeated @n@ times.
1009-- @t@ repeated @n@ times.
1202replicate :: Int -> Text -> Text
1010replicate :: Int -> Text -> Text
1203−replicate = coerce JSS.replicate
1204−-- replicate n t@(Text a o l)
1011+replicate n t@(Text a o l)
1205−-- | n <= 0 || l <= 0 = empty
1012+ | n <= 0 || l <= 0 = empty
1206−-- | n == 1 = t
1013+ | n == 1 = t
1207−-- | isSingleton t = replicateChar n (unsafeHead t)
1014+ | isSingleton t = replicateChar n (unsafeHead t)
1208−-- | otherwise = Text (A.run x) 0 len
1015+ | otherwise = Text (A.run x) 0 len
1209−-- where
1016+ where
1210−-- len = l `mul` n
1017+ len = l `mul` n
1211−-- x :: ST s (A.MArray s)
1018+ x :: ST s (A.MArray s)
1212−-- x = do
1019+ x = do
1213−-- arr <- A.new len
1020+ arr <- A.new len
1214−-- let loop !d !i | i >= n = return arr
1021+ let loop !d !i | i >= n = return arr
1215−-- | otherwise = let m = d + l
1022+ | otherwise = let m = d + l
1216−-- in A.copyI arr d a o m >> loop m (i+1)
1023+ in A.copyI arr d a o m >> loop m (i+1)
1217−-- loop 0 0
1024+ loop 0 0
1218{-# INLINE [1] replicate #-}
1025{-# INLINE [1] replicate #-}
1219
1026
1220{-# RULES
1027{-# RULES
@@ -1225,19 +1032,8 @@ replicate = coerce JSS.replicate
1225-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1032-- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the
1226-- value of every element. Subject to fusion.
1033-- value of every element. Subject to fusion.
1227replicateChar :: Int -> Char -> Text
1034replicateChar :: Int -> Char -> Text
1228−#ifndef __GHCJS__
1229replicateChar n c = unstream (S.replicateCharI n (safe c))
1035replicateChar n c = unstream (S.replicateCharI n (safe c))
1230{-# INLINE replicateChar #-}
1036{-# 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
1241
1037
1242-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
1038-- | /O(n)/, where @n@ is the length of the result. The 'unfoldr'
1243-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
1039-- function is analogous to the List 'L.unfoldr'. 'unfoldr' builds a
@@ -1247,8 +1043,7 @@ replicateChar n c = Text $ js_replicateChar n c
1247-- string, and @b@ is the seed value for further production. Subject
1043-- string, and @b@ is the seed value for further production. Subject
1248-- to fusion. Performs replacement on invalid scalar values.
1044-- to fusion. Performs replacement on invalid scalar values.
1249unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1045unfoldr :: (a -> Maybe (Char,a)) -> a -> Text
1250−unfoldr f a = Text $ JSS.unfoldr f a
1251−-- unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1046+unfoldr f s = unstream (S.unfoldr (firstf safe . f) s)
1252{-# INLINE unfoldr #-}
1047{-# INLINE unfoldr #-}
1253
1048
1254-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
1049-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a 'Text' from a seed
@@ -1258,8 +1053,7 @@ unfoldr f a = Text $ JSS.unfoldr f a
1258-- correct, otherwise its performance is similar to 'unfoldr'. Subject
1053-- correct, otherwise its performance is similar to 'unfoldr'. Subject
1259-- to fusion. Performs replacement on invalid scalar values.
1054-- to fusion. Performs replacement on invalid scalar values.
1260unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
1055unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Text
1261−unfoldrN n f a0 = Text $ JSS.unfoldrN n f a0
1262−-- unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)
1056+unfoldrN n f s = unstream (S.unfoldrN n (firstf safe . f) s)
1263{-# INLINE unfoldrN #-}
1057{-# INLINE unfoldrN #-}
1264
1058
1265-- -----------------------------------------------------------------------------
1059-- -----------------------------------------------------------------------------
@@ -1269,19 +1063,18 @@ unfoldrN n f a0 = Text $ JSS.unfoldrN n f a0
1269-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than
1063-- 'Text' of length @n@, or the 'Text' itself if @n@ is greater than
1270-- the length of the Text. Subject to fusion.
1064-- the length of the Text. Subject to fusion.
1271take :: Int -> Text -> Text
1065take :: Int -> Text -> Text
1272−take = coerce JSS.take
1273−-- take n t@(Text arr off len)
1066+take n t@(Text arr off len)
1274−-- | n <= 0 = empty
1067+ | n <= 0 = empty
1275−-- | n >= len = t
1068+ | n >= len = t
1276−-- | otherwise = text arr off (iterN n t)
1069+ | otherwise = text arr off (iterN n t)
1277{-# INLINE [1] take #-}
1070{-# INLINE [1] take #-}
1278
1071
1279−-- iterN :: Int -> Text -> Int
1072+iterN :: Int -> Text -> Int
1280−-- iterN n t@(Text _arr _off len) = loop 0 0
1073+iterN n t@(Text _arr _off len) = loop 0 0
1281−-- where loop !i !cnt
1074+ where loop !i !cnt
1282−-- | i >= len || cnt >= n = i
1075+ | i >= len || cnt >= n = i
1283−-- | otherwise = loop (i+d) (cnt+1)
1076+ | otherwise = loop (i+d) (cnt+1)
1284−-- where d = iter_ t i
1077+ where d = iter_ t i
1285
1078
1286{-# RULES
1079{-# RULES
1287"TEXT take -> fused" [~1] forall n t.
1080"TEXT take -> fused" [~1] forall n t.
@@ -1295,36 +1088,31 @@ take = coerce JSS.take
1295--
1088--
1296-- Examples:
1089-- Examples:
1297--
1090--
1298−-- >>> takeEnd 3 "foobar"
1091+-- > takeEnd 3 "foobar" == "bar"
1299−-- "bar"
1300−--
1301−-- @since 1.1.1.0
1302takeEnd :: Int -> Text -> Text
1092takeEnd :: Int -> Text -> Text
1303−takeEnd = coerce JSS.takeEnd
1304−-- takeEnd n t@(Text arr off len)
1093+takeEnd n t@(Text arr off len)
1305−-- | n <= 0 = empty
1094+ | n <= 0 = empty
1306−-- | n >= len = t
1095+ | n >= len = t
1307−-- | otherwise = text arr (off+i) (len-i)
1096+ | otherwise = text arr (off+i) (len-i)
1308−-- where i = iterNEnd n t
1097+ where i = iterNEnd n t
1309−
1098+
1310−-- iterNEnd :: Int -> Text -> Int
1099+iterNEnd :: Int -> Text -> Int
1311−-- iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1100+iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1312−-- where loop i !m
1101+ where loop i !m
1313−-- | i <= 0 = 0
1102+ | i <= 0 = 0
1314−-- | m <= 1 = i
1103+ | m <= 1 = i
1315−-- | otherwise = loop (i+d) (m-1)
1104+ | otherwise = loop (i+d) (m-1)
1316−-- where d = reverseIter_ t i
1105+ where d = reverseIter_ t i
1317
1106
1318-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1107-- | /O(n)/ 'drop' @n@, applied to a 'Text', returns the suffix of the
1319-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1108-- 'Text' after the first @n@ characters, or the empty 'Text' if @n@
1320-- is greater than the length of the 'Text'. Subject to fusion.
1109-- is greater than the length of the 'Text'. Subject to fusion.
1321drop :: Int -> Text -> Text
1110drop :: Int -> Text -> Text
1322−drop = coerce JSS.drop
1323−-- drop n t@(Text arr off len)
1111+drop n t@(Text arr off len)
1324−-- | n <= 0 = t
1112+ | n <= 0 = t
1325−-- | n >= len = empty
1113+ | n >= len = empty
1326−-- | otherwise = text arr (off+i) (len-i)
1114+ | otherwise = text arr (off+i) (len-i)
1327−-- where i = iterN n t
1115+ where i = iterN n t
1328{-# INLINE [1] drop #-}
1116{-# INLINE [1] drop #-}
1329
1117
1330{-# RULES
1118{-# RULES
@@ -1339,27 +1127,22 @@ drop = coerce JSS.drop
1339--
1127--
1340-- Examples:
1128-- Examples:
1341--
1129--
1342−-- >>> dropEnd 3 "foobar"
1130+-- > dropEnd 3 "foobar" == "foo"
1343−-- "foo"
1344−--
1345−-- @since 1.1.1.0
1346dropEnd :: Int -> Text -> Text
1131dropEnd :: Int -> Text -> Text
1347−dropEnd = coerce JSS.dropEnd
1348−-- dropEnd n t@(Text arr off len)
1132+dropEnd n t@(Text arr off len)
1349−-- | n <= 0 = t
1133+ | n <= 0 = t
1350−-- | n >= len = empty
1134+ | n >= len = empty
1351−-- | otherwise = text arr off (iterNEnd n t)
1135+ | otherwise = text arr off (iterNEnd n t)
1352
1136
1353-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1137-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1354-- returns the longest prefix (possibly empty) of elements that
1138-- returns the longest prefix (possibly empty) of elements that
1355-- satisfy @p@. Subject to fusion.
1139-- satisfy @p@. Subject to fusion.
1356takeWhile :: (Char -> Bool) -> Text -> Text
1140takeWhile :: (Char -> Bool) -> Text -> Text
1357−takeWhile = coerce JSS.takeWhile
1358−-- takeWhile p t@(Text arr off len) = loop 0
1141+takeWhile p t@(Text arr off len) = loop 0
1359−-- where loop !i | i >= len = t
1142+ where loop !i | i >= len = t
1360−-- | p c = loop (i+d)
1143+ | p c = loop (i+d)
1361−-- | otherwise = text arr off i
1144+ | otherwise = text arr off i
1362−-- where Iter c d = iter t i
1145+ where Iter c d = iter t i
1363{-# INLINE [1] takeWhile #-}
1146{-# INLINE [1] takeWhile #-}
1364
1147
1365{-# RULES
1148{-# RULES
@@ -1374,25 +1157,13 @@ takeWhile = coerce JSS.takeWhile
1374-- satisfy @p@. Subject to fusion.
1157-- satisfy @p@. Subject to fusion.
1375-- Examples:
1158-- Examples:
1376--
1159--
1377−-- >>> takeWhileEnd (=='o') "foo"
1160+-- > takeWhileEnd (=='o') "foo" == "oo"
1378−-- "oo"
1379−--
1380−-- @since 1.2.2.0
1381takeWhileEnd :: (Char -> Bool) -> Text -> Text
1161takeWhileEnd :: (Char -> Bool) -> Text -> Text
1382−#ifndef __GHCJS__
1383takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1162takeWhileEnd p t@(Text arr off len) = loop (len-1) len
1384 where loop !i !l | l <= 0 = t
1163 where loop !i !l | l <= 0 = t
1385 | p c = loop (i+d) (l+d)
1164 | p c = loop (i+d) (l+d)
1386 | otherwise = text arr (off+l) (len-l)
1165 | otherwise = text arr (off+l) (len-l)
1387 where (c,d) = reverseIter t i
1166 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
1396{-# INLINE [1] takeWhileEnd #-}
1167{-# INLINE [1] takeWhileEnd #-}
1397
1168
1398{-# RULES
1169{-# RULES
@@ -1405,12 +1176,11 @@ takeWhileEnd p t@(Text jst) = loop (len-1) len
1405-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1176-- | /O(n)/ 'dropWhile' @p@ @t@ returns the suffix remaining after
1406-- 'takeWhile' @p@ @t@. Subject to fusion.
1177-- 'takeWhile' @p@ @t@. Subject to fusion.
1407dropWhile :: (Char -> Bool) -> Text -> Text
1178dropWhile :: (Char -> Bool) -> Text -> Text
1408−dropWhile = coerce JSS.dropWhile
1409−-- dropWhile p t@(Text arr off len) = loop 0 0
1179+dropWhile p t@(Text arr off len) = loop 0 0
1410−-- where loop !i !l | l >= len = empty
1180+ where loop !i !l | l >= len = empty
1411−-- | p c = loop (i+d) (l+d)
1181+ | p c = loop (i+d) (l+d)
1412−-- | otherwise = Text arr (off+i) (len-l)
1182+ | otherwise = Text arr (off+i) (len-l)
1413−
1183+ where Iter c d = iter t i
1414{-# INLINE [1] dropWhile #-}
1184{-# INLINE [1] dropWhile #-}
1415
1185
1416{-# RULES
1186{-# RULES
@@ -1426,15 +1196,13 @@ dropWhile = coerce JSS.dropWhile
1426--
1196--
1427-- Examples:
1197-- Examples:
1428--
1198--
1429−-- >>> dropWhileEnd (=='.') "foo..."
1199+-- > dropWhileEnd (=='.') "foo..." == "foo"
1430−-- "foo"
1431dropWhileEnd :: (Char -> Bool) -> Text -> Text
1200dropWhileEnd :: (Char -> Bool) -> Text -> Text
1432−dropWhileEnd = coerce JSS.dropWhileEnd
1433−-- dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1201+dropWhileEnd p t@(Text arr off len) = loop (len-1) len
1434−-- where loop !i !l | l <= 0 = empty
1202+ where loop !i !l | l <= 0 = empty
1435−-- | p c = loop (i+d) (l+d)
1203+ | p c = loop (i+d) (l+d)
1436−-- | otherwise = Text arr off l
1204+ | otherwise = Text arr off l
1437−-- where (c,d) = reverseIter t i
1205+ where (c,d) = reverseIter t i
1438{-# INLINE [1] dropWhileEnd #-}
1206{-# INLINE [1] dropWhileEnd #-}
1439
1207
1440{-# RULES
1208{-# RULES
@@ -1477,49 +1245,45 @@ strip = dropAround isSpace
1477-- prefix of @t@ of length @n@, and whose second is the remainder of
1245-- prefix of @t@ of length @n@, and whose second is the remainder of
1478-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
1246-- the string. It is equivalent to @('take' n t, 'drop' n t)@.
1479splitAt :: Int -> Text -> (Text, Text)
1247splitAt :: Int -> Text -> (Text, Text)
1480−splitAt = coerce JSS.splitAt
1481−-- splitAt n t@(Text arr off len)
1248+splitAt n t@(Text arr off len)
1482−-- | n <= 0 = (empty, t)
1249+ | n <= 0 = (empty, t)
1483−-- | n >= len = (t, empty)
1250+ | n >= len = (t, empty)
1484−-- | otherwise = let k = iterN n t
1251+ | otherwise = let k = iterN n t
1485−-- in (text arr off k, text arr (off+k) (len-k))
1252+ in (text arr off k, text arr (off+k) (len-k))
1486
1253
1487-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1254-- | /O(n)/ 'span', applied to a predicate @p@ and text @t@, returns
1488-- a pair whose first element is the longest prefix (possibly empty)
1255-- a pair whose first element is the longest prefix (possibly empty)
1489-- of @t@ of elements that satisfy @p@, and whose second is the
1256-- of @t@ of elements that satisfy @p@, and whose second is the
1490-- remainder of the list.
1257-- remainder of the list.
1491span :: (Char -> Bool) -> Text -> (Text, Text)
1258span :: (Char -> Bool) -> Text -> (Text, Text)
1492−span = coerce JSS.span
1493−-- span p t = case span_ p t of
1259+span p t = case span_ p t of
1494−-- (# hd,tl #) -> (hd,tl)
1260+ (# hd,tl #) -> (hd,tl)
1495{-# INLINE span #-}
1261{-# INLINE span #-}
1496
1262
1497-- | /O(n)/ 'break' is like 'span', but the prefix returned is
1263-- | /O(n)/ 'break' is like 'span', but the prefix returned is
1498-- over elements that fail the predicate @p@.
1264-- over elements that fail the predicate @p@.
1499break :: (Char -> Bool) -> Text -> (Text, Text)
1265break :: (Char -> Bool) -> Text -> (Text, Text)
1500−break = coerce JSS.break
1501−-- break p = span (not . p)
1266+break p = span (not . p)
1502{-# INLINE break #-}
1267{-# INLINE break #-}
1503
1268
1504-- | /O(n)/ Group characters in a string according to a predicate.
1269-- | /O(n)/ Group characters in a string according to a predicate.
1505groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
1270groupBy :: (Char -> Char -> Bool) -> Text -> [Text]
1506−groupBy = coerce JSS.groupBy
1507−-- groupBy p = loop
1271+groupBy p = loop
1508−-- where
1272+ where
1509−-- loop t@(Text arr off len)
1273+ loop t@(Text arr off len)
1510−-- | null t = []
1274+ | null t = []
1511−-- | otherwise = text arr off n : loop (text arr (off+n) (len-n))
1275+ | otherwise = text arr off n : loop (text arr (off+n) (len-n))
1512−-- where Iter c d = iter t 0
1276+ where Iter c d = iter t 0
1513−-- n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
1277+ n = d + findAIndexOrEnd (not . p c) (Text arr (off+d) (len-d))
1514
1278
1515-- | Returns the /array/ index (in units of 'Word16') at which a
1279-- | Returns the /array/ index (in units of 'Word16') at which a
1516-- character may be found. This is /not/ the same as the logical
1280-- character may be found. This is /not/ the same as the logical
1517-- index returned by e.g. 'findIndex'.
1281-- index returned by e.g. 'findIndex'.
1518−-- findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
1282+findAIndexOrEnd :: (Char -> Bool) -> Text -> Int
1519−-- findAIndexOrEnd q t@(Text _arr _off len) = go 0
1283+findAIndexOrEnd q t@(Text _arr _off len) = go 0
1520−-- where go !i | i >= len || q c = i
1284+ where go !i | i >= len || q c = i
1521−-- | otherwise = go (i+d)
1285+ | otherwise = go (i+d)
1522−-- where Iter c d = iter t i
1286+ where Iter c d = iter t i
1523
1287
1524-- | /O(n)/ Group characters in a string by equality.
1288-- | /O(n)/ Group characters in a string by equality.
1525group :: Text -> [Text]
1289group :: Text -> [Text]
@@ -1528,17 +1292,15 @@ group = groupBy (==)
1528-- | /O(n)/ Return all initial segments of the given 'Text', shortest
1292-- | /O(n)/ Return all initial segments of the given 'Text', shortest
1529-- first.
1293-- first.
1530inits :: Text -> [Text]
1294inits :: Text -> [Text]
1531−inits = coerce JSS.inits
1532−-- inits t@(Text arr off len) = loop 0
1295+inits t@(Text arr off len) = loop 0
1533−-- where loop i | i >= len = [t]
1296+ where loop i | i >= len = [t]
1534−-- | otherwise = Text arr off i : loop (i + iter_ t i)
1297+ | otherwise = Text arr off i : loop (i + iter_ t i)
1535
1298
1536-- | /O(n)/ Return all final segments of the given 'Text', longest
1299-- | /O(n)/ Return all final segments of the given 'Text', longest
1537-- first.
1300-- first.
1538tails :: Text -> [Text]
1301tails :: Text -> [Text]
1539−tails = coerce JSS.tails
1540−-- tails t | null t = [empty]
1302+tails t | null t = [empty]
1541−-- | otherwise = t : tails (unsafeTail t)
1303+ | otherwise = t : tails (unsafeTail t)
1542
1304
1543-- $split
1305-- $split
1544--
1306--
@@ -1552,14 +1314,9 @@ tails = coerce JSS.tails
1552--
1314--
1553-- Examples:
1315-- Examples:
1554--
1316--
1555−-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne"
1317+-- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"]
1556−-- ["a","b","d","e"]
1557−--
1558−-- >>> splitOn "aaa" "aaaXaaaXaaaXaaa"
1318+-- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""]
1559−-- ["","X","X","X",""]
1560−--
1561−-- >>> splitOn "x" "x"
1319+-- > splitOn "x" "x" == ["",""]
1562−-- ["",""]
1563--
1320--
1564-- and
1321-- and
1565--
1322--
@@ -1576,14 +1333,13 @@ splitOn :: Text
1576 -> Text
1333 -> Text
1577 -- ^ Input text.
1334 -- ^ Input text.
1578 -> [Text]
1335 -> [Text]
1579−splitOn = coerce JSS.splitOn
1580−-- splitOn pat@(Text _ _ l) src@(Text arr off len)
1336+splitOn pat@(Text _ _ l) src@(Text arr off len)
1581−-- | l <= 0 = emptyError "splitOn"
1337+ | l <= 0 = emptyError "splitOn"
1582−-- | isSingleton pat = split (== unsafeHead pat) src
1338+ | isSingleton pat = split (== unsafeHead pat) src
1583−-- | otherwise = go 0 (indices pat src)
1339+ | otherwise = go 0 (indices pat src)
1584−-- where
1340+ where
1585−-- go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1341+ go !s (x:xs) = text arr (s+off) (x-s) : go (x+l) xs
1586−-- go s _ = [text arr (s+off) (len-s)]
1342+ go s _ = [text arr (s+off) (len-s)]
1587{-# INLINE [1] splitOn #-}
1343{-# INLINE [1] splitOn #-}
1588
1344
1589{-# RULES
1345{-# RULES
@@ -1596,36 +1352,28 @@ splitOn = coerce JSS.splitOn
1596-- resulting components do not contain the separators. Two adjacent
1352-- resulting components do not contain the separators. Two adjacent
1597-- separators result in an empty component in the output. eg.
1353-- separators result in an empty component in the output. eg.
1598--
1354--
1599−-- >>> split (=='a') "aabbaca"
1355+-- > split (=='a') "aabbaca" == ["","","bb","c",""]
1600−-- ["","","bb","c",""]
1601−--
1602−-- >>> split (=='a') ""
1356+-- > split (=='a') "" == [""]
1603−-- [""]
1604split :: (Char -> Bool) -> Text -> [Text]
1357split :: (Char -> Bool) -> Text -> [Text]
1605−split = coerce JSS.split
1606−-- split _ t@(Text _off _arr 0) = [t]
1358+split _ t@(Text _off _arr 0) = [t]
1607−-- split p t = loop t
1359+split p t = loop t
1608−-- where loop s | null s' = [l]
1360+ where loop s | null s' = [l]
1609−-- | otherwise = l : loop (unsafeTail s')
1361+ | otherwise = l : loop (unsafeTail s')
1610−-- where (# l, s' #) = span_ (not . p) s
1362+ where (# l, s' #) = span_ (not . p) s
1611{-# INLINE split #-}
1363{-# INLINE split #-}
1612
1364
1613-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1365-- | /O(n)/ Splits a 'Text' into components of length @k@. The last
1614-- element may be shorter than the other chunks, depending on the
1366-- element may be shorter than the other chunks, depending on the
1615-- length of the input. Examples:
1367-- length of the input. Examples:
1616--
1368--
1617−-- >>> chunksOf 3 "foobarbaz"
1369+-- > chunksOf 3 "foobarbaz" == ["foo","bar","baz"]
1618−-- ["foo","bar","baz"]
1619−--
1620−-- >>> chunksOf 4 "haskell.org"
1370+-- > chunksOf 4 "haskell.org" == ["hask","ell.","org"]
1621−-- ["hask","ell.","org"]
1622chunksOf :: Int -> Text -> [Text]
1371chunksOf :: Int -> Text -> [Text]
1623−chunksOf = coerce JSS.chunksOf
1372+chunksOf k = go
1624−-- chunksOf k = go
1625−-- where
1373+ where
1626−-- go t = case splitAt k t of
1374+ go t = case splitAt k t of
1627−-- (a,b) | null a -> []
1375+ (a,b) | null a -> []
1628−-- | otherwise -> a : go b
1376+ | otherwise -> a : go b
1629{-# INLINE chunksOf #-}
1377{-# INLINE chunksOf #-}
1630
1378
1631-- ----------------------------------------------------------------------------
1379-- ----------------------------------------------------------------------------
@@ -1638,8 +1386,7 @@ chunksOf = coerce JSS.chunksOf
1638-- returns the first element matching the predicate, or 'Nothing' if
1386-- returns the first element matching the predicate, or 'Nothing' if
1639-- there is no such element.
1387-- there is no such element.
1640find :: (Char -> Bool) -> Text -> Maybe Char
1388find :: (Char -> Bool) -> Text -> Maybe Char
1641−find = coerce JSS.find
1642−-- find p t = S.findBy p (stream t)
1389+find p t = S.findBy p (stream t)
1643{-# INLINE find #-}
1390{-# INLINE find #-}
1644
1391
1645-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
1392-- | /O(n)/ The 'partition' function takes a predicate and a 'Text',
@@ -1648,16 +1395,14 @@ find = coerce JSS.find
1648--
1395--
1649-- > partition p t == (filter p t, filter (not . p) t)
1396-- > partition p t == (filter p t, filter (not . p) t)
1650partition :: (Char -> Bool) -> Text -> (Text, Text)
1397partition :: (Char -> Bool) -> Text -> (Text, Text)
1651−partition = coerce JSS.partition
1652−-- partition p t = (filter p t, filter (not . p) t)
1398+partition p t = (filter p t, filter (not . p) t)
1653{-# INLINE partition #-}
1399{-# INLINE partition #-}
1654
1400
1655-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1401-- | /O(n)/ 'filter', applied to a predicate and a 'Text',
1656-- returns a 'Text' containing those characters that satisfy the
1402-- returns a 'Text' containing those characters that satisfy the
1657-- predicate.
1403-- predicate.
1658filter :: (Char -> Bool) -> Text -> Text
1404filter :: (Char -> Bool) -> Text -> Text
1659−filter = coerce JSS.filter
1660−-- filter p t = unstream (S.filter p (stream t))
1405+filter p t = unstream (S.filter p (stream t))
1661{-# INLINE filter #-}
1406{-# INLINE filter #-}
1662
1407
1663-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1408-- | /O(n+m)/ Find the first instance of @needle@ (which must be
@@ -1667,11 +1412,8 @@ filter = coerce JSS.filter
1667--
1412--
1668-- Examples:
1413-- Examples:
1669--
1414--
1670−-- >>> breakOn "::" "a::b::c"
1415+-- > breakOn "::" "a::b::c" ==> ("a", "::b::c")
1671−-- ("a","::b::c")
1672−--
1673−-- >>> breakOn "/" "foobar"
1416+-- > breakOn "/" "foobar" ==> ("foobar", "")
1674−-- ("foobar","")
1675--
1417--
1676-- Laws:
1418-- Laws:
1677--
1419--
@@ -1685,12 +1427,11 @@ filter = coerce JSS.filter
1685-- In (unlikely) bad cases, this function's time complexity degrades
1427-- In (unlikely) bad cases, this function's time complexity degrades
1686-- towards /O(n*m)/.
1428-- towards /O(n*m)/.
1687breakOn :: Text -> Text -> (Text, Text)
1429breakOn :: Text -> Text -> (Text, Text)
1688−breakOn = coerce JSS.breakOn
1689−-- breakOn pat src@(Text arr off len)
1430+breakOn pat src@(Text arr off len)
1690−-- | null pat = emptyError "breakOn"
1431+ | null pat = emptyError "breakOn"
1691−-- | otherwise = case indices pat src of
1432+ | otherwise = case indices pat src of
1692−-- [] -> (src, empty)
1433+ [] -> (src, empty)
1693−-- (x:_) -> (text arr off x, text arr (off+x) (len-x))
1434+ (x:_) -> (text arr off x, text arr (off+x) (len-x))
1694{-# INLINE breakOn #-}
1435{-# INLINE breakOn #-}
1695
1436
1696-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
1437-- | /O(n+m)/ Similar to 'breakOn', but searches from the end of the
@@ -1700,12 +1441,10 @@ breakOn = coerce JSS.breakOn
1700-- up to and including the last match of @needle@. The second is the
1441-- up to and including the last match of @needle@. The second is the
1701-- remainder of @haystack@, following the match.
1442-- remainder of @haystack@, following the match.
1702--
1443--
1703−-- >>> breakOnEnd "::" "a::b::c"
1444+-- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c")
1704−-- ("a::b::","c")
1705breakOnEnd :: Text -> Text -> (Text, Text)
1445breakOnEnd :: Text -> Text -> (Text, Text)
1706−breakOnEnd = coerce JSS.breakOnEnd
1707−-- breakOnEnd pat src = (reverse b, reverse a)
1446+breakOnEnd pat src = (reverse b, reverse a)
1708−-- where (a,b) = breakOn (reverse pat) (reverse src)
1447+ where (a,b) = breakOn (reverse pat) (reverse src)
1709{-# INLINE breakOnEnd #-}
1448{-# INLINE breakOnEnd #-}
1710
1449
1711-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
1450-- | /O(n+m)/ Find all non-overlapping instances of @needle@ in
@@ -1717,11 +1456,10 @@ breakOnEnd = coerce JSS.breakOnEnd
1717--
1456--
1718-- Examples:
1457-- Examples:
1719--
1458--
1720−-- >>> breakOnAll "::" ""
1459+-- > breakOnAll "::" ""
1721−-- []
1460+-- > ==> []
1722−--
1723−-- >>> breakOnAll "/" "a/b/c/"
1461+-- > breakOnAll "/" "a/b/c/"
1724−-- [("a","/b/c/"),("a/b","/c/"),("a/b/c","/")]
1462+-- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")]
1725--
1463--
1726-- In (unlikely) bad cases, this function's time complexity degrades
1464-- In (unlikely) bad cases, this function's time complexity degrades
1727-- towards /O(n*m)/.
1465-- towards /O(n*m)/.
@@ -1730,13 +1468,12 @@ breakOnEnd = coerce JSS.breakOnEnd
1730breakOnAll :: Text -- ^ @needle@ to search for
1468breakOnAll :: Text -- ^ @needle@ to search for
1731 -> Text -- ^ @haystack@ in which to search
1469 -> Text -- ^ @haystack@ in which to search
1732 -> [(Text, Text)]
1470 -> [(Text, Text)]
1733−breakOnAll = coerce JSS.breakOnAll
1734−-- breakOnAll pat src@(Text arr off slen)
1471+breakOnAll pat src@(Text arr off slen)
1735−-- | null pat = emptyError "breakOnAll"
1472+ | null pat = emptyError "breakOnAll"
1736−-- | otherwise = L.map step (indices pat src)
1473+ | otherwise = L.map step (indices pat src)
1737−-- where
1474+ where
1738−-- step x = (chunk 0 x, chunk x (slen-x))
1475+ step x = (chunk 0 x, chunk x (slen-x))
1739−-- chunk !n !l = text arr (n+off) l
1476+ chunk !n !l = text arr (n+off) l
1740{-# INLINE breakOnAll #-}
1477{-# INLINE breakOnAll #-}
1741
1478
1742-------------------------------------------------------------------------------
1479-------------------------------------------------------------------------------
@@ -1760,16 +1497,14 @@ breakOnAll = coerce JSS.breakOnAll
1760
1497
1761-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1498-- | /O(n)/ 'Text' index (subscript) operator, starting from 0.
1762index :: Text -> Int -> Char
1499index :: Text -> Int -> Char
1763−index = coerce JSS.index
1764−-- index t n = S.index (stream t) n
1500+index t n = S.index (stream t) n
1765{-# INLINE index #-}
1501{-# INLINE index #-}
1766
1502
1767-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
1503-- | /O(n)/ The 'findIndex' function takes a predicate and a 'Text'
1768-- and returns the index of the first element in the 'Text' satisfying
1504-- and returns the index of the first element in the 'Text' satisfying
1769-- the predicate. Subject to fusion.
1505-- the predicate. Subject to fusion.
1770findIndex :: (Char -> Bool) -> Text -> Maybe Int
1506findIndex :: (Char -> Bool) -> Text -> Maybe Int
1771−findIndex = coerce JSS.findIndex
1772−-- findIndex p t = S.findIndex p (stream t)
1507+findIndex p t = S.findIndex p (stream t)
1773{-# INLINE findIndex #-}
1508{-# INLINE findIndex #-}
1774
1509
1775-- | /O(n+m)/ The 'count' function returns the number of times the
1510-- | /O(n+m)/ The 'count' function returns the number of times the
@@ -1779,11 +1514,10 @@ findIndex = coerce JSS.findIndex
1779-- In (unlikely) bad cases, this function's time complexity degrades
1514-- In (unlikely) bad cases, this function's time complexity degrades
1780-- towards /O(n*m)/.
1515-- towards /O(n*m)/.
1781count :: Text -> Text -> Int
1516count :: Text -> Text -> Int
1782−count = coerce JSS.count
1783−-- count pat src
1517+count pat src
1784−-- | null pat = emptyError "count"
1518+ | null pat = emptyError "count"
1785−-- | isSingleton pat = countChar (unsafeHead pat) src
1519+ | isSingleton pat = countChar (unsafeHead pat) src
1786−-- | otherwise = L.length (indices pat src)
1520+ | otherwise = L.length (indices pat src)
1787{-# INLINE [1] count #-}
1521{-# INLINE [1] count #-}
1788
1522
1789{-# RULES
1523{-# RULES
@@ -1805,46 +1539,42 @@ countChar c t = S.countChar c (stream t)
1805-- excess elements of the longer 'Text' are discarded. This is
1539-- excess elements of the longer 'Text' are discarded. This is
1806-- equivalent to a pair of 'unpack' operations.
1540-- equivalent to a pair of 'unpack' operations.
1807zip :: Text -> Text -> [(Char,Char)]
1541zip :: Text -> Text -> [(Char,Char)]
1808−zip = coerce JSS.zip
1809−-- zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1542+zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)
1810{-# INLINE zip #-}
1543{-# INLINE zip #-}
1811
1544
1812-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1545-- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function
1813-- given as the first argument, instead of a tupling function.
1546-- given as the first argument, instead of a tupling function.
1814-- Performs replacement on invalid scalar values.
1547-- Performs replacement on invalid scalar values.
1815zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1548zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text
1816−zipWith = coerce JSS.zipWith
1817−-- zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1549+zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2))
1818−-- where g a b = safe (f a b)
1550+ where g a b = safe (f a b)
1819{-# INLINE zipWith #-}
1551{-# INLINE zipWith #-}
1820
1552
1821-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1553-- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's
1822-- representing white space.
1554-- representing white space.
1823words :: Text -> [Text]
1555words :: Text -> [Text]
1824−words = coerce JSS.words
1825−-- words t@(Text arr off len) = loop 0 0
1556+words t@(Text arr off len) = loop 0 0
1826−-- where
1557+ where
1827−-- loop !start !n
1558+ loop !start !n
1828−-- | n >= len = if start == n
1559+ | n >= len = if start == n
1829−-- then []
1560+ then []
1830−-- else [Text arr (start+off) (n-start)]
1561+ else [Text arr (start+off) (n-start)]
1831−-- | isSpace c =
1562+ | isSpace c =
1832−-- if start == n
1563+ if start == n
1833−-- then loop (start+1) (start+1)
1564+ then loop (start+1) (start+1)
1834−-- else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1565+ else Text arr (start+off) (n-start) : loop (n+d) (n+d)
1835−-- | otherwise = loop start (n+d)
1566+ | otherwise = loop start (n+d)
1836−-- where Iter c d = iter t n
1567+ where Iter c d = iter t n
1837{-# INLINE words #-}
1568{-# INLINE words #-}
1838
1569
1839-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
1570-- | /O(n)/ Breaks a 'Text' up into a list of 'Text's at
1840-- newline 'Char's. The resulting strings do not contain newlines.
1571-- newline 'Char's. The resulting strings do not contain newlines.
1841lines :: Text -> [Text]
1572lines :: Text -> [Text]
1842−lines = coerce JSS.lines
1843−-- lines ps | null ps = []
1573+lines ps | null ps = []
1844−-- | otherwise = h : if null t
1574+ | otherwise = h : if null t
1845−-- then []
1575+ then []
1846−-- else lines (unsafeTail t)
1576+ else lines (unsafeTail t)
1847−-- where (# h,t #) = span_ (/= '\n') ps
1577+ where (# h,t #) = span_ (/= '\n') ps
1848{-# INLINE lines #-}
1578{-# INLINE lines #-}
1849
1579
1850{-
1580{-
@@ -1872,40 +1602,34 @@ lines' ps | null ps = []
1872-- | /O(n)/ Joins lines, after appending a terminating newline to
1602-- | /O(n)/ Joins lines, after appending a terminating newline to
1873-- each.
1603-- each.
1874unlines :: [Text] -> Text
1604unlines :: [Text] -> Text
1875−unlines = coerce JSS.unlines
1876−-- unlines = concat . L.map (`snoc` '\n')
1605+unlines = concat . L.map (`snoc` '\n')
1877{-# INLINE unlines #-}
1606{-# INLINE unlines #-}
1878
1607
1879-- | /O(n)/ Joins words using single space characters.
1608-- | /O(n)/ Joins words using single space characters.
1880unwords :: [Text] -> Text
1609unwords :: [Text] -> Text
1881−unwords = coerce JSS.unwords
1882−-- unwords = intercalate (singleton ' ')
1610+unwords = intercalate (singleton ' ')
1883{-# INLINE unwords #-}
1611{-# INLINE unwords #-}
1884
1612
1885-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1613-- | /O(n)/ The 'isPrefixOf' function takes two 'Text's and returns
1886-- 'True' iff the first is a prefix of the second. Subject to fusion.
1614-- 'True' iff the first is a prefix of the second. Subject to fusion.
1887isPrefixOf :: Text -> Text -> Bool
1615isPrefixOf :: Text -> Text -> Bool
1888−isPrefixOf = coerce JSS.isPrefixOf
1889−-- isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1616+isPrefixOf a@(Text _ _ alen) b@(Text _ _ blen) =
1890−-- alen <= blen && S.isPrefixOf (stream a) (stream b)
1617+ alen <= blen && S.isPrefixOf (stream a) (stream b)
1891{-# INLINE [1] isPrefixOf #-}
1618{-# INLINE [1] isPrefixOf #-}
1892
1619
1893{-# RULES
1620{-# RULES
1894"TEXT isPrefixOf -> fused" [~1] forall s t.
1621"TEXT isPrefixOf -> fused" [~1] forall s t.
1895 isPrefixOf s t = S.isPrefixOf (stream s) (stream t)
1622 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
1898 #-}
1623 #-}
1899
1624
1900-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
1625-- | /O(n)/ The 'isSuffixOf' function takes two 'Text's and returns
1901-- 'True' iff the first is a suffix of the second.
1626-- 'True' iff the first is a suffix of the second.
1902isSuffixOf :: Text -> Text -> Bool
1627isSuffixOf :: Text -> Text -> Bool
1903−isSuffixOf = coerce JSS.isSuffixOf
1904−-- isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1628+isSuffixOf a@(Text _aarr _aoff alen) b@(Text barr boff blen) =
1905−-- d >= 0 && a == b'
1629+ d >= 0 && a == b'
1906−-- where d = blen - alen
1630+ where d = blen - alen
1907−-- b' | d == 0 = b
1631+ b' | d == 0 = b
1908−-- | otherwise = Text barr (boff+d) alen
1632+ | otherwise = Text barr (boff+d) alen
1909{-# INLINE isSuffixOf #-}
1633{-# INLINE isSuffixOf #-}
1910
1634
1911-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns
1635-- | /O(n+m)/ The 'isInfixOf' function takes two 'Text's and returns
@@ -1915,11 +1639,10 @@ isSuffixOf = coerce JSS.isSuffixOf
1915-- In (unlikely) bad cases, this function's time complexity degrades
1639-- In (unlikely) bad cases, this function's time complexity degrades
1916-- towards /O(n*m)/.
1640-- towards /O(n*m)/.
1917isInfixOf :: Text -> Text -> Bool
1641isInfixOf :: Text -> Text -> Bool
1918−isInfixOf = coerce JSS.isInfixOf
1919−-- isInfixOf needle haystack
1642+isInfixOf needle haystack
1920−-- | null needle = True
1643+ | null needle = True
1921−-- | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack
1644+ | isSingleton needle = S.elem (unsafeHead needle) . S.stream $ haystack
1922−-- | otherwise = not . L.null . indices needle $ haystack
1645+ | otherwise = not . L.null . indices needle $ haystack
1923{-# INLINE [1] isInfixOf #-}
1646{-# INLINE [1] isInfixOf #-}
1924
1647
1925{-# RULES
1648{-# RULES
@@ -1935,14 +1658,9 @@ isInfixOf = coerce JSS.isInfixOf
1935--
1658--
1936-- Examples:
1659-- Examples:
1937--
1660--
1938−-- >>> stripPrefix "foo" "foobar"
1661+-- > stripPrefix "foo" "foobar" == Just "bar"
1939−-- Just "bar"
1940−--
1941−-- >>> stripPrefix "" "baz"
1662+-- > stripPrefix "" "baz" == Just "baz"
1942−-- Just "baz"
1943−--
1944−-- >>> stripPrefix "foo" "quux"
1663+-- > stripPrefix "foo" "quux" == Nothing
1945−-- Nothing
1946--
1664--
1947-- This is particularly useful with the @ViewPatterns@ extension to
1665-- This is particularly useful with the @ViewPatterns@ extension to
1948-- GHC, as follows:
1666-- GHC, as follows:
@@ -1954,10 +1672,9 @@ isInfixOf = coerce JSS.isInfixOf
1954-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
1672-- > fnordLength (stripPrefix "fnord" -> Just suf) = T.length suf
1955-- > fnordLength _ = -1
1673-- > fnordLength _ = -1
1956stripPrefix :: Text -> Text -> Maybe Text
1674stripPrefix :: Text -> Text -> Maybe Text
1957−stripPrefix = coerce JSS.stripPrefix
1958−-- stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1675+stripPrefix p@(Text _arr _off plen) t@(Text arr off len)
1959−-- | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1676+ | p `isPrefixOf` t = Just $! text arr (off+plen) (len-plen)
1960−-- | otherwise = Nothing
1677+ | otherwise = Nothing
1961
1678
1962-- | /O(n)/ Find the longest non-empty common prefix of two strings
1679-- | /O(n)/ Find the longest non-empty common prefix of two strings
1963-- and return it, along with the suffixes of each string at which they
1680-- and return it, along with the suffixes of each string at which they
@@ -1968,39 +1685,28 @@ stripPrefix = coerce JSS.stripPrefix
1968--
1685--
1969-- Examples:
1686-- Examples:
1970--
1687--
1971−-- >>> commonPrefixes "foobar" "fooquux"
1688+-- > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux")
1972−-- Just ("foo","bar","quux")
1973−--
1974−-- >>> commonPrefixes "veeble" "fetzer"
1689+-- > commonPrefixes "veeble" "fetzer" == Nothing
1975−-- Nothing
1976−--
1977−-- >>> commonPrefixes "" "baz"
1690+-- > commonPrefixes "" "baz" == Nothing
1978−-- Nothing
1979commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1691commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text)
1980−commonPrefixes = coerce JSS.commonPrefixes
1981−-- commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1692+commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0
1982−-- where
1693+ where
1983−-- go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1694+ go !i !j | i < len0 && j < len1 && a == b = go (i+d0) (j+d1)
1984−-- | i > 0 = Just (Text arr0 off0 i,
1695+ | i > 0 = Just (Text arr0 off0 i,
1985−-- text arr0 (off0+i) (len0-i),
1696+ text arr0 (off0+i) (len0-i),
1986−-- text arr1 (off1+j) (len1-j))
1697+ text arr1 (off1+j) (len1-j))
1987−-- | otherwise = Nothing
1698+ | otherwise = Nothing
1988−-- where Iter a d0 = iter t0 i
1699+ where Iter a d0 = iter t0 i
1989−-- Iter b d1 = iter t1 j
1700+ Iter b d1 = iter t1 j
1990
1701
1991-- | /O(n)/ Return the prefix of the second string if its suffix
1702-- | /O(n)/ Return the prefix of the second string if its suffix
1992-- matches the entire first string.
1703-- matches the entire first string.
1993--
1704--
1994-- Examples:
1705-- Examples:
1995--
1706--
1996−-- >>> stripSuffix "bar" "foobar"
1707+-- > stripSuffix "bar" "foobar" == Just "foo"
1997−-- Just "foo"
1998−--
1999−-- >>> stripSuffix "" "baz"
1708+-- > stripSuffix "" "baz" == Just "baz"
2000−-- Just "baz"
2001−--
2002−-- >>> stripSuffix "foo" "quux"
1709+-- > stripSuffix "foo" "quux" == Nothing
2003−-- Nothing
2004--
1710--
2005-- This is particularly useful with the @ViewPatterns@ extension to
1711-- This is particularly useful with the @ViewPatterns@ extension to
2006-- GHC, as follows:
1712-- GHC, as follows:
@@ -2012,22 +1718,21 @@ commonPrefixes = coerce JSS.commonPrefixes
2012-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
1718-- > quuxLength (stripSuffix "quux" -> Just pre) = T.length pre
2013-- > quuxLength _ = -1
1719-- > quuxLength _ = -1
2014stripSuffix :: Text -> Text -> Maybe Text
1720stripSuffix :: Text -> Text -> Maybe Text
2015−stripSuffix = coerce JSS.stripSuffix
2016−-- stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
1721+stripSuffix p@(Text _arr _off plen) t@(Text arr off len)
2017−-- | p `isSuffixOf` t = Just $! text arr off (len-plen)
1722+ | p `isSuffixOf` t = Just $! text arr off (len-plen)
2018−-- | otherwise = Nothing
1723+ | otherwise = Nothing
2019−
1724+
2020−-- -- | Add a list of non-negative numbers. Errors out on overflow.
1725+-- | Add a list of non-negative numbers. Errors out on overflow.
2021−-- sumP :: String -> [Int] -> Int
1726+sumP :: String -> [Int] -> Int
2022−-- sumP fun = go 0
1727+sumP fun = go 0
2023−-- where go !a (x:xs)
1728+ where go !a (x:xs)
2024−-- | ax >= 0 = go ax xs
1729+ | ax >= 0 = go ax xs
2025−-- | otherwise = overflowError fun
1730+ | otherwise = overflowError fun
2026−-- where ax = a + x
1731+ where ax = a + x
2027−-- go a _ = a
1732+ go a _ = a
2028−
1733+
2029−-- emptyError :: String -> a
1734+emptyError :: String -> a
2030−-- emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
1735+emptyError fun = P.error $ "Data.Text." ++ fun ++ ": empty input"
2031
1736
2032overflowError :: String -> a
1737overflowError :: String -> a
2033overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
1738overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
@@ -2041,22 +1746,10 @@ overflowError fun = P.error $ "Data.Text." ++ fun ++ ": size overflow"
2041-- copy \"breaks the link\" to the original array, allowing it to be
1746-- copy \"breaks the link\" to the original array, allowing it to be
2042-- garbage collected if there are no other live references to it.
1747-- garbage collected if there are no other live references to it.
2043copy :: Text -> Text
1748copy :: Text -> Text
2044−copy = P.id -- TODO
2045−-- copy (Text arr off len) = Text (A.run go) 0 len
1749+copy (Text arr off len) = Text (A.run go) 0 len
2046−-- where
1750+ where
2047−-- go :: ST s (A.MArray s)
1751+ go :: ST s (A.MArray s)
2048−-- go = do
1752+ go = do
2049−-- marr <- A.new len
1753+ marr <- A.new len
2050−
1754+ A.copyI marr 0 arr off len
2051−foreign import javascript unsafe
1755+ return marr
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+1−4
@@ -7,6 +7,7 @@
7--
7--
8-- License : BSD-style
8-- License : BSD-style
9-- Maintainer : bos@serpentine.com
9-- Maintainer : bos@serpentine.com
10+-- Stability : experimental
10-- Portability : portable
11-- Portability : portable
11--
12--
12-- Packed, unboxed, heap-resident arrays. Suitable for performance
13-- Packed, unboxed, heap-resident arrays. Suitable for performance
@@ -79,8 +80,6 @@ import GHC.Word (Word16(..))
79import Prelude hiding (length, read)
80import Prelude hiding (length, read)
80
81
81-- | Immutable array type.
82-- | Immutable array type.
82−--
83−-- The 'Array' constructor is exposed since @text-1.1.1.3@
84data Array = Array {
83data Array = Array {
85 aBA :: ByteArray#
84 aBA :: ByteArray#
86#if defined(ASSERTS)
85#if defined(ASSERTS)
@@ -89,8 +88,6 @@ data Array = Array {
89 }
88 }
90
89
91-- | Mutable array type, for use in the ST monad.
90-- | Mutable array type, for use in the ST monad.
92−--
93−-- The 'MArray' constructor is exposed since @text-1.1.1.3@
94data MArray s = MArray {
91data MArray s = MArray {
95 maBA :: MutableByteArray# s
92 maBA :: MutableByteArray# s
96#if defined(ASSERTS)
93#if defined(ASSERTS)
Data/Text/Encoding.hs+11−101
@@ -3,7 +3,6 @@
3#if __GLASGOW_HASKELL__ >= 702
3#if __GLASGOW_HASKELL__ >= 702
4{-# LANGUAGE Trustworthy #-}
4{-# LANGUAGE Trustworthy #-}
5#endif
5#endif
6−{-# LANGUAGE UnboxedTuples #-}
7-- |
6-- |
8-- Module : Data.Text.Encoding
7-- Module : Data.Text.Encoding
9-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
8-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan,
@@ -12,13 +11,14 @@
12--
11--
13-- License : BSD-style
12-- License : BSD-style
14-- Maintainer : bos@serpentine.com
13-- 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−-- <http://hackage.haskell.org/package/text-icu text-icu package>.
21+-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
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, throwIO, ErrorCall(ErrorCall))
69+import Control.Exception (evaluate, try)
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,16 +76,10 @@ 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__
80import Data.Text.Show ()
79import Data.Text.Show ()
81−#endif
82import Data.Text.Unsafe (unsafeDupablePerformIO)
80import Data.Text.Unsafe (unsafeDupablePerformIO)
83import Data.Word (Word8, Word32)
81import Data.Word (Word8, Word32)
84−#if __GLASGOW_HASKELL__ >= 703
85−import Foreign.C.Types (CSize(CSize))
82+import Foreign.C.Types (CSize(..))
86−#else
87−import Foreign.C.Types (CSize)
88−#endif
89import Foreign.ForeignPtr (withForeignPtr)
83import Foreign.ForeignPtr (withForeignPtr)
90import Foreign.Marshal.Utils (with)
84import Foreign.Marshal.Utils (with)
91import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
85import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr)
@@ -101,12 +95,6 @@ import qualified Data.Text.Internal.Encoding.Utf16 as U16
101import qualified Data.Text.Internal.Fusion as F
95import qualified Data.Text.Internal.Fusion as F
102
96
103#include "text_cbits.h"
97#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
110
98
111-- $strict
99-- $strict
112--
100--
@@ -140,13 +128,6 @@ decodeLatin1 (PS fp off len) = text a 0 len
140 return dest
128 return dest
141
129
142-- | Decode a 'ByteString' containing UTF-8 encoded text.
130-- | 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.
150decodeUtf8With :: OnDecodeError -> ByteString -> Text
131decodeUtf8With :: OnDecodeError -> ByteString -> Text
151decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
132decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
152 let go dest = withForeignPtr fp $ \ptr ->
133 let go dest = withForeignPtr fp $ \ptr ->
@@ -162,52 +143,16 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
162 x <- peek curPtr'
143 x <- peek curPtr'
163 case onErr desc (Just x) of
144 case onErr desc (Just x) of
164 Nothing -> loop $ curPtr' `plusPtr` 1
145 Nothing -> loop $ curPtr' `plusPtr` 1
165− Just c
146+ Just c -> do
166− | c > '\xFFFF' -> throwUnsupportedReplChar
167− | otherwise -> do
168− destOff <- peek destOffPtr
147+ destOff <- peek destOffPtr
169− w <- unsafeSTToIO $
148+ w <- unsafeSTToIO $
170− unsafeWrite dest (fromIntegral destOff)
149+ unsafeWrite dest (fromIntegral destOff) (safe c)
171− (safe c)
172− poke destOffPtr (destOff + fromIntegral w)
150+ poke destOffPtr (destOff + fromIntegral w)
173− loop $ curPtr' `plusPtr` 1
151+ loop $ curPtr' `plusPtr` 1
174 loop (ptr `plusPtr` off)
152 loop (ptr `plusPtr` off)
175 (unsafeIOToST . go) =<< A.new len
153 (unsafeIOToST . go) =<< A.new len
176 where
154 where
177 desc = "Data.Text.Internal.Encoding.decodeUtf8: Invalid UTF-8 stream"
155 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.
211{- INLINE[0] decodeUtf8With #-}
156{- INLINE[0] decodeUtf8With #-}
212
157
213-- $stream
158-- $stream
@@ -264,8 +209,6 @@ decodeUtf8With onErr (PS fp off len) = runText $ \done -> do
264-- or continuation where it is encountered.
209-- or continuation where it is encountered.
265
210
266-- | A stream oriented decoding result.
211-- | A stream oriented decoding result.
267−--
268−-- @since 1.0.0.0
269data Decoding = Some Text ByteString (ByteString -> Decoding)
212data Decoding = Some Text ByteString (ByteString -> Decoding)
270
213
271instance Show Decoding where
214instance Show Decoding where
@@ -285,15 +228,11 @@ newtype DecoderState = DecoderState Word32 deriving (Eq, Show, Num, Storable)
285-- thrown (either by this function or a continuation) that cannot be
228-- thrown (either by this function or a continuation) that cannot be
286-- caught in pure code. For more control over the handling of invalid
229-- caught in pure code. For more control over the handling of invalid
287-- data, use 'streamDecodeUtf8With'.
230-- data, use 'streamDecodeUtf8With'.
288−--
289−-- @since 1.0.0.0
290streamDecodeUtf8 :: ByteString -> Decoding
231streamDecodeUtf8 :: ByteString -> Decoding
291streamDecodeUtf8 = streamDecodeUtf8With strictDecode
232streamDecodeUtf8 = streamDecodeUtf8With strictDecode
292
233
293-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
234-- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8
294-- encoded text.
235-- encoded text.
295−--
296−-- @since 1.0.0.0
297streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
236streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding
298streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
237streamDecodeUtf8With onErr = decodeChunk B.empty 0 0
299 where
238 where
@@ -369,8 +308,6 @@ decodeUtf8' = unsafeDupablePerformIO . try . evaluate . decodeUtf8With strictDec
369{-# INLINE decodeUtf8' #-}
308{-# INLINE decodeUtf8' #-}
370
309
371-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
310-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding.
372−--
373−-- @since 1.1.0.0
374encodeUtf8Builder :: Text -> B.Builder
311encodeUtf8Builder :: Text -> B.Builder
375encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
312encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
376
313
@@ -379,8 +316,6 @@ encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8)
379--
316--
380-- Use this function is to implement efficient encoders for text-based formats
317-- Use this function is to implement efficient encoders for text-based formats
381-- like JSON or HTML.
318-- like JSON or HTML.
382−--
383−-- @since 1.1.0.0
384{-# INLINE encodeUtf8BuilderEscaped #-}
319{-# INLINE encodeUtf8BuilderEscaped #-}
385-- TODO: Extend documentation with references to source code in @blaze-html@
320-- TODO: Extend documentation with references to source code in @blaze-html@
386-- or @aeson@ that uses this function.
321-- or @aeson@ that uses this function.
@@ -391,24 +326,9 @@ encodeUtf8BuilderEscaped be =
391 where
326 where
392 bound = max 4 $ BP.sizeBound be
327 bound = max 4 $ BP.sizeBound be
393
328
394−#ifndef __GHCJS__
395 mkBuildstep (Text arr off len) !k =
329 mkBuildstep (Text arr off len) !k =
396−#else
397− mkBuildstep (Text t) !k =
398−#endif
399 outerLoop off
330 outerLoop off
400 where
331 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
412 iend = off + len
332 iend = off + len
413
333
414 outerLoop !i0 !br@(B.BufferRange op0 ope)
334 outerLoop !i0 !br@(B.BufferRange op0 ope)
@@ -450,11 +370,10 @@ encodeUtf8BuilderEscaped be =
450
370
451-- | Encode text using UTF-8 encoding.
371-- | Encode text using UTF-8 encoding.
452encodeUtf8 :: Text -> ByteString
372encodeUtf8 :: Text -> ByteString
453−#ifndef __GHCJS__
454encodeUtf8 (Text arr off len)
373encodeUtf8 (Text arr off len)
455 | len == 0 = B.empty
374 | len == 0 = B.empty
456 | otherwise = unsafeDupablePerformIO $ do
375 | otherwise = unsafeDupablePerformIO $ do
457− fp <- mallocByteString (len*3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough
376+ fp <- mallocByteString (len*4)
458 withForeignPtr fp $ \ptr ->
377 withForeignPtr fp $ \ptr ->
459 with ptr $ \destPtr -> do
378 with ptr $ \destPtr -> do
460 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
379 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
@@ -467,10 +386,6 @@ encodeUtf8 (Text arr off len)
467 withForeignPtr fp' $ \ptr' -> do
386 withForeignPtr fp' $ \ptr' -> do
468 memcpy ptr' ptr (fromIntegral utf8len)
387 memcpy ptr' ptr (fromIntegral utf8len)
469 return (PS fp' 0 utf8len)
388 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
474
389
475-- | Decode text from little endian UTF-16 encoding.
390-- | Decode text from little endian UTF-16 encoding.
476decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
391decodeUtf16LEWith :: OnDecodeError -> ByteString -> Text
@@ -560,10 +475,5 @@ foreign import ccall unsafe "_hs_text_decode_utf8_state" c_decode_utf8_with_stat
560foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
475foreign import ccall unsafe "_hs_text_decode_latin1" c_decode_latin1
561 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
476 :: MutableByteArray# s -> Ptr Word8 -> Ptr Word8 -> IO ()
562
477
563−#ifndef __GHCJS__
564foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
478foreign import ccall unsafe "_hs_text_encode_utf8" c_encode_utf8
565 :: Ptr (Ptr Word8) -> ByteArray# -> CSize -> CSize -> IO ()
479 :: 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,6 +10,7 @@
10--
10--
11-- License : BSD-style
11-- License : BSD-style
12-- Maintainer : bos@serpentine.com
12-- Maintainer : bos@serpentine.com
13+-- Stability : experimental
13-- Portability : GHC
14-- Portability : GHC
14--
15--
15-- Types and functions for dealing with encoding and decoding errors
16-- Types and functions for dealing with encoding and decoding errors
Data/Text/Foreign.hs+3−92
@@ -1,11 +1,11 @@
1{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving #-}
1{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving #-}
2−{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes, MagicHash #-}
3-- |
2-- |
4-- Module : Data.Text.Foreign
3-- Module : Data.Text.Foreign
5-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
6--
5--
7-- License : BSD-style
6-- License : BSD-style
8-- Maintainer : bos@serpentine.com
7-- 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,13 +51,6 @@ 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
61
54
62-- $interop
55-- $interop
63--
56--
@@ -82,15 +75,11 @@ fromPtr :: Ptr Word16 -- ^ source array
82 -> I16 -- ^ length of source array (in 'Word16' units)
75 -> I16 -- ^ length of source array (in 'Word16' units)
83 -> IO Text
76 -> IO Text
84fromPtr _ (I16 0) = return empty
77fromPtr _ (I16 0) = return empty
85−fromPtr ptr (I16 (len@(I# len#))) =
78+fromPtr ptr (I16 len) =
86#if defined(ASSERTS)
79#if defined(ASSERTS)
87 assert (len > 0) $
80 assert (len > 0) $
88#endif
81#endif
89−#if defined(__GHCJS__)
90− return $! Text (js_toString (A.aBA arr) 0# len#)
91−#else
92 return $! Text arr 0 len
82 return $! Text arr 0 len
93−#endif
94 where
83 where
95 arr = A.run (A.new len >>= copy)
84 arr = A.run (A.new len >>= copy)
96 copy marr = loop ptr 0
85 copy marr = loop ptr 0
@@ -114,30 +103,14 @@ fromPtr ptr (I16 (len@(I# len#))) =
114-- end of the prefix will be advanced by one additional 'Word16' unit
103-- end of the prefix will be advanced by one additional 'Word16' unit
115-- to maintain its validity.
104-- to maintain its validity.
116takeWord16 :: I16 -> Text -> Text
105takeWord16 :: 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
123takeWord16 (I16 n) t@(Text arr off len)
106takeWord16 (I16 n) t@(Text arr off len)
124 | n <= 0 = empty
107 | n <= 0 = empty
125 | n >= len || m >= len = t
108 | n >= len || m >= len = t
126 | otherwise = Text arr off m
109 | otherwise = Text arr off m
127−#endif
128 where
110 where
129−#ifdef __GHCJS__
111+ m | w < 0xDB00 || w > 0xD8FF = n
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
138 | otherwise = n+1
112 | otherwise = n+1
139 w = A.unsafeIndex arr (off+n-1)
113 w = A.unsafeIndex arr (off+n-1)
140−#endif
141
114
142-- | /O(1)/ Return the suffix of the 'Text', with @n@ 'Word16' units
115-- | /O(1)/ Return the suffix of the 'Text', with @n@ 'Word16' units
143-- dropped from its beginning.
116-- dropped from its beginning.
@@ -146,45 +119,18 @@ takeWord16 (I16 n) t@(Text arr off len)
146-- beginning of the suffix will be advanced by one additional 'Word16'
119-- beginning of the suffix will be advanced by one additional 'Word16'
147-- unit to maintain its validity.
120-- unit to maintain its validity.
148dropWord16 :: I16 -> Text -> Text
121dropWord16 :: 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
155dropWord16 (I16 n) t@(Text arr off len)
122dropWord16 (I16 n) t@(Text arr off len)
156 | n <= 0 = t
123 | n <= 0 = t
157 | n >= len || m >= len = empty
124 | n >= len || m >= len = empty
158 | otherwise = Text arr (off+m) (len-m)
125 | otherwise = Text arr (off+m) (len-m)
159−#endif
160 where
126 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
169 m | w < 0xD800 || w > 0xDBFF = n
127 m | w < 0xD800 || w > 0xDBFF = n
170 | otherwise = n+1
128 | otherwise = n+1
171 w = A.unsafeIndex arr (off+n-1)
129 w = A.unsafeIndex arr (off+n-1)
172−#endif
173
130
174-- | /O(n)/ Copy a 'Text' to an array. The array is assumed to be big
131-- | /O(n)/ Copy a 'Text' to an array. The array is assumed to be big
175-- enough to hold the contents of the entire 'Text'.
132-- enough to hold the contents of the entire 'Text'.
176unsafeCopyToPtr :: Text -> Ptr Word16 -> IO ()
133unsafeCopyToPtr :: 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
188unsafeCopyToPtr (Text arr off len) ptr = loop ptr off
134unsafeCopyToPtr (Text arr off len) ptr = loop ptr off
189 where
135 where
190 end = off + len
136 end = off + len
@@ -192,44 +138,25 @@ unsafeCopyToPtr (Text arr off len) ptr = loop ptr off
192 | otherwise = do
138 | otherwise = do
193 poke p (A.unsafeIndex arr i)
139 poke p (A.unsafeIndex arr i)
194 loop (p `plusPtr` 2) (i + 1)
140 loop (p `plusPtr` 2) (i + 1)
195−#endif
196
141
197-- | /O(n)/ Perform an action on a temporary, mutable copy of a
142-- | /O(n)/ Perform an action on a temporary, mutable copy of a
198-- 'Text'. The copy is freed as soon as the action returns.
143-- 'Text'. The copy is freed as soon as the action returns.
199useAsPtr :: Text -> (Ptr Word16 -> I16 -> IO a) -> IO a
144useAsPtr :: 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
207useAsPtr t@(Text _arr _off len) action =
145useAsPtr t@(Text _arr _off len) action =
208 allocaBytes (len * 2) $ \buf -> do
146 allocaBytes (len * 2) $ \buf -> do
209 unsafeCopyToPtr t buf
147 unsafeCopyToPtr t buf
210 action (castPtr buf) (fromIntegral len)
148 action (castPtr buf) (fromIntegral len)
211−#endif
212
149
213-- | /O(n)/ Make a mutable copy of a 'Text'.
150-- | /O(n)/ Make a mutable copy of a 'Text'.
214asForeignPtr :: Text -> IO (ForeignPtr Word16, I16)
151asForeignPtr :: 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
222asForeignPtr t@(Text _arr _off len) = do
152asForeignPtr t@(Text _arr _off len) = do
223 fp <- mallocForeignPtrArray len
153 fp <- mallocForeignPtrArray len
224 withForeignPtr fp $ unsafeCopyToPtr t
154 withForeignPtr fp $ unsafeCopyToPtr t
225 return (fp, I16 len)
155 return (fp, I16 len)
226−#endif
227
156
228-- | /O(n)/ Decode a C string with explicit length, which is assumed
157-- | /O(n)/ Decode a C string with explicit length, which is assumed
229-- to have been encoded as UTF-8. If decoding fails, a
158-- to have been encoded as UTF-8. If decoding fails, a
230-- 'UnicodeException' is thrown.
159-- 'UnicodeException' is thrown.
231−--
232−-- @since 1.0.0.0
233peekCStringLen :: CStringLen -> IO Text
160peekCStringLen :: CStringLen -> IO Text
234peekCStringLen cs = do
161peekCStringLen cs = do
235 bs <- unsafePackCStringLen cs
162 bs <- unsafePackCStringLen cs
@@ -242,21 +169,5 @@ peekCStringLen cs = do
242-- The temporary storage is freed when the subcomputation terminates
169-- The temporary storage is freed when the subcomputation terminates
243-- (either normally or via an exception), so the pointer to the
170-- (either normally or via an exception), so the pointer to the
244-- temporary storage must /not/ be used after this function returns.
171-- temporary storage must /not/ be used after this function returns.
245−--
246−-- @since 1.0.0.0
247withCStringLen :: Text -> (CStringLen -> IO a) -> IO a
172withCStringLen :: Text -> (CStringLen -> IO a) -> IO a
248withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act
173withCStringLen 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+1−20
@@ -8,6 +8,7 @@
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
11-- Portability : GHC
12-- Portability : GHC
12--
13--
13-- Efficient locale-sensitive support for text I\/O.
14-- Efficient locale-sensitive support for text I\/O.
@@ -184,11 +185,7 @@ hPutStr h t = do
184 | otherwise -> writeBlocksRaw h buf str
185 | otherwise -> writeBlocksRaw h buf str
185
186
186hPutChars :: Handle -> Stream Char -> IO ()
187hPutChars :: 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
192 where
189 where
193 loop !s = case next0 s of
190 loop !s = case next0 s of
194 Done -> return ()
191 Done -> return ()
@@ -206,11 +203,7 @@ hPutChars h (Stream next0 s0) = loop s0
206-- handling gave a few more percent on top.
203-- handling gave a few more percent on top.
207
204
208writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()
205writeLines :: Handle -> Newline -> Buffer CharBufElem -> Stream Char -> IO ()
209−#ifndef __GHCJS__
210writeLines h nl buf0 (Stream next0 s0 _len) = outer s0 buf0
206writeLines 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
214 where
207 where
215 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
208 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
216 where
209 where
@@ -230,11 +223,7 @@ writeLines h nl buf0 (Stream next0 s0) = outer s0 buf0
230 commit = commitBuffer h raw len
223 commit = commitBuffer h raw len
231
224
232writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
225writeBlocksCRLF :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
233−#ifndef __GHCJS__
234writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
226writeBlocksCRLF h buf0 (Stream next0 s0 _len) = outer s0 buf0
235−#else
236−writeBlocksCRLF h buf0 (Stream next0 s0) = outer s0 buf0
237−#endif
238 where
227 where
239 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
228 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
240 where
229 where
@@ -250,11 +239,7 @@ writeBlocksCRLF h buf0 (Stream next0 s0) = outer s0 buf0
250 commit = commitBuffer h raw len
239 commit = commitBuffer h raw len
251
240
252writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
241writeBlocksRaw :: Handle -> Buffer CharBufElem -> Stream Char -> IO ()
253−#ifndef __GHCJS__
254writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0
242writeBlocksRaw h buf0 (Stream next0 s0 _len) = outer s0 buf0
255−#else
256−writeBlocksRaw h buf0 (Stream next0 s0) = outer s0 buf0
257−#endif
258 where
243 where
259 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
244 outer s1 Buffer{bufRaw=raw, bufSize=len} = inner s1 (0::Int)
260 where
245 where
@@ -351,7 +336,3 @@ putStrLn = hPutStrLn stdout
351-- >
336-- >
352-- > putStr_Utf16LE :: Text -> IO ()
337-- > putStr_Utf16LE :: Text -> IO ()
353-- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t)
338-- > 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+125−53
@@ -1,72 +1,127 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples, MagicHash,
1+{-# LANGUAGE CPP, DeriveDataTypeable, UnboxedTuples #-}
2− BangPatterns, ForeignFunctionInterface, JavaScriptFFI, GeneralizedNewtypeDeriving #-}
2+{-# OPTIONS_HADDOCK not-home #-}
3−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes,
3+
4− GHCForeignImportPrim, MagicHash, FlexibleInstances #-}
4+-- |
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+
5module Data.Text.Internal
27module Data.Text.Internal
6− ( module Data.Text.Internal
28+ (
29+ -- * Types
30+ -- $internals
31+ Text(..)
32+ -- * Construction
33+ , text
34+ , textP
35+ -- * Safety
7− , JSS.safe
36+ , safe
37+ -- * Code that must be here for accessibility
38+ , empty
39+ , empty_
40+ -- * Utilities
8− , JSS.firstf
41+ , firstf
42+ -- * Checked multiplication
43+ , mul
44+ , mul32
45+ , mul64
46+ -- * Debugging
47+ , showText
9− ) where
48+ ) 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
24
49
50+#if defined(ASSERTS)
51+import Control.Exception (assert)
52+#endif
25import Data.Bits
53import Data.Bits
26import Data.Int (Int32, Int64)
54import Data.Int (Int32, Int64)
27−-- import Data.Text.Internal.Unsafe.Char (ord)
55+import Data.Text.Internal.Unsafe.Char (ord)
28import Data.Typeable (Typeable)
56import Data.Typeable (Typeable)
29−import GHC.Exts (ByteArray#, Char(..), ord#, andI#, (/=#), isTrue#, (==#), Int(..), Int#, isTrue#)
30−-- import qualified Data.Text.Array as A
57+import qualified Data.Text.Array as A
31−import GHCJS.Marshal.Pure
32−import GHCJS.Marshal
33−import qualified GHC.CString as GHC
34−
35
58
59+-- | A space efficient, packed, unboxed Unicode text type.
36−newtype Text = Text JSString
60+data Text = Text
37− deriving (PToJSVal, PFromJSVal, FromJSVal, ToJSVal)
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)
38
65
39−instance Show Text where
66+-- | Smart constructor.
40− showsPrec p (Text jsstring) r = showsPrec p jsstring r
67+text_ :: A.Array -> Int -> Int -> Text
68+text_ arr off len =
69+#if defined(ASSERTS)
70+ let c = A.unsafeIndex arr off
71+ alen = A.length arr
72+ in assert (len >= 0) .
73+ assert (off >= 0) .
74+ assert (alen == 0 || len == 0 || off < alen) .
75+ assert (len == 0 || c < 0xDC00 || c > 0xDFFF) $
76+#endif
77+ Text arr off len
78+{-# INLINE text_ #-}
41
79
80+-- | /O(1)/ The empty 'Text'.
42empty :: Text
81empty :: Text
43−empty = Text JSS.empty
82+empty = Text A.empty 0 0
44{-# INLINE [1] empty #-}
83{-# INLINE [1] empty #-}
45
84
85+-- | A non-inlined version of 'empty'.
46empty_ :: Text
86empty_ :: Text
47−empty_ = Text JSS.empty
87+empty_ = Text A.empty 0 0
48{-# NOINLINE empty_ #-}
88{-# NOINLINE empty_ #-}
49
89
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_1,$2,$3)"
56− js_textToString :: ByteArray# -> Int# -> Int# -> JSString
57−
58-- | Construct a 'Text' without invisibly pinning its byte array in
90-- | Construct a 'Text' without invisibly pinning its byte array in
59-- memory if its length has dwindled to zero.
91-- memory if its length has dwindled to zero.
60text :: A.Array -> Int -> Int -> Text
92text :: A.Array -> Int -> Int -> Text
61−-- text arr off len | len == 0 = empty
93+text arr off len | len == 0 = empty
62−-- | otherwise = text_ arr off len
94+ | otherwise = text_ arr off len
63−#if defined(ASSERTS)
95+{-# INLINE text #-}
64−text (A.Array ba _) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty
96+
65− | otherwise = Text $ js_textToString ba off# len#
97+textP :: A.Array -> Int -> Int -> Text
66−#else
98+{-# DEPRECATED textP "Use text instead" #-}
67−text (A.Array ba) (I# off#) (I# len#) | isTrue# (len# ==# 0#) = empty
99+textP = text
68− | otherwise = Text $ js_textToString ba off# len#
100+
69−#endif
101+-- | A useful 'show'-like function for debugging purposes.
102+showText :: Text -> String
103+showText (Text arr off len) =
104+ "Text " ++ show (A.toList arr off len) ++ ' ' :
105+ show off ++ ' ' : show len
106+
107+-- | Map a 'Char' to a 'Text'-safe value.
108+--
109+-- UTF-16 surrogate code points are not included in the set of Unicode
110+-- scalar values, but are unfortunately admitted as valid 'Char'
111+-- values by Haskell. They cannot be represented in a 'Text'. This
112+-- function remaps those code points to the Unicode replacement
113+-- character (U+FFFD, \'&#xfffd;\'), and leaves other code points
114+-- unchanged.
115+safe :: Char -> Char
116+safe c
117+ | ord c .&. 0x1ff800 /= 0xd800 = c
118+ | otherwise = '\xfffd'
119+{-# INLINE [0] safe #-}
120+
121+-- | Apply a function to the first element of an optional pair.
122+firstf :: (a -> c) -> Maybe (a,b) -> Maybe (c,b)
123+firstf f (Just (a, b)) = Just (f a, b)
124+firstf _ Nothing = Nothing
70
125
71-- | Checked multiplication. Calls 'error' if the result would
126-- | Checked multiplication. Calls 'error' if the result would
72-- overflow.
127-- overflow.
@@ -113,4 +168,21 @@ mul32 a b = case fromIntegral a * fromIntegral b of
113{-# INLINE mul32 #-}
168{-# INLINE mul32 #-}
114infixl 7 `mul32`
169infixl 7 `mul32`
115
170
116−--------------------------------------
171+-- $internals
172+--
173+-- Internally, the 'Text' type is represented as an array of 'Word16'
174+-- UTF-16 code units. The offset and length fields in the constructor
175+-- are in these units, /not/ units of 'Char'.
176+--
177+-- Invariants that all functions must maintain:
178+--
179+-- * Since the 'Text' type uses UTF-16 internally, it cannot represent
180+-- characters in the reserved surrogate code point range U+D800 to
181+-- U+DFFF. To maintain this invariant, the 'safe' function maps
182+-- 'Char' values in this range to the replacement character (U+FFFD,
183+-- \'&#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+5−51
@@ -1,6 +1,4 @@
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
1{-# LANGUAGE BangPatterns, CPP, Rank2Types #-}
2−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, UnboxedTuples,
3− MagicHash #-}
4{-# OPTIONS_HADDOCK not-home #-}
2{-# OPTIONS_HADDOCK not-home #-}
5
3
6-----------------------------------------------------------------------------
4-----------------------------------------------------------------------------
@@ -75,8 +73,6 @@ import qualified Data.Text as S
75import qualified Data.Text.Array as A
73import qualified Data.Text.Array as A
76import qualified Data.Text.Lazy as L
74import qualified Data.Text.Lazy as L
77
75
78−import Data.JSString (JSString)
79−import GHC.Exts (ByteArray#, Int#, Int(I#))
80------------------------------------------------------------------------
76------------------------------------------------------------------------
81
77
82-- | A @Builder@ is an efficient way to build lazy @Text@ values.
78-- | A @Builder@ is an efficient way to build lazy @Text@ values.
@@ -168,21 +164,10 @@ copyLimit = 128
168-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
164-- * @'toLazyText' ('fromText' t) = 'L.fromChunks' [t]@
169--
165--
170fromText :: S.Text -> Builder
166fromText :: S.Text -> Builder
171−fromText t@(Text t')
167+fromText t@(Text arr off l)
172 | S.null t = empty
168 | S.null t = empty
173 | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
169 | l <= copyLimit = writeN l $ \marr o -> A.copyI marr o arr off (l+o)
174 | otherwise = flush `append` mapBuilder (t :)
170 | 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 :)
186{-# INLINE [1] fromText #-}
171{-# INLINE [1] fromText #-}
187
172
188{-# RULES
173{-# RULES
@@ -197,10 +182,10 @@ fromText t@(Text t')
197fromString :: String -> Builder
182fromString :: String -> Builder
198fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
183fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
199 let loop !marr !o !u !l [] = k (Buffer marr o u l)
184 let loop !marr !o !u !l [] = k (Buffer marr o u l)
200− loop marr o@(I# o#) u@(I# u#) l s@(c:cs)
185+ loop marr o u l s@(c:cs)
201 | l <= 1 = do
186 | l <= 1 = do
202 arr <- A.unsafeFreeze marr
187 arr <- A.unsafeFreeze marr
203− let !t = Text $ js_toString (A.aBA arr) o# u#
188+ let !t = Text arr o u
204 marr' <- A.new chunkSize
189 marr' <- A.new chunkSize
205 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
190 ts <- inlineInterleaveST (loop marr' 0 0 chunkSize s)
206 return $ t : ts
191 return $ t : ts
@@ -210,21 +195,6 @@ fromString str = Builder $ \k (Buffer p0 o0 u0 l0) ->
210 in loop p0 o0 u0 l0 str
195 in loop p0 o0 u0 l0 str
211 where
196 where
212 chunkSize = smallChunkSize
197 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
228{-# INLINE fromString #-}
198{-# INLINE fromString #-}
229
199
230-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
200-- | /O(1)./ A @Builder@ taking a lazy @Text@, satisfying
@@ -264,24 +234,16 @@ toLazyTextWith chunkSize m = L.fromChunks (runST $
264-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
234-- | /O(1)./ Pop the strict @Text@ we have constructed so far, if any,
265-- yielding a new chunk in the result lazy @Text@.
235-- yielding a new chunk in the result lazy @Text@.
266flush :: Builder
236flush :: Builder
267−flush = Builder $ \ k buf@(Buffer p o@(I# o#) u@(I# u#) l) ->
237+flush = Builder $ \ k buf@(Buffer p o u l) ->
268 if u == 0
238 if u == 0
269 then k buf
239 then k buf
270 else do arr <- A.unsafeFreeze p
240 else do arr <- A.unsafeFreeze p
271 let !b = Buffer p (o+u) 0 l
241 let !b = Buffer p (o+u) 0 l
272− !t = Text $ js_toString (A.aBA arr) o# u#
242+ !t = Text arr o u
273 ts <- inlineInterleaveST (k b)
243 ts <- inlineInterleaveST (k b)
274 return $! t : ts
244 return $! t : ts
275{-# INLINE [1] flush #-}
245{-# INLINE [1] flush #-}
276-- defer inlining so that flush/flush rule may fire.
246-- 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
285
247
286------------------------------------------------------------------------
248------------------------------------------------------------------------
287
249
@@ -365,11 +327,3 @@ append' (Builder f) (Builder g) = Builder (f . g)
365 append flush flush = flush
327 append flush flush = flush
366
328
367 #-}
329 #-}
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_1,$2,$3)"
375− js_toString :: ByteArray# -> Int# -> Int# -> JSString
Data/Text/Internal/Encoding/Fusion.hs+8−10
@@ -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,10 +166,8 @@ 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
171− -- let mlen = upperBound 4 len
170+ let mlen = upperBound 4 len
172− let mlen = 4
173 mallocByteString mlen >>= loop mlen 0 s0
171 mallocByteString mlen >>= loop mlen 0 s0
174 where
172 where
175 loop !n !off !s fp = case next s of
173 loop !n !off !s fp = case next s of
Data/Text/Internal/Encoding/Fusion/Common.hs+4−8
@@ -37,8 +37,7 @@ 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)
42 where
41 where
43 next (RS0 s) = case next0 s of
42 next (RS0 s) = case next0 s of
44 Done -> Done
43 Done -> Done
@@ -62,8 +61,7 @@ restreamUtf16BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
62{-# INLINE restreamUtf16BE #-}
61{-# INLINE restreamUtf16BE #-}
63
62
64restreamUtf16LE :: Stream Char -> Stream Word8
63restreamUtf16LE :: Stream Char -> Stream Word8
65−-- restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
64+restreamUtf16LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
66−restreamUtf16LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
67 where
65 where
68 next (RS0 s) = case next0 s of
66 next (RS0 s) = case next0 s of
69 Done -> Done
67 Done -> Done
@@ -87,8 +85,7 @@ restreamUtf16LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
87{-# INLINE restreamUtf16LE #-}
85{-# INLINE restreamUtf16LE #-}
88
86
89restreamUtf32BE :: Stream Char -> Stream Word8
87restreamUtf32BE :: Stream Char -> Stream Word8
90−restreamUtf32BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
88+restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
91−-- restreamUtf32BE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
92 where
89 where
93 next (RS0 s) = case next0 s of
90 next (RS0 s) = case next0 s of
94 Done -> Done
91 Done -> Done
@@ -107,8 +104,7 @@ restreamUtf32BE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
107{-# INLINE restreamUtf32BE #-}
104{-# INLINE restreamUtf32BE #-}
108
105
109restreamUtf32LE :: Stream Char -> Stream Word8
106restreamUtf32LE :: Stream Char -> Stream Word8
110−restreamUtf32LE (Stream next0 s0) = Stream next (RS0 s0) -- (len * 2)
107+restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
111−-- restreamUtf32LE (Stream next0 s0 len) = Stream next (RS0 s0) (len * 2)
112 where
108 where
113 next (RS0 s) = case next0 s of
109 next (RS0 s) = case next0 s of
114 Done -> Done
110 Done -> Done
Data/Text/Internal/Fusion.hs+166−40
@@ -28,91 +28,217 @@ module Data.Text.Internal.Fusion
28 , unstream
28 , unstream
29 , reverseStream
29 , reverseStream
30
30
31− , Data.Text.Internal.Fusion.length
31+ , length
32
32
33 -- * Transformations
33 -- * Transformations
34− , Data.Text.Internal.Fusion.reverse
34+ , reverse
35
35
36 -- * Construction
36 -- * Construction
37 -- ** Scans
37 -- ** Scans
38 , reverseScanr
38 , reverseScanr
39
39
40 -- ** Accumulating maps
40 -- ** Accumulating maps
41− , Data.Text.Internal.Fusion.mapAccumL
41+ , mapAccumL
42
42
43 -- ** Generation and unfolding
43 -- ** Generation and unfolding
44 , unfoldrN
44 , unfoldrN
45
45
46 -- * Indexing
46 -- * Indexing
47− , Data.Text.Internal.Fusion.index
47+ , index
48− , Data.Text.Internal.Fusion.findIndex
48+ , findIndex
49 , countChar
49 , countChar
50 ) where
50 ) where
51
51
52−import GHC.Exts (Char(..), Int(..), chr#, Int#, isTrue#, (-#), (+#), (>=#))
52+import Prelude (Bool(..), Char, Maybe(..), Monad(..), Int,
53−
53+ Num(..), Ord(..), ($), (&&),
54−import Prelude hiding (length, reverse)
54+ fromIntegral, otherwise)
55−import Data.Char
55+import Data.Bits ((.&.))
56−
57−import Data.JSString.Internal.Type (JSString(..))
56+import Data.Text.Internal (Text(..))
58−import qualified Data.JSString.Internal.Type as I
57+import Data.Text.Internal.Private (runText)
58+import Data.Text.Internal.Unsafe.Char (ord, unsafeChr, unsafeWrite)
59−import Data.JSString.Internal.Fusion.Types
59+import Data.Text.Internal.Unsafe.Shift (shiftL, shiftR)
60+import qualified Data.Text.Array as A
60−import qualified Data.JSString.Internal.Fusion.Common as S
61+import qualified Data.Text.Internal.Fusion.Common as S
61−
62+import Data.Text.Internal.Fusion.Types
62−import System.IO.Unsafe
63−
64−import GHCJS.Prim
65−
66−import Data.Coerce
67−import Data.Text.Internal
63+import Data.Text.Internal.Fusion.Size
68−import qualified Data.JSString.Internal.Fusion as JSS
64+import qualified Data.Text.Internal as I
69−import Data.JSString.Internal.Fusion.Types (Stream(..))
65+import qualified Data.Text.Internal.Encoding.Utf16 as U16
70
66
71default(Int)
67default(Int)
72
68
69+-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
73stream :: Text -> Stream Char
70stream :: Text -> Stream Char
74−stream = coerce JSS.stream
71+stream (Text arr off len) = Stream next off (betweenSize (len `shiftR` 1) len)
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)
75{-# INLINE [0] stream #-}
81{-# INLINE [0] stream #-}
76
82
83+-- | /O(n)/ Convert a 'Text' into a 'Stream Char', but iterate
84+-- backwards.
77reverseStream :: Text -> Stream Char
85reverseStream :: Text -> Stream Char
78−reverseStream = coerce JSS.reverseStream
86+reverseStream (Text arr off len) = Stream next (off+len-1) (betweenSize (len `shiftR` 1) len)
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)
79{-# INLINE [0] reverseStream #-}
96{-# INLINE [0] reverseStream #-}
80
97
98+-- | /O(n)/ Convert a 'Stream Char' into a 'Text'.
81unstream :: Stream Char -> Text
99unstream :: Stream Char -> Text
82−unstream = coerce JSS.unstream
100+unstream (Stream next0 s0 len) = runText $ \done -> do
101+ -- Before encoding each char we perform a buffer realloc check assuming
102+ -- worst case encoding size of two 16-bit units for the char. Just add an
103+ -- extra space to the buffer so that we do not end up reallocating even when
104+ -- all the chars are encoded as single unit.
105+ let mlen = upperBound 4 len + 1
106+ arr0 <- A.new mlen
107+ let outer !arr !maxi = encode
108+ where
109+ -- keep the common case loop as small as possible
110+ encode !si !di =
111+ case next0 si of
112+ Done -> done arr di
113+ Skip si' -> encode si' di
114+ Yield c si'
115+ -- simply check for the worst case
116+ | maxi < di + 1 -> realloc si di
117+ | otherwise -> do
118+ n <- unsafeWrite arr di c
119+ encode si' (di + n)
120+
121+ -- keep uncommon case separate from the common case code
122+ {-# NOINLINE realloc #-}
123+ realloc !si !di = do
124+ let newlen = (maxi + 1) * 2
125+ arr' <- A.new newlen
126+ A.copyM arr' 0 arr 0 di
127+ outer arr' (newlen - 1) si di
128+
129+ outer arr0 (mlen - 1) s0 0
83{-# INLINE [0] unstream #-}
130{-# INLINE [0] unstream #-}
84{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
131{-# RULES "STREAM stream/unstream fusion" forall s. stream (unstream s) = s #-}
85
132
133+
134+-- ----------------------------------------------------------------------------
135+-- * Basic stream functions
136+
86length :: Stream Char -> Int
137length :: Stream Char -> Int
87−length = JSS.length
138+length = S.lengthI
88−{-# INLINE [0] length #-}
139+{-# INLINE[0] length #-}
89
140
141+-- | /O(n)/ Reverse the characters of a string.
90reverse :: Stream Char -> Text
142reverse :: Stream Char -> Text
91−reverse = coerce JSS.reverse
143+reverse (Stream next s len0)
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
92{-# INLINE [0] reverse #-}
174{-# INLINE [0] reverse #-}
93
175
176+-- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with
177+-- the input and result reversed.
94reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
178reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
95−reverseScanr = JSS.reverseScanr
179+reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
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
96{-# INLINE reverseScanr #-}
188{-# INLINE reverseScanr #-}
97
189
98−mapAccumL :: (a -> Char -> (a, Char)) -> a -> Stream Char -> (a, Text)
190+-- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
99−mapAccumL f z0 st =
191+-- value. However, the length of the result is limited by the
100− let (a, t) = JSS.mapAccumL f z0 st
192+-- first argument to 'unfoldrN'. This function is more efficient than
101− in (a, Text t)
193+-- 'unfoldr' when the length of the result is known.
102−{-# INLINE [0] mapAccumL #-}
103−
104unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char
194unfoldrN :: Int -> (a -> Maybe (Char,a)) -> a -> Stream Char
105−unfoldrN = JSS.unfoldrN
195+unfoldrN n = S.unfoldrNI n
106{-# INLINE [0] unfoldrN #-}
196{-# INLINE [0] unfoldrN #-}
107
197
198+-------------------------------------------------------------------------------
199+-- ** Indexing streams
200+
201+-- | /O(n)/ stream index (subscript) operator, starting from 0.
108index :: Stream Char -> Int -> Char
202index :: Stream Char -> Int -> Char
109−index = JSS.index
203+index = S.indexI
110{-# INLINE [0] index #-}
204{-# INLINE [0] index #-}
111
205
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.
112findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
209findIndex :: (Char -> Bool) -> Stream Char -> Maybe Int
113−findIndex = JSS.findIndex
210+findIndex = S.findIndexI
114{-# INLINE [0] findIndex #-}
211{-# INLINE [0] findIndex #-}
115
212
213+-- | /O(n)/ The 'count' function returns the number of times the query
214+-- element appears in the given stream.
116countChar :: Char -> Stream Char -> Int
215countChar :: Char -> Stream Char -> Int
117−countChar = JSS.countChar
216+countChar = S.countCharI
118{-# INLINE [0] countChar #-}
217{-# 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+4−164
@@ -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-9.0.0.txt
4+-- CaseFolding-8.0.0.txt
5−-- Date: 2016-03-02, 18:54:54 GMT
5+-- Date: 2015-01-13, 18:16:36 GMT [MD]
6−-- SpecialCasing-9.0.0.txt
6+-- SpecialCasing-8.0.0.txt
7−-- Date: 2016-03-02, 18:55:13 GMT
7+-- Date: 2014-12-16, 23:08:04 GMT [MD]
8
8
9module Data.Text.Internal.Fusion.CaseMapping where
9module Data.Text.Internal.Fusion.CaseMapping where
10import Data.Char
10import Data.Char
@@ -371,24 +371,6 @@ 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')
392-- LATIN SMALL LETTER H WITH LINE BELOW
374-- LATIN SMALL LETTER H WITH LINE BELOW
393foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
375foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
394-- LATIN SMALL LETTER T WITH DIAERESIS
376-- LATIN SMALL LETTER T WITH DIAERESIS
@@ -563,8 +545,6 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')
563foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
545foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
564-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
546-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
565foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000')
547foldMapping '\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')
568-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL
548-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL
569foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')
549foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')
570-- LATIN CAPITAL LETTER CHI
550-- LATIN CAPITAL LETTER CHI
@@ -757,78 +737,6 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')
757foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
737foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
758-- ARMENIAN SMALL LIGATURE MEN XEH
738-- ARMENIAN SMALL LIGATURE MEN XEH
759foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')
739foldMapping '\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')
832-- OLD HUNGARIAN CAPITAL LETTER A
740-- OLD HUNGARIAN CAPITAL LETTER A
833foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')
741foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')
834-- OLD HUNGARIAN CAPITAL LETTER AA
742-- OLD HUNGARIAN CAPITAL LETTER AA
@@ -931,72 +839,4 @@ foldMapping '\x10cb0' s = Yield '\x10cf0' (CC s '\x0000' '\x0000')
931foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')
839foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')
932-- OLD HUNGARIAN CAPITAL LETTER US
840-- OLD HUNGARIAN CAPITAL LETTER US
933foldMapping '\x10cb2' s = Yield '\x10cf2' (CC s '\x0000' '\x0000')
841foldMapping '\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')
1002foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
842foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
Data/Text/Internal/Fusion/Common.hs+922−968
@@ -14,971 +14,925 @@
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 (module Data.JSString.Internal.Fusion.Common) where
17+module Data.Text.Internal.Fusion.Common
18−import Data.JSString.Internal.Fusion.Common
18+ (
19−-- module Data.Text.Internal.Fusion.Common
19+ -- * Creation and elimination
20−-- (
20+ singleton
21−-- -- * Creation and elimination
21+ , streamList
22−-- singleton
22+ , unstreamList
23−-- , streamList
23+ , streamCString#
24−-- , unstreamList
24+
25−-- , streamCString#
25+ -- * Basic interface
26−
26+ , cons
27−-- -- * Basic interface
27+ , snoc
28−-- , cons
28+ , append
29−-- , snoc
29+ , head
30−-- , append
30+ , uncons
31−-- , head
31+ , last
32−-- , uncons
32+ , tail
33−-- , last
33+ , init
34−-- , tail
34+ , null
35−-- , init
35+ , lengthI
36−-- , null
36+ , compareLengthI
37−-- , lengthI
37+ , isSingleton
38−-- , compareLengthI
38+
39−-- , isSingleton
39+ -- * Transformations
40−
40+ , map
41−-- -- * Transformations
41+ , intercalate
42−-- , map
42+ , intersperse
43−-- , intercalate
43+
44−-- , intersperse
44+ -- ** Case conversion
45−
45+ -- $case
46−-- -- ** Case conversion
46+ , toCaseFold
47−-- -- $case
47+ , toLower
48−-- , toCaseFold
48+ , toTitle
49−-- , toLower
49+ , toUpper
50−-- , toTitle
50+
51−-- , toUpper
51+ -- ** Justification
52−
52+ , justifyLeftI
53−-- -- ** Justification
53+
54−-- , justifyLeftI
54+ -- * Folds
55−
55+ , foldl
56−-- -- * Folds
56+ , foldl'
57−-- , foldl
57+ , foldl1
58−-- , foldl'
58+ , foldl1'
59−-- , foldl1
59+ , foldr
60−-- , foldl1'
60+ , foldr1
61−-- , foldr
61+
62−-- , foldr1
62+ -- ** Special folds
63−
63+ , concat
64−-- -- ** Special folds
64+ , concatMap
65−-- , concat
65+ , any
66−-- , concatMap
66+ , all
67−-- , any
67+ , maximum
68−-- , all
68+ , minimum
69−-- , maximum
69+
70−-- , minimum
70+ -- * Construction
71−
71+ -- ** Scans
72−-- -- * Construction
72+ , scanl
73−-- -- ** Scans
73+
74−-- , scanl
74+ -- ** Generation and unfolding
75−
75+ , replicateCharI
76−-- -- ** Generation and unfolding
76+ , replicateI
77−-- , replicateCharI
77+ , unfoldr
78−-- , replicateI
78+ , unfoldrNI
79−-- , unfoldr
79+
80−-- , unfoldrNI
80+ -- * Substrings
81−
81+ -- ** Breaking strings
82−-- -- * Substrings
82+ , take
83−-- -- ** Breaking strings
83+ , drop
84−-- , take
84+ , takeWhile
85−-- , drop
85+ , dropWhile
86−-- , takeWhile
86+
87−-- , dropWhile
87+ -- * Predicates
88−
88+ , isPrefixOf
89−-- -- * Predicates
89+
90−-- , isPrefixOf
90+ -- * Searching
91−
91+ , elem
92−-- -- * Searching
92+ , filter
93−-- , elem
93+
94−-- , filter
94+ -- * Indexing
95−
95+ , findBy
96−-- -- * Indexing
96+ , indexI
97−-- , findBy
97+ , findIndexI
98−-- , indexI
98+ , countCharI
99−-- , findIndexI
99+
100−-- , countCharI
100+ -- * Zipping and unzipping
101−
101+ , zipWith
102−-- -- * Zipping and unzipping
102+ ) where
103−-- , zipWith
103+
104−-- ) where
104+import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
105−
105+ Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
106−-- import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
106+ (&&), fromIntegral, otherwise)
107−-- Ord(..), Ordering(..), String, (.), ($), (+), (-), (*), (++),
107+import qualified Data.List as L
108−-- (&&), fromIntegral, otherwise)
108+import qualified Prelude as P
109−-- import qualified Data.List as L
109+import Data.Bits (shiftL)
110−-- import qualified Prelude as P
110+import Data.Char (isLetter)
111−-- import Data.Bits (shiftL)
111+import Data.Int (Int64)
112−-- import Data.Char (isLetter)
112+import Data.Text.Internal.Fusion.Types
113−-- import Data.Int (Int64)
113+import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
114−-- import Data.Text.Internal.Fusion.Types
114+ upperMapping)
115−-- import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
115+import Data.Text.Internal.Fusion.Size
116−-- upperMapping)
116+import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
117−-- import Data.Text.Internal.Fusion.Size
117+import GHC.Types (Char(..), Int(..))
118−-- import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
118+
119−-- import GHC.Types (Char(..), Int(..))
119+singleton :: Char -> Stream Char
120−
120+singleton c = Stream next False 1
121−-- singleton :: Char -> Stream Char
121+ where next False = Yield c True
122−-- singleton c = Stream next False -- 1
122+ next True = Done
123−-- where next False = Yield c True
123+{-# INLINE [0] singleton #-}
124−-- next True = Done
124+
125−-- {-# INLINE [0] singleton #-}
125+streamList :: [a] -> Stream a
126−
126+{-# INLINE [0] streamList #-}
127−-- streamList :: [a] -> Stream a
127+streamList s = Stream next s unknownSize
128−-- {-# INLINE [0] streamList #-}
128+ where next [] = Done
129−-- streamList s = Stream next s -- unknownSize
129+ next (x:xs) = Yield x xs
130−-- where next [] = Done
130+
131−-- next (x:xs) = Yield x xs
131+unstreamList :: Stream a -> [a]
132−
132+unstreamList (Stream next s0 _len) = unfold s0
133−-- unstreamList :: Stream a -> [a]
133+ where unfold !s = case next s of
134−-- -- unstreamList (Stream next s0 _len) = unfold s0
134+ Done -> []
135−-- unstreamList (Stream next s0) = unfold s0
135+ Skip s' -> unfold s'
136−-- where unfold !s = case next s of
136+ Yield x s' -> x : unfold s'
137−-- Done -> []
137+{-# INLINE [0] unstreamList #-}
138−-- Skip s' -> unfold s'
138+
139−-- Yield x s' -> x : unfold s'
139+{-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
140−-- {-# INLINE [0] unstreamList #-}
140+
141−
141+-- | Stream the UTF-8-like packed encoding used by GHC to represent
142−-- {-# RULES "STREAM streamList/unstreamList fusion" forall s. streamList (unstreamList s) = s #-}
142+-- constant strings in generated code.
143−
143+--
144−-- -- | Stream the UTF-8-like packed encoding used by GHC to represent
144+-- This encoding uses the byte sequence "\xc0\x80" to represent NUL,
145−-- -- constant strings in generated code.
145+-- and the string is NUL-terminated.
146−-- --
146+streamCString# :: Addr# -> Stream Char
147−-- -- This encoding uses the byte sequence "\xc0\x80" to represent NUL,
147+streamCString# addr = Stream step 0 unknownSize
148−-- -- and the string is NUL-terminated.
148+ where
149−-- streamCString# :: Addr# -> Stream Char
149+ step !i
150−-- streamCString# addr = Stream step 0 -- unknownSize
150+ | b == 0 = Done
151−-- where
151+ | b <= 0x7f = Yield (C# b#) (i+1)
152−-- step !i
152+ | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1
153−-- | b == 0 = Done
153+ in Yield c (i+2)
154−-- | b <= 0x7f = Yield (C# b#) (i+1)
154+ | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +
155−-- | b <= 0xdf = let !c = chr $ ((b-0xc0) `shiftL` 6) + next 1
155+ (next 1 `shiftL` 6) +
156−-- in Yield c (i+2)
156+ next 2
157−-- | b <= 0xef = let !c = chr $ ((b-0xe0) `shiftL` 12) +
157+ in Yield c (i+3)
158−-- (next 1 `shiftL` 6) +
158+ | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +
159−-- next 2
159+ (next 1 `shiftL` 12) +
160−-- in Yield c (i+3)
160+ (next 2 `shiftL` 6) +
161−-- | otherwise = let !c = chr $ ((b-0xf0) `shiftL` 18) +
161+ next 3
162−-- (next 1 `shiftL` 12) +
162+ in Yield c (i+4)
163−-- (next 2 `shiftL` 6) +
163+ where b = I# (ord# b#)
164−-- next 3
164+ next n = I# (ord# (at# (i+n))) - 0x80
165−-- in Yield c (i+4)
165+ !b# = at# i
166−-- where b = I# (ord# b#)
166+ at# (I# i#) = indexCharOffAddr# addr i#
167−-- next n = I# (ord# (at# (i+n))) - 0x80
167+ chr (I# i#) = C# (chr# i#)
168−-- !b# = at# i
168+{-# INLINE [0] streamCString# #-}
169−-- at# (I# i#) = indexCharOffAddr# addr i#
169+
170−-- chr (I# i#) = C# (chr# i#)
170+-- ----------------------------------------------------------------------------
171−-- {-# INLINE [0] streamCString# #-}
171+-- * Basic stream functions
172−
172+
173−-- -- ----------------------------------------------------------------------------
173+data C s = C0 !s
174−-- -- * Basic stream functions
174+ | C1 !s
175−
175+
176−-- data C s = C0 !s
176+-- | /O(n)/ Adds a character to the front of a Stream Char.
177−-- | C1 !s
177+cons :: Char -> Stream Char -> Stream Char
178−
178+cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
179−-- -- | /O(n)/ Adds a character to the front of a Stream Char.
179+ where
180−-- cons :: Char -> Stream Char -> Stream Char
180+ next (C1 s) = Yield w (C0 s)
181−-- -- cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
181+ next (C0 s) = case next0 s of
182−-- cons !w (Stream next0 s0) = Stream next (C1 s0) -- (len+1)
182+ Done -> Done
183−-- where
183+ Skip s' -> Skip (C0 s')
184−-- next (C1 s) = Yield w (C0 s)
184+ Yield x s' -> Yield x (C0 s')
185−-- next (C0 s) = case next0 s of
185+{-# INLINE [0] cons #-}
186−-- Done -> Done
186+
187−-- Skip s' -> Skip (C0 s')
187+data Snoc a = N
188−-- Yield x s' -> Yield x (C0 s')
188+ | J !a
189−-- {-# INLINE [0] cons #-}
189+
190−
190+-- | /O(n)/ Adds a character to the end of a stream.
191−-- data Snoc a = N
191+snoc :: Stream Char -> Char -> Stream Char
192−-- | J !a
192+snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
193−
193+ where
194−-- -- | /O(n)/ Adds a character to the end of a stream.
194+ next (J xs) = case next0 xs of
195−-- snoc :: Stream Char -> Char -> Stream Char
195+ Done -> Yield w N
196−-- -- snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
196+ Skip xs' -> Skip (J xs')
197−-- snoc (Stream next0 xs0) w = Stream next (J xs0) -- (len+1)
197+ Yield x xs' -> Yield x (J xs')
198−-- where
198+ next N = Done
199−-- next (J xs) = case next0 xs of
199+{-# INLINE [0] snoc #-}
200−-- Done -> Yield w N
200+
201−-- Skip xs' -> Skip (J xs')
201+data E l r = L !l
202−-- Yield x xs' -> Yield x (J xs')
202+ | R !r
203−-- next N = Done
203+
204−-- {-# INLINE [0] snoc #-}
204+-- | /O(n)/ Appends one Stream to the other.
205−
205+append :: Stream Char -> Stream Char -> Stream Char
206−-- data E l r = L !l
206+append (Stream next0 s01 len1) (Stream next1 s02 len2) =
207−-- | R !r
207+ Stream next (L s01) (len1 + len2)
208−
208+ where
209−-- -- | /O(n)/ Appends one Stream to the other.
209+ next (L s1) = case next0 s1 of
210−-- append :: Stream Char -> Stream Char -> Stream Char
210+ Done -> Skip (R s02)
211−-- -- append (Stream next0 s01 len1) (Stream next1 s02 len2) =
211+ Skip s1' -> Skip (L s1')
212−-- -- Stream next (L s01) (len1 + len2)
212+ Yield x s1' -> Yield x (L s1')
213−-- append (Stream next0 s01) (Stream next1 s02) =
213+ next (R s2) = case next1 s2 of
214−-- Stream next (L s01)
214+ Done -> Done
215−-- where
215+ Skip s2' -> Skip (R s2')
216−-- next (L s1) = case next0 s1 of
216+ Yield x s2' -> Yield x (R s2')
217−-- Done -> Skip (R s02)
217+{-# INLINE [0] append #-}
218−-- Skip s1' -> Skip (L s1')
218+
219−-- Yield x s1' -> Yield x (L s1')
219+-- | /O(1)/ Returns the first character of a Text, which must be non-empty.
220−-- next (R s2) = case next1 s2 of
220+-- Subject to array fusion.
221−-- Done -> Done
221+head :: Stream Char -> Char
222−-- Skip s2' -> Skip (R s2')
222+head (Stream next s0 _len) = loop_head s0
223−-- Yield x s2' -> Yield x (R s2')
223+ where
224−-- {-# INLINE [0] append #-}
224+ loop_head !s = case next s of
225−
225+ Yield x _ -> x
226−-- -- | /O(1)/ Returns the first character of a Text, which must be non-empty.
226+ Skip s' -> loop_head s'
227−-- -- Subject to array fusion.
227+ Done -> head_empty
228−-- head :: Stream Char -> Char
228+{-# INLINE [0] head #-}
229−-- -- head (Stream next s0 _len) = loop_head s0
229+
230−-- head (Stream next s0) = loop_head s0
230+head_empty :: a
231−-- where
231+head_empty = streamError "head" "Empty stream"
232−-- loop_head !s = case next s of
232+{-# NOINLINE head_empty #-}
233−-- Yield x _ -> x
233+
234−-- Skip s' -> loop_head s'
234+-- | /O(1)/ Returns the first character and remainder of a 'Stream
235−-- Done -> head_empty
235+-- Char', or 'Nothing' if empty. Subject to array fusion.
236−-- {-# INLINE [0] head #-}
236+uncons :: Stream Char -> Maybe (Char, Stream Char)
237−
237+uncons (Stream next s0 len) = loop_uncons s0
238−-- head_empty :: a
238+ where
239−-- head_empty = streamError "head" "Empty stream"
239+ loop_uncons !s = case next s of
240−-- {-# NOINLINE head_empty #-}
240+ Yield x s1 -> Just (x, Stream next s1 (len-1))
241−
241+ Skip s' -> loop_uncons s'
242−-- -- | /O(1)/ Returns the first character and remainder of a 'Stream
242+ Done -> Nothing
243−-- -- Char', or 'Nothing' if empty. Subject to array fusion.
243+{-# INLINE [0] uncons #-}
244−-- uncons :: Stream Char -> Maybe (Char, Stream Char)
244+
245−-- -- uncons (Stream next s0 len) = loop_uncons s0
245+-- | /O(n)/ Returns the last character of a 'Stream Char', which must
246−-- uncons (Stream next s0) = loop_uncons s0
246+-- be non-empty.
247−-- where
247+last :: Stream Char -> Char
248−-- loop_uncons !s = case next s of
248+last (Stream next s0 _len) = loop0_last s0
249−-- Yield x s1 -> Just (x, Stream next s1)
249+ where
250−-- Skip s' -> loop_uncons s'
250+ loop0_last !s = case next s of
251−-- Done -> Nothing
251+ Done -> emptyError "last"
252−-- {-# INLINE [0] uncons #-}
252+ Skip s' -> loop0_last s'
253−
253+ Yield x s' -> loop_last x s'
254−-- -- | /O(n)/ Returns the last character of a 'Stream Char', which must
254+ loop_last !x !s = case next s of
255−-- -- be non-empty.
255+ Done -> x
256−-- last :: Stream Char -> Char
256+ Skip s' -> loop_last x s'
257−-- -- last (Stream next s0 _len) = loop0_last s0
257+ Yield x' s' -> loop_last x' s'
258−-- last (Stream next s0) = loop0_last s0
258+{-# INLINE[0] last #-}
259−-- where
259+
260−-- loop0_last !s = case next s of
260+-- | /O(1)/ Returns all characters after the head of a Stream Char, which must
261−-- Done -> emptyError "last"
261+-- be non-empty.
262−-- Skip s' -> loop0_last s'
262+tail :: Stream Char -> Stream Char
263−-- Yield x s' -> loop_last x s'
263+tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
264−-- loop_last !x !s = case next s of
264+ where
265−-- Done -> x
265+ next (C0 s) = case next0 s of
266−-- Skip s' -> loop_last x s'
266+ Done -> emptyError "tail"
267−-- Yield x' s' -> loop_last x' s'
267+ Skip s' -> Skip (C0 s')
268−-- {-# INLINE[0] last #-}
268+ Yield _ s' -> Skip (C1 s')
269−
269+ next (C1 s) = case next0 s of
270−-- -- | /O(1)/ Returns all characters after the head of a Stream Char, which must
270+ Done -> Done
271−-- -- be non-empty.
271+ Skip s' -> Skip (C1 s')
272−-- tail :: Stream Char -> Stream Char
272+ Yield x s' -> Yield x (C1 s')
273−-- -- tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
273+{-# INLINE [0] tail #-}
274−-- tail (Stream next0 s0) = Stream next (C0 s0) -- (len-1)
274+
275−-- where
275+data Init s = Init0 !s
276−-- next (C0 s) = case next0 s of
276+ | Init1 {-# UNPACK #-} !Char !s
277−-- Done -> emptyError "tail"
277+
278−-- Skip s' -> Skip (C0 s')
278+-- | /O(1)/ Returns all but the last character of a Stream Char, which
279−-- Yield _ s' -> Skip (C1 s')
279+-- must be non-empty.
280−-- next (C1 s) = case next0 s of
280+init :: Stream Char -> Stream Char
281−-- Done -> Done
281+init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
282−-- Skip s' -> Skip (C1 s')
282+ where
283−-- Yield x s' -> Yield x (C1 s')
283+ next (Init0 s) = case next0 s of
284−-- {-# INLINE [0] tail #-}
284+ Done -> emptyError "init"
285−
285+ Skip s' -> Skip (Init0 s')
286−-- data Init s = Init0 !s
286+ Yield x s' -> Skip (Init1 x s')
287−-- | Init1 {-# UNPACK #-} !Char !s
287+ next (Init1 x s) = case next0 s of
288−
288+ Done -> Done
289−-- -- | /O(1)/ Returns all but the last character of a Stream Char, which
289+ Skip s' -> Skip (Init1 x s')
290−-- -- must be non-empty.
290+ Yield x' s' -> Yield x (Init1 x' s')
291−-- init :: Stream Char -> Stream Char
291+{-# INLINE [0] init #-}
292−-- -- init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
292+
293−-- init (Stream next0 s0) = Stream next (Init0 s0) -- (len-1)
293+-- | /O(1)/ Tests whether a Stream Char is empty or not.
294−-- where
294+null :: Stream Char -> Bool
295−-- next (Init0 s) = case next0 s of
295+null (Stream next s0 _len) = loop_null s0
296−-- Done -> emptyError "init"
296+ where
297−-- Skip s' -> Skip (Init0 s')
297+ loop_null !s = case next s of
298−-- Yield x s' -> Skip (Init1 x s')
298+ Done -> True
299−-- next (Init1 x s) = case next0 s of
299+ Yield _ _ -> False
300−-- Done -> Done
300+ Skip s' -> loop_null s'
301−-- Skip s' -> Skip (Init1 x s')
301+{-# INLINE[0] null #-}
302−-- Yield x' s' -> Yield x (Init1 x' s')
302+
303−-- {-# INLINE [0] init #-}
303+-- | /O(n)/ Returns the number of characters in a string.
304−
304+lengthI :: Integral a => Stream Char -> a
305−-- -- | /O(1)/ Tests whether a Stream Char is empty or not.
305+lengthI (Stream next s0 _len) = loop_length 0 s0
306−-- null :: Stream Char -> Bool
306+ where
307−-- -- null (Stream next s0 _len) = loop_null s0
307+ loop_length !z s = case next s of
308−-- null (Stream next s0) = loop_null s0
308+ Done -> z
309−-- where
309+ Skip s' -> loop_length z s'
310−-- loop_null !s = case next s of
310+ Yield _ s' -> loop_length (z + 1) s'
311−-- Done -> True
311+{-# INLINE[0] lengthI #-}
312−-- Yield _ _ -> False
312+
313−-- Skip s' -> loop_null s'
313+-- | /O(n)/ Compares the count of characters in a string to a number.
314−-- {-# INLINE[0] null #-}
314+-- Subject to fusion.
315−
315+--
316−-- -- | /O(n)/ Returns the number of characters in a string.
316+-- This function gives the same answer as comparing against the result
317−-- lengthI :: Integral a => Stream Char -> a
317+-- of 'lengthI', but can short circuit if the count of characters is
318−-- -- lengthI (Stream next s0 _len) = loop_length 0 s0
318+-- greater than the number or if the stream can't possibly be as long
319−-- lengthI (Stream next s0) = loop_length 0 s0
319+-- as the number supplied, and hence be more efficient.
320−-- where
320+compareLengthI :: Integral a => Stream Char -> a -> Ordering
321−-- loop_length !z s = case next s of
321+compareLengthI (Stream next s0 len) n =
322−-- Done -> z
322+ case compareSize len (fromIntegral n) of
323−-- Skip s' -> loop_length z s'
323+ Just o -> o
324−-- Yield _ s' -> loop_length (z + 1) s'
324+ Nothing -> loop_cmp 0 s0
325−-- {-# INLINE[0] lengthI #-}
325+ where
326−
326+ loop_cmp !z s = case next s of
327−-- -- | /O(n)/ Compares the count of characters in a string to a number.
327+ Done -> compare z n
328−-- -- Subject to fusion.
328+ Skip s' -> loop_cmp z s'
329−-- --
329+ Yield _ s' | z > n -> GT
330−-- -- This function gives the same answer as comparing against the result
330+ | otherwise -> loop_cmp (z + 1) s'
331−-- -- of 'lengthI', but can short circuit if the count of characters is
331+{-# INLINE[0] compareLengthI #-}
332−-- -- greater than the number or if the stream can't possibly be as long
332+
333−-- -- as the number supplied, and hence be more efficient.
333+-- | /O(n)/ Indicate whether a string contains exactly one element.
334−-- compareLengthI :: Integral a => Stream Char -> a -> Ordering
334+isSingleton :: Stream Char -> Bool
335−-- -- compareLengthI (Stream next s0 len) n =
335+isSingleton (Stream next s0 _len) = loop 0 s0
336−-- compareLengthI (Stream next s0) n =
336+ where
337−-- -- case compareSize len (fromIntegral n) of
337+ loop !z s = case next s of
338−-- -- Just o -> o
338+ Done -> z == (1::Int)
339−-- -- Nothing -> loop_cmp 0 s0
339+ Skip s' -> loop z s'
340−-- loop_cmp 0 s0
340+ Yield _ s'
341−-- where
341+ | z >= 1 -> False
342−-- loop_cmp !z s = case next s of
342+ | otherwise -> loop (z+1) s'
343−-- Done -> compare z n
343+{-# INLINE[0] isSingleton #-}
344−-- Skip s' -> loop_cmp z s'
344+
345−-- Yield _ s' | z > n -> GT
345+-- ----------------------------------------------------------------------------
346−-- | otherwise -> loop_cmp (z + 1) s'
346+-- * Stream transformations
347−-- {-# INLINE[0] compareLengthI #-}
347+
348−
348+-- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@
349−-- -- | /O(n)/ Indicate whether a string contains exactly one element.
349+-- to each element of @xs@.
350−-- isSingleton :: Stream Char -> Bool
350+map :: (Char -> Char) -> Stream Char -> Stream Char
351−-- -- isSingleton (Stream next s0 _len) = loop 0 s0
351+map f (Stream next0 s0 len) = Stream next s0 len
352−-- isSingleton (Stream next s0) = loop 0 s0
352+ where
353−-- where
353+ next !s = case next0 s of
354−-- loop !z s = case next s of
354+ Done -> Done
355−-- Done -> z == (1::Int)
355+ Skip s' -> Skip s'
356−-- Skip s' -> loop z s'
356+ Yield x s' -> Yield (f x) s'
357−-- Yield _ s'
357+{-# INLINE [0] map #-}
358−-- | z >= 1 -> False
358+
359−-- | otherwise -> loop (z+1) s'
359+{-#
360−-- {-# INLINE[0] isSingleton #-}
360+ RULES "STREAM map/map fusion" forall f g s.
361−
361+ map f (map g s) = map (\x -> f (g x)) s
362−-- -- ----------------------------------------------------------------------------
362+ #-}
363−-- -- * Stream transformations
363+
364−
364+data I s = I1 !s
365−-- -- | /O(n)/ 'map' @f @xs is the Stream Char obtained by applying @f@
365+ | I2 !s {-# UNPACK #-} !Char
366−-- -- to each element of @xs@.
366+ | I3 !s
367−-- map :: (Char -> Char) -> Stream Char -> Stream Char
367+
368−-- -- map f (Stream next0 s0 len) = Stream next s0 len
368+-- | /O(n)/ Take a character and place it between each of the
369−-- map f (Stream next0 s0) = Stream next s0 -- len
369+-- characters of a 'Stream Char'.
370−-- where
370+intersperse :: Char -> Stream Char -> Stream Char
371−-- next !s = case next0 s of
371+intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
372−-- Done -> Done
372+ where
373−-- Skip s' -> Skip s'
373+ next (I1 s) = case next0 s of
374−-- Yield x s' -> Yield (f x) s'
374+ Done -> Done
375−-- {-# INLINE [0] map #-}
375+ Skip s' -> Skip (I1 s')
376−
376+ Yield x s' -> Skip (I2 s' x)
377−-- {-#
377+ next (I2 s x) = Yield x (I3 s)
378−-- RULES "STREAM map/map fusion" forall f g s.
378+ next (I3 s) = case next0 s of
379−-- map f (map g s) = map (\x -> f (g x)) s
379+ Done -> Done
380−-- #-}
380+ Skip s' -> Skip (I3 s')
381−
381+ Yield x s' -> Yield c (I2 s' x)
382−-- data I s = I1 !s
382+{-# INLINE [0] intersperse #-}
383−-- | I2 !s {-# UNPACK #-} !Char
383+
384−-- | I3 !s
384+-- ----------------------------------------------------------------------------
385−
385+-- ** Case conversions (folds)
386−-- -- | /O(n)/ Take a character and place it between each of the
386+
387−-- -- characters of a 'Stream Char'.
387+-- $case
388−-- intersperse :: Char -> Stream Char -> Stream Char
388+--
389−-- intersperse c (Stream next0 s0) = Stream next (I1 s0) -- len
389+-- With Unicode text, it is incorrect to use combinators like @map
390−-- -- intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
390+-- toUpper@ to case convert each character of a string individually.
391−-- where
391+-- Instead, use the whole-string case conversion functions from this
392−-- next (I1 s) = case next0 s of
392+-- module. For correctness in different writing systems, these
393−-- Done -> Done
393+-- functions may map one input character to two or three output
394−-- Skip s' -> Skip (I1 s')
394+-- characters.
395−-- Yield x s' -> Skip (I2 s' x)
395+
396−-- next (I2 s x) = Yield x (I3 s)
396+caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
397−-- next (I3 s) = case next0 s of
397+ -> Stream Char -> Stream Char
398−-- Done -> Done
398+caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
399−-- Skip s' -> Skip (I3 s')
399+ where
400−-- Yield x s' -> Yield c (I2 s' x)
400+ next (CC s '\0' _) =
401−-- {-# INLINE [0] intersperse #-}
401+ case next0 s of
402−
402+ Done -> Done
403−-- -- ----------------------------------------------------------------------------
403+ Skip s' -> Skip (CC s' '\0' '\0')
404−-- -- ** Case conversions (folds)
404+ Yield c s' -> remap c s'
405−
405+ next (CC s a b) = Yield a (CC s b '\0')
406−-- -- $case
406+
407−-- --
407+-- | /O(n)/ Convert a string to folded case. This function is mainly
408−-- -- With Unicode text, it is incorrect to use combinators like @map
408+-- useful for performing caseless (or case insensitive) string
409−-- -- toUpper@ to case convert each character of a string individually.
409+-- comparisons.
410−-- -- Instead, use the whole-string case conversion functions from this
410+--
411−-- -- module. For correctness in different writing systems, these
411+-- A string @x@ is a caseless match for a string @y@ if and only if:
412−-- -- functions may map one input character to two or three output
412+--
413−-- -- characters.
413+-- @toCaseFold x == toCaseFold y@
414−
414+--
415−-- caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
415+-- The result string may be longer than the input string, and may
416−-- -> Stream Char -> Stream Char
416+-- differ from applying 'toLower' to the input string. For instance,
417−-- -- caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
417+-- the Armenian small ligature men now (U+FB13) is case folded to the
418−-- caseConvert remap (Stream next0 s0) = Stream next (CC s0 '\0' '\0') -- len
418+-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is
419−-- where
419+-- case folded to the Greek small letter letter mu (U+03BC) instead of
420−-- next (CC s '\0' _) =
420+-- itself.
421−-- case next0 s of
421+toCaseFold :: Stream Char -> Stream Char
422−-- Done -> Done
422+toCaseFold = caseConvert foldMapping
423−-- Skip s' -> Skip (CC s' '\0' '\0')
423+{-# INLINE [0] toCaseFold #-}
424−-- Yield c s' -> remap c s'
424+
425−-- next (CC s a b) = Yield a (CC s b '\0')
425+-- | /O(n)/ Convert a string to upper case, using simple case
426−
426+-- conversion. The result string may be longer than the input string.
427−-- -- | /O(n)/ Convert a string to folded case. This function is mainly
427+-- For instance, the German eszett (U+00DF) maps to the two-letter
428−-- -- useful for performing caseless (or case insensitive) string
428+-- sequence SS.
429−-- -- comparisons.
429+toUpper :: Stream Char -> Stream Char
430−-- --
430+toUpper = caseConvert upperMapping
431−-- -- A string @x@ is a caseless match for a string @y@ if and only if:
431+{-# INLINE [0] toUpper #-}
432−-- --
432+
433−-- -- @toCaseFold x == toCaseFold y@
433+-- | /O(n)/ Convert a string to lower case, using simple case
434−-- --
434+-- conversion. The result string may be longer than the input string.
435−-- -- The result string may be longer than the input string, and may
435+-- For instance, the Latin capital letter I with dot above (U+0130)
436−-- -- differ from applying 'toLower' to the input string. For instance,
436+-- maps to the sequence Latin small letter i (U+0069) followed by
437−-- -- the Armenian small ligature men now (U+FB13) is case folded to the
437+-- combining dot above (U+0307).
438−-- -- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is
438+toLower :: Stream Char -> Stream Char
439−-- -- case folded to the Greek small letter letter mu (U+03BC) instead of
439+toLower = caseConvert lowerMapping
440−-- -- itself.
440+{-# INLINE [0] toLower #-}
441−-- toCaseFold :: Stream Char -> Stream Char
441+
442−-- toCaseFold = caseConvert foldMapping
442+-- | /O(n)/ Convert a string to title case, using simple case
443−-- {-# INLINE [0] toCaseFold #-}
443+-- conversion.
444−
444+--
445−-- -- | /O(n)/ Convert a string to upper case, using simple case
445+-- The first letter of the input is converted to title case, as is
446−-- -- conversion. The result string may be longer than the input string.
446+-- every subsequent letter that immediately follows a non-letter.
447−-- -- For instance, the German eszett (U+00DF) maps to the two-letter
447+-- Every letter that immediately follows another letter is converted
448−-- -- sequence SS.
448+-- to lower case.
449−-- toUpper :: Stream Char -> Stream Char
449+--
450−-- toUpper = caseConvert upperMapping
450+-- The result string may be longer than the input string. For example,
451−-- {-# INLINE [0] toUpper #-}
451+-- the Latin small ligature &#xfb02; (U+FB02) is converted to the
452−
452+-- sequence Latin capital letter F (U+0046) followed by Latin small
453−-- -- | /O(n)/ Convert a string to lower case, using simple case
453+-- letter l (U+006C).
454−-- -- conversion. The result string may be longer than the input string.
454+--
455−-- -- For instance, the Latin capital letter I with dot above (U+0130)
455+-- /Note/: this function does not take language or culture specific
456−-- -- maps to the sequence Latin small letter i (U+0069) followed by
456+-- rules into account. For instance, in English, different style
457−-- -- combining dot above (U+0307).
457+-- guides disagree on whether the book name \"The Hill of the Red
458−-- toLower :: Stream Char -> Stream Char
458+-- Fox\" is correctly title cased&#x2014;but this function will
459−-- toLower = caseConvert lowerMapping
459+-- capitalize /every/ word.
460−-- {-# INLINE [0] toLower #-}
460+toTitle :: Stream Char -> Stream Char
461−
461+toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
462−-- -- | /O(n)/ Convert a string to title case, using simple case
462+ where
463−-- -- conversion.
463+ next (CC (letter :*: s) '\0' _) =
464−-- --
464+ case next0 s of
465−-- -- The first letter of the input is converted to title case, as is
465+ Done -> Done
466−-- -- every subsequent letter that immediately follows a non-letter.
466+ Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
467−-- -- Every letter that immediately follows another letter is converted
467+ Yield c s'
468−-- -- to lower case.
468+ | letter' -> if letter
469−-- --
469+ then lowerMapping c (letter' :*: s')
470−-- -- The result string may be longer than the input string. For example,
470+ else titleMapping c (letter' :*: s')
471−-- -- the Latin small ligature &#xfb02; (U+FB02) is converted to the
471+ | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
472−-- -- sequence Latin capital letter F (U+0046) followed by Latin small
472+ where letter' = isLetter c
473−-- -- letter l (U+006C).
473+ next (CC s a b) = Yield a (CC s b '\0')
474−-- --
474+{-# INLINE [0] toTitle #-}
475−-- -- /Note/: this function does not take language or culture specific
475+
476−-- -- rules into account. For instance, in English, different style
476+data Justify i s = Just1 !i !s
477−-- -- guides disagree on whether the book name \"The Hill of the Red
477+ | Just2 !i !s
478−-- -- Fox\" is correctly title cased&#x2014;but this function will
478+
479−-- -- capitalize /every/ word.
479+justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
480−-- toTitle :: Stream Char -> Stream Char
480+justifyLeftI k c (Stream next0 s0 len) =
481−-- -- toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
481+ Stream next (Just1 0 s0) (larger (fromIntegral k) len)
482−-- toTitle (Stream next0 s0) = Stream next (CC (False :*: s0) '\0' '\0') -- len
482+ where
483−-- where
483+ next (Just1 n s) =
484−-- next (CC (letter :*: s) '\0' _) =
484+ case next0 s of
485−-- case next0 s of
485+ Done -> next (Just2 n s)
486−-- Done -> Done
486+ Skip s' -> Skip (Just1 n s')
487−-- Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
487+ Yield x s' -> Yield x (Just1 (n+1) s')
488−-- Yield c s'
488+ next (Just2 n s)
489−-- | letter' -> if letter
489+ | n < k = Yield c (Just2 (n+1) s)
490−-- then lowerMapping c (letter' :*: s')
490+ | otherwise = Done
491−-- else titleMapping c (letter' :*: s')
491+ {-# INLINE next #-}
492−-- | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
492+{-# INLINE [0] justifyLeftI #-}
493−-- where letter' = isLetter c
493+
494−-- next (CC s a b) = Yield a (CC s b '\0')
494+-- ----------------------------------------------------------------------------
495−-- {-# INLINE [0] toTitle #-}
495+-- * Reducing Streams (folds)
496−
496+
497−-- data Justify i s = Just1 !i !s
497+-- | foldl, applied to a binary operator, a starting value (typically the
498−-- | Just2 !i !s
498+-- left-identity of the operator), and a Stream, reduces the Stream using the
499−
499+-- binary operator, from left to right.
500−-- justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
500+foldl :: (b -> Char -> b) -> b -> Stream Char -> b
501−-- -- justifyLeftI k c (Stream next0 s0 len) =
501+foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0
502−-- justifyLeftI k c (Stream next0 s0) =
502+ where
503−-- Stream next (Just1 0 s0) -- (larger (fromIntegral k) len)
503+ loop_foldl z !s = case next s of
504−-- where
504+ Done -> z
505−-- next (Just1 n s) =
505+ Skip s' -> loop_foldl z s'
506−-- case next0 s of
506+ Yield x s' -> loop_foldl (f z x) s'
507−-- Done -> next (Just2 n s)
507+{-# INLINE [0] foldl #-}
508−-- Skip s' -> Skip (Just1 n s')
508+
509−-- Yield x s' -> Yield x (Just1 (n+1) s')
509+-- | A strict version of foldl.
510−-- next (Just2 n s)
510+foldl' :: (b -> Char -> b) -> b -> Stream Char -> b
511−-- | n < k = Yield c (Just2 (n+1) s)
511+foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0
512−-- | otherwise = Done
512+ where
513−-- {-# INLINE next #-}
513+ loop_foldl' !z !s = case next s of
514−-- {-# INLINE [0] justifyLeftI #-}
514+ Done -> z
515−
515+ Skip s' -> loop_foldl' z s'
516−-- -- ----------------------------------------------------------------------------
516+ Yield x s' -> loop_foldl' (f z x) s'
517−-- -- * Reducing Streams (folds)
517+{-# INLINE [0] foldl' #-}
518−
518+
519−-- -- | foldl, applied to a binary operator, a starting value (typically the
519+-- | foldl1 is a variant of foldl that has no starting value argument,
520−-- -- left-identity of the operator), and a Stream, reduces the Stream using the
520+-- and thus must be applied to non-empty Streams.
521−-- -- binary operator, from left to right.
521+foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char
522−-- foldl :: (b -> Char -> b) -> b -> Stream Char -> b
522+foldl1 f (Stream next s0 _len) = loop0_foldl1 s0
523−-- -- foldl f z0 (Stream next s0 _len) = loop_foldl z0 s0
523+ where
524−-- foldl f z0 (Stream next s0) = loop_foldl z0 s0
524+ loop0_foldl1 !s = case next s of
525−-- where
525+ Skip s' -> loop0_foldl1 s'
526−-- loop_foldl z !s = case next s of
526+ Yield x s' -> loop_foldl1 x s'
527−-- Done -> z
527+ Done -> emptyError "foldl1"
528−-- Skip s' -> loop_foldl z s'
528+ loop_foldl1 z !s = case next s of
529−-- Yield x s' -> loop_foldl (f z x) s'
529+ Done -> z
530−-- {-# INLINE [0] foldl #-}
530+ Skip s' -> loop_foldl1 z s'
531−
531+ Yield x s' -> loop_foldl1 (f z x) s'
532−-- -- | A strict version of foldl.
532+{-# INLINE [0] foldl1 #-}
533−-- foldl' :: (b -> Char -> b) -> b -> Stream Char -> b
533+
534−-- -- foldl' f z0 (Stream next s0 _len) = loop_foldl' z0 s0
534+-- | A strict version of foldl1.
535−-- foldl' f z0 (Stream next s0) = loop_foldl' z0 s0
535+foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char
536−-- where
536+foldl1' f (Stream next s0 _len) = loop0_foldl1' s0
537−-- loop_foldl' !z !s = case next s of
537+ where
538−-- Done -> z
538+ loop0_foldl1' !s = case next s of
539−-- Skip s' -> loop_foldl' z s'
539+ Skip s' -> loop0_foldl1' s'
540−-- Yield x s' -> loop_foldl' (f z x) s'
540+ Yield x s' -> loop_foldl1' x s'
541−-- {-# INLINE [0] foldl' #-}
541+ Done -> emptyError "foldl1"
542−
542+ loop_foldl1' !z !s = case next s of
543−-- -- | foldl1 is a variant of foldl that has no starting value argument,
543+ Done -> z
544−-- -- and thus must be applied to non-empty Streams.
544+ Skip s' -> loop_foldl1' z s'
545−-- foldl1 :: (Char -> Char -> Char) -> Stream Char -> Char
545+ Yield x s' -> loop_foldl1' (f z x) s'
546−-- -- foldl1 f (Stream next s0 _len) = loop0_foldl1 s0
546+{-# INLINE [0] foldl1' #-}
547−-- foldl1 f (Stream next s0) = loop0_foldl1 s0
547+
548−-- where
548+-- | 'foldr', applied to a binary operator, a starting value (typically the
549−-- loop0_foldl1 !s = case next s of
549+-- right-identity of the operator), and a stream, reduces the stream using the
550−-- Skip s' -> loop0_foldl1 s'
550+-- binary operator, from right to left.
551−-- Yield x s' -> loop_foldl1 x s'
551+foldr :: (Char -> b -> b) -> b -> Stream Char -> b
552−-- Done -> emptyError "foldl1"
552+foldr f z (Stream next s0 _len) = loop_foldr s0
553−-- loop_foldl1 z !s = case next s of
553+ where
554−-- Done -> z
554+ loop_foldr !s = case next s of
555−-- Skip s' -> loop_foldl1 z s'
555+ Done -> z
556−-- Yield x s' -> loop_foldl1 (f z x) s'
556+ Skip s' -> loop_foldr s'
557−-- {-# INLINE [0] foldl1 #-}
557+ Yield x s' -> f x (loop_foldr s')
558−
558+{-# INLINE [0] foldr #-}
559−-- -- | A strict version of foldl1.
559+
560−-- foldl1' :: (Char -> Char -> Char) -> Stream Char -> Char
560+-- | foldr1 is a variant of 'foldr' that has no starting value argument,
561−-- -- foldl1' f (Stream next s0 _len) = loop0_foldl1' s0
561+-- and thus must be applied to non-empty streams.
562−-- foldl1' f (Stream next s0) = loop0_foldl1' s0
562+-- Subject to array fusion.
563−-- where
563+foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char
564−-- loop0_foldl1' !s = case next s of
564+foldr1 f (Stream next s0 _len) = loop0_foldr1 s0
565−-- Skip s' -> loop0_foldl1' s'
565+ where
566−-- Yield x s' -> loop_foldl1' x s'
566+ loop0_foldr1 !s = case next s of
567−-- Done -> emptyError "foldl1"
567+ Done -> emptyError "foldr1"
568−-- loop_foldl1' !z !s = case next s of
568+ Skip s' -> loop0_foldr1 s'
569−-- Done -> z
569+ Yield x s' -> loop_foldr1 x s'
570−-- Skip s' -> loop_foldl1' z s'
570+
571−-- Yield x s' -> loop_foldl1' (f z x) s'
571+ loop_foldr1 x !s = case next s of
572−-- {-# INLINE [0] foldl1' #-}
572+ Done -> x
573−
573+ Skip s' -> loop_foldr1 x s'
574−-- -- | 'foldr', applied to a binary operator, a starting value (typically the
574+ Yield x' s' -> f x (loop_foldr1 x' s')
575−-- -- right-identity of the operator), and a stream, reduces the stream using the
575+{-# INLINE [0] foldr1 #-}
576−-- -- binary operator, from right to left.
576+
577−-- foldr :: (Char -> b -> b) -> b -> Stream Char -> b
577+intercalate :: Stream Char -> [Stream Char] -> Stream Char
578−-- -- foldr f z (Stream next s0 _len) = loop_foldr s0
578+intercalate s = concat . (L.intersperse s)
579−-- foldr f z (Stream next s0) = loop_foldr s0
579+{-# INLINE [0] intercalate #-}
580−-- where
580+
581−-- loop_foldr !s = case next s of
581+-- ----------------------------------------------------------------------------
582−-- Done -> z
582+-- ** Special folds
583−-- Skip s' -> loop_foldr s'
583+
584−-- Yield x s' -> f x (loop_foldr s')
584+-- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
585−-- {-# INLINE [0] foldr #-}
585+concat :: [Stream Char] -> Stream Char
586−
586+concat = L.foldr append empty
587−-- -- | foldr1 is a variant of 'foldr' that has no starting value argument,
587+{-# INLINE [0] concat #-}
588−-- -- and thus must be applied to non-empty streams.
588+
589−-- -- Subject to array fusion.
589+-- | Map a function over a stream that results in a stream and concatenate the
590−-- foldr1 :: (Char -> Char -> Char) -> Stream Char -> Char
590+-- results.
591−-- -- foldr1 f (Stream next s0 _len) = loop0_foldr1 s0
591+concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
592−-- foldr1 f (Stream next s0) = loop0_foldr1 s0
592+concatMap f = foldr (append . f) empty
593−-- where
593+{-# INLINE [0] concatMap #-}
594−-- loop0_foldr1 !s = case next s of
594+
595−-- Done -> emptyError "foldr1"
595+-- | /O(n)/ any @p @xs determines if any character in the stream
596−-- Skip s' -> loop0_foldr1 s'
596+-- @xs@ satisfies the predicate @p@.
597−-- Yield x s' -> loop_foldr1 x s'
597+any :: (Char -> Bool) -> Stream Char -> Bool
598−
598+any p (Stream next0 s0 _len) = loop_any s0
599−-- loop_foldr1 x !s = case next s of
599+ where
600−-- Done -> x
600+ loop_any !s = case next0 s of
601−-- Skip s' -> loop_foldr1 x s'
601+ Done -> False
602−-- Yield x' s' -> f x (loop_foldr1 x' s')
602+ Skip s' -> loop_any s'
603−-- {-# INLINE [0] foldr1 #-}
603+ Yield x s' | p x -> True
604−
604+ | otherwise -> loop_any s'
605−-- intercalate :: Stream Char -> [Stream Char] -> Stream Char
605+{-# INLINE [0] any #-}
606−-- intercalate s = concat . (L.intersperse s)
606+
607−-- {-# INLINE [0] intercalate #-}
607+-- | /O(n)/ all @p @xs determines if all characters in the 'Text'
608−
608+-- @xs@ satisfy the predicate @p@.
609−-- -- ----------------------------------------------------------------------------
609+all :: (Char -> Bool) -> Stream Char -> Bool
610−-- -- ** Special folds
610+all p (Stream next0 s0 _len) = loop_all s0
611−
611+ where
612−-- -- | /O(n)/ Concatenate a list of streams. Subject to array fusion.
612+ loop_all !s = case next0 s of
613−-- concat :: [Stream Char] -> Stream Char
613+ Done -> True
614−-- concat = L.foldr append empty
614+ Skip s' -> loop_all s'
615−-- {-# INLINE [0] concat #-}
615+ Yield x s' | p x -> loop_all s'
616−
616+ | otherwise -> False
617−-- -- | Map a function over a stream that results in a stream and concatenate the
617+{-# INLINE [0] all #-}
618−-- -- results.
618+
619−-- concatMap :: (Char -> Stream Char) -> Stream Char -> Stream Char
619+-- | /O(n)/ maximum returns the maximum value from a stream, which must be
620−-- concatMap f = foldr (append . f) empty
620+-- non-empty.
621−-- {-# INLINE [0] concatMap #-}
621+maximum :: Stream Char -> Char
622−
622+maximum (Stream next0 s0 _len) = loop0_maximum s0
623−-- -- | /O(n)/ any @p @xs determines if any character in the stream
623+ where
624−-- -- @xs@ satisfies the predicate @p@.
624+ loop0_maximum !s = case next0 s of
625−-- any :: (Char -> Bool) -> Stream Char -> Bool
625+ Done -> emptyError "maximum"
626−-- -- any p (Stream next0 s0 _len) = loop_any s0
626+ Skip s' -> loop0_maximum s'
627−-- any p (Stream next0 s0) = loop_any s0
627+ Yield x s' -> loop_maximum x s'
628−-- where
628+ loop_maximum !z !s = case next0 s of
629−-- loop_any !s = case next0 s of
629+ Done -> z
630−-- Done -> False
630+ Skip s' -> loop_maximum z s'
631−-- Skip s' -> loop_any s'
631+ Yield x s'
632−-- Yield x s' | p x -> True
632+ | x > z -> loop_maximum x s'
633−-- | otherwise -> loop_any s'
633+ | otherwise -> loop_maximum z s'
634−-- {-# INLINE [0] any #-}
634+{-# INLINE [0] maximum #-}
635−
635+
636−-- -- | /O(n)/ all @p @xs determines if all characters in the 'Text'
636+-- | /O(n)/ minimum returns the minimum value from a 'Text', which must be
637−-- -- @xs@ satisfy the predicate @p@.
637+-- non-empty.
638−-- all :: (Char -> Bool) -> Stream Char -> Bool
638+minimum :: Stream Char -> Char
639−-- -- all p (Stream next0 s0 _len) = loop_all s0
639+minimum (Stream next0 s0 _len) = loop0_minimum s0
640−-- all p (Stream next0 s0) = loop_all s0
640+ where
641−-- where
641+ loop0_minimum !s = case next0 s of
642−-- loop_all !s = case next0 s of
642+ Done -> emptyError "minimum"
643−-- Done -> True
643+ Skip s' -> loop0_minimum s'
644−-- Skip s' -> loop_all s'
644+ Yield x s' -> loop_minimum x s'
645−-- Yield x s' | p x -> loop_all s'
645+ loop_minimum !z !s = case next0 s of
646−-- | otherwise -> False
646+ Done -> z
647−-- {-# INLINE [0] all #-}
647+ Skip s' -> loop_minimum z s'
648−
648+ Yield x s'
649−-- -- | /O(n)/ maximum returns the maximum value from a stream, which must be
649+ | x < z -> loop_minimum x s'
650−-- -- non-empty.
650+ | otherwise -> loop_minimum z s'
651−-- maximum :: Stream Char -> Char
651+{-# INLINE [0] minimum #-}
652−-- -- maximum (Stream next0 s0 _len) = loop0_maximum s0
652+
653−-- maximum (Stream next0 s0) = loop0_maximum s0
653+-- -----------------------------------------------------------------------------
654−-- where
654+-- * Building streams
655−-- loop0_maximum !s = case next0 s of
655+
656−-- Done -> emptyError "maximum"
656+scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
657−-- Skip s' -> loop0_maximum s'
657+scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
658−-- Yield x s' -> loop_maximum x s'
658+ where
659−-- loop_maximum !z !s = case next0 s of
659+ {-# INLINE next #-}
660−-- Done -> z
660+ next (Scan1 z s) = Yield z (Scan2 z s)
661−-- Skip s' -> loop_maximum z s'
661+ next (Scan2 z s) = case next0 s of
662−-- Yield x s'
662+ Yield x s' -> let !x' = f z x
663−-- | x > z -> loop_maximum x s'
663+ in Yield x' (Scan2 x' s')
664−-- | otherwise -> loop_maximum z s'
664+ Skip s' -> Skip (Scan2 z s')
665−-- {-# INLINE [0] maximum #-}
665+ Done -> Done
666−
666+{-# INLINE [0] scanl #-}
667−-- -- | /O(n)/ minimum returns the minimum value from a 'Text', which must be
667+
668−-- -- non-empty.
668+-- -----------------------------------------------------------------------------
669−-- minimum :: Stream Char -> Char
669+-- ** Generating and unfolding streams
670−-- -- minimum (Stream next0 s0 _len) = loop0_minimum s0
670+
671−-- minimum (Stream next0 s0) = loop0_minimum s0
671+replicateCharI :: Integral a => a -> Char -> Stream Char
672−-- where
672+replicateCharI !n !c
673−-- loop0_minimum !s = case next0 s of
673+ | n < 0 = empty
674−-- Done -> emptyError "minimum"
674+ | otherwise = Stream next 0 (fromIntegral n) -- HINT maybe too low
675−-- Skip s' -> loop0_minimum s'
675+ where
676−-- Yield x s' -> loop_minimum x s'
676+ next !i | i >= n = Done
677−-- loop_minimum !z !s = case next0 s of
677+ | otherwise = Yield c (i + 1)
678−-- Done -> z
678+{-# INLINE [0] replicateCharI #-}
679−-- Skip s' -> loop_minimum z s'
679+
680−-- Yield x s'
680+data RI s = RI !s {-# UNPACK #-} !Int64
681−-- | x < z -> loop_minimum x s'
681+
682−-- | otherwise -> loop_minimum z s'
682+replicateI :: Int64 -> Stream Char -> Stream Char
683−-- {-# INLINE [0] minimum #-}
683+replicateI n (Stream next0 s0 len) =
684−
684+ Stream next (RI s0 0) (fromIntegral (max 0 n) * len)
685−-- -- -----------------------------------------------------------------------------
685+ where
686−-- -- * Building streams
686+ next (RI s k)
687−
687+ | k >= n = Done
688−-- scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char
688+ | otherwise = case next0 s of
689−-- -- scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low
689+ Done -> Skip (RI s0 (k+1))
690−-- scanl f z0 (Stream next0 s0) = Stream next (Scan1 z0 s0) -- (len+1) -- HINT maybe too low
690+ Skip s' -> Skip (RI s' k)
691−-- where
691+ Yield x s' -> Yield x (RI s' k)
692−-- {-# INLINE next #-}
692+{-# INLINE [0] replicateI #-}
693−-- next (Scan1 z s) = Yield z (Scan2 z s)
693+
694−-- next (Scan2 z s) = case next0 s of
694+-- | /O(n)/, where @n@ is the length of the result. The unfoldr function
695−-- Yield x s' -> let !x' = f z x
695+-- is analogous to the List 'unfoldr'. unfoldr builds a stream
696−-- in Yield x' (Scan2 x' s')
696+-- from a seed value. The function takes the element and returns
697−-- Skip s' -> Skip (Scan2 z s')
697+-- Nothing if it is done producing the stream or returns Just
698−-- Done -> Done
698+-- (a,b), in which case, a is the next Char in the string, and b is
699−-- {-# INLINE [0] scanl #-}
699+-- the seed value for further production.
700−
700+unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
701−-- -- -----------------------------------------------------------------------------
701+unfoldr f s0 = Stream next s0 1 -- HINT maybe too low
702−-- -- ** Generating and unfolding streams
702+ where
703−
703+ {-# INLINE next #-}
704−-- replicateCharI :: Integral a => a -> Char -> Stream Char
704+ next !s = case f s of
705−-- replicateCharI n c
705+ Nothing -> Done
706−-- | n < 0 = empty
706+ Just (w, s') -> Yield w s'
707−-- | otherwise = Stream next 0 -- (fromIntegral n) -- HINT maybe too low
707+{-# INLINE [0] unfoldr #-}
708−-- where
708+
709−-- next i | i >= n = Done
709+-- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed
710−-- | otherwise = Yield c (i + 1)
710+-- value. However, the length of the result is limited by the
711−-- {-# INLINE [0] replicateCharI #-}
711+-- first argument to 'unfoldrNI'. This function is more efficient than
712−
712+-- 'unfoldr' when the length of the result is known.
713−-- data RI s = RI !s {-# UNPACK #-} !Int64
713+unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
714−
714+unfoldrNI n f s0 | n < 0 = empty
715−-- replicateI :: Int64 -> Stream Char -> Stream Char
715+ | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high
716−-- -- replicateI n (Stream next0 s0 len) =
716+ where
717−-- replicateI n (Stream next0 s0) =
717+ {-# INLINE next #-}
718−-- Stream next (RI s0 0) -- (fromIntegral (max 0 n) * len)
718+ next (z :*: s) = case f s of
719−-- where
719+ Nothing -> Done
720−-- next (RI s k)
720+ Just (w, s') | z >= n -> Done
721−-- | k >= n = Done
721+ | otherwise -> Yield w ((z + 1) :*: s')
722−-- | otherwise = case next0 s of
722+{-# INLINE unfoldrNI #-}
723−-- Done -> Skip (RI s0 (k+1))
723+
724−-- Skip s' -> Skip (RI s' k)
724+-------------------------------------------------------------------------------
725−-- Yield x s' -> Yield x (RI s' k)
725+-- * Substreams
726−-- {-# INLINE [0] replicateI #-}
726+
727−
727+-- | /O(n)/ take n, applied to a stream, returns the prefix of the
728−-- -- | /O(n)/, where @n@ is the length of the result. The unfoldr function
728+-- stream of length @n@, or the stream itself if @n@ is greater than the
729−-- -- is analogous to the List 'unfoldr'. unfoldr builds a stream
729+-- length of the stream.
730−-- -- from a seed value. The function takes the element and returns
730+take :: Integral a => a -> Stream Char -> Stream Char
731−-- -- Nothing if it is done producing the stream or returns Just
731+take n0 (Stream next0 s0 len) =
732−-- -- (a,b), in which case, a is the next Char in the string, and b is
732+ Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))
733−-- -- the seed value for further production.
733+ where
734−-- unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
734+ {-# INLINE next #-}
735−-- unfoldr f s0 = Stream next s0 -- 1 -- HINT maybe too low
735+ next (n :*: s) | n <= 0 = Done
736−-- where
736+ | otherwise = case next0 s of
737−-- {-# INLINE next #-}
737+ Done -> Done
738−-- next !s = case f s of
738+ Skip s' -> Skip (n :*: s')
739−-- Nothing -> Done
739+ Yield x s' -> Yield x ((n-1) :*: s')
740−-- Just (w, s') -> Yield w s'
740+{-# INLINE [0] take #-}
741−-- {-# INLINE [0] unfoldr #-}
741+
742−
742+data Drop a s = NS !s
743−-- -- | /O(n)/ Like 'unfoldr', 'unfoldrNI' builds a stream from a seed
743+ | JS !a !s
744−-- -- value. However, the length of the result is limited by the
744+
745−-- -- first argument to 'unfoldrNI'. This function is more efficient than
745+-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
746−-- -- 'unfoldr' when the length of the result is known.
746+-- stream after the first @n@ characters, or the empty stream if @n@
747−-- unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
747+-- is greater than the length of the stream.
748−-- unfoldrNI n f s0 | n < 0 = empty
748+drop :: Integral a => a -> Stream Char -> Stream Char
749−-- | otherwise = Stream next (0 :*: s0) -- (fromIntegral (n*2)) -- HINT maybe too high
749+drop n0 (Stream next0 s0 len) =
750−-- where
750+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
751−-- {-# INLINE next #-}
751+ where
752−-- next (z :*: s) = case f s of
752+ {-# INLINE next #-}
753−-- Nothing -> Done
753+ next (JS n s)
754−-- Just (w, s') | z >= n -> Done
754+ | n <= 0 = Skip (NS s)
755−-- | otherwise -> Yield w ((z + 1) :*: s')
755+ | otherwise = case next0 s of
756−-- {-# INLINE unfoldrNI #-}
756+ Done -> Done
757−
757+ Skip s' -> Skip (JS n s')
758−-- -------------------------------------------------------------------------------
758+ Yield _ s' -> Skip (JS (n-1) s')
759−-- -- * Substreams
759+ next (NS s) = case next0 s of
760−
760+ Done -> Done
761−-- -- | /O(n)/ take n, applied to a stream, returns the prefix of the
761+ Skip s' -> Skip (NS s')
762−-- -- stream of length @n@, or the stream itself if @n@ is greater than the
762+ Yield x s' -> Yield x (NS s')
763−-- -- length of the stream.
763+{-# INLINE [0] drop #-}
764−-- take :: Integral a => a -> Stream Char -> Stream Char
764+
765−-- take n0 (Stream next0 s0) =
765+-- | takeWhile, applied to a predicate @p@ and a stream, returns the
766−-- -- take n0 (Stream next0 s0 len) =
766+-- longest prefix (possibly empty) of elements that satisfy p.
767−-- Stream next (n0 :*: s0) -- (smaller len (fromIntegral (max 0 n0)))
767+takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
768−-- where
768+takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
769−-- {-# INLINE next #-}
769+ where
770−-- next (n :*: s) | n <= 0 = Done
770+ {-# INLINE next #-}
771−-- | otherwise = case next0 s of
771+ next !s = case next0 s of
772−-- Done -> Done
772+ Done -> Done
773−-- Skip s' -> Skip (n :*: s')
773+ Skip s' -> Skip s'
774−-- Yield x s' -> Yield x ((n-1) :*: s')
774+ Yield x s' | p x -> Yield x s'
775−-- {-# INLINE [0] take #-}
775+ | otherwise -> Done
776−
776+{-# INLINE [0] takeWhile #-}
777−-- data Drop a s = NS !s
777+
778−-- | JS !a !s
778+-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
779−
779+dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
780−-- -- | /O(n)/ drop n, applied to a stream, returns the suffix of the
780+dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
781−-- -- stream after the first @n@ characters, or the empty stream if @n@
781+ where
782−-- -- is greater than the length of the stream.
782+ {-# INLINE next #-}
783−-- drop :: Integral a => a -> Stream Char -> Stream Char
783+ next (L s) = case next0 s of
784−-- -- drop n0 (Stream next0 s0 len) =
784+ Done -> Done
785−-- drop n0 (Stream next0 s0) =
785+ Skip s' -> Skip (L s')
786−-- Stream next (JS n0 s0) -- (len - fromIntegral (max 0 n0))
786+ Yield x s' | p x -> Skip (L s')
787−-- where
787+ | otherwise -> Yield x (R s')
788−-- {-# INLINE next #-}
788+ next (R s) = case next0 s of
789−-- next (JS n s)
789+ Done -> Done
790−-- | n <= 0 = Skip (NS s)
790+ Skip s' -> Skip (R s')
791−-- | otherwise = case next0 s of
791+ Yield x s' -> Yield x (R s')
792−-- Done -> Done
792+{-# INLINE [0] dropWhile #-}
793−-- Skip s' -> Skip (JS n s')
793+
794−-- Yield _ s' -> Skip (JS (n-1) s')
794+-- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
795−-- next (NS s) = case next0 s of
795+-- 'True' iff the first is a prefix of the second.
796−-- Done -> Done
796+isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool
797−-- Skip s' -> Skip (NS s')
797+isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
798−-- Yield x s' -> Yield x (NS s')
798+ where
799−-- {-# INLINE [0] drop #-}
799+ loop Done _ = True
800−
800+ loop _ Done = False
801−-- -- | takeWhile, applied to a predicate @p@ and a stream, returns the
801+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
802−-- -- longest prefix (possibly empty) of elements that satisfy p.
802+ loop (Skip s1') x2 = loop (next1 s1') x2
803−-- takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
803+ loop x1 (Skip s2') = loop x1 (next2 s2')
804−-- -- takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
804+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
805−-- takeWhile p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high
805+ loop (next1 s1') (next2 s2')
806−-- where
806+{-# INLINE [0] isPrefixOf #-}
807−-- {-# INLINE next #-}
807+
808−-- next !s = case next0 s of
808+-- ----------------------------------------------------------------------------
809−-- Done -> Done
809+-- * Searching
810−-- Skip s' -> Skip s'
810+
811−-- Yield x s' | p x -> Yield x s'
811+-------------------------------------------------------------------------------
812−-- | otherwise -> Done
812+-- ** Searching by equality
813−-- {-# INLINE [0] takeWhile #-}
813+
814−
814+-- | /O(n)/ elem is the stream membership predicate.
815−-- -- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
815+elem :: Char -> Stream Char -> Bool
816−-- dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
816+elem w (Stream next s0 _len) = loop_elem s0
817−-- -- dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
817+ where
818−-- dropWhile p (Stream next0 s0) = Stream next (L s0) -- len -- HINT maybe too high
818+ loop_elem !s = case next s of
819−-- where
819+ Done -> False
820−-- {-# INLINE next #-}
820+ Skip s' -> loop_elem s'
821−-- next (L s) = case next0 s of
821+ Yield x s' | x == w -> True
822−-- Done -> Done
822+ | otherwise -> loop_elem s'
823−-- Skip s' -> Skip (L s')
823+{-# INLINE [0] elem #-}
824−-- Yield x s' | p x -> Skip (L s')
824+
825−-- | otherwise -> Yield x (R s')
825+-------------------------------------------------------------------------------
826−-- next (R s) = case next0 s of
826+-- ** Searching with a predicate
827−-- Done -> Done
827+
828−-- Skip s' -> Skip (R s')
828+-- | /O(n)/ The 'findBy' function takes a predicate and a stream,
829−-- Yield x s' -> Yield x (R s')
829+-- and returns the first element in matching the predicate, or 'Nothing'
830−-- {-# INLINE [0] dropWhile #-}
830+-- if there is no such element.
831−
831+
832−-- -- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns
832+findBy :: (Char -> Bool) -> Stream Char -> Maybe Char
833−-- -- 'True' iff the first is a prefix of the second.
833+findBy p (Stream next s0 _len) = loop_find s0
834−-- isPrefixOf :: (Eq a) => Stream a -> Stream a -> Bool
834+ where
835−-- -- isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
835+ loop_find !s = case next s of
836−-- isPrefixOf (Stream next1 s1) (Stream next2 s2) = loop (next1 s1) (next2 s2)
836+ Done -> Nothing
837−-- where
837+ Skip s' -> loop_find s'
838−-- loop Done _ = True
838+ Yield x s' | p x -> Just x
839−-- loop _ Done = False
839+ | otherwise -> loop_find s'
840−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
840+{-# INLINE [0] findBy #-}
841−-- loop (Skip s1') x2 = loop (next1 s1') x2
841+
842−-- loop x1 (Skip s2') = loop x1 (next2 s2')
842+-- | /O(n)/ Stream index (subscript) operator, starting from 0.
843−-- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
843+indexI :: Integral a => Stream Char -> a -> Char
844−-- loop (next1 s1') (next2 s2')
844+indexI (Stream next s0 _len) n0
845−-- {-# INLINE [0] isPrefixOf #-}
845+ | n0 < 0 = streamError "index" "Negative index"
846−
846+ | otherwise = loop_index n0 s0
847−-- -- ----------------------------------------------------------------------------
847+ where
848−-- -- * Searching
848+ loop_index !n !s = case next s of
849−
849+ Done -> streamError "index" "Index too large"
850−-- -------------------------------------------------------------------------------
850+ Skip s' -> loop_index n s'
851−-- -- ** Searching by equality
851+ Yield x s' | n == 0 -> x
852−
852+ | otherwise -> loop_index (n-1) s'
853−-- -- | /O(n)/ elem is the stream membership predicate.
853+{-# INLINE [0] indexI #-}
854−-- elem :: Char -> Stream Char -> Bool
854+
855−-- -- elem w (Stream next s0 _len) = loop_elem s0
855+-- | /O(n)/ 'filter', applied to a predicate and a stream,
856−-- elem w (Stream next s0) = loop_elem s0
856+-- returns a stream containing those characters that satisfy the
857−-- where
857+-- predicate.
858−-- loop_elem !s = case next s of
858+filter :: (Char -> Bool) -> Stream Char -> Stream Char
859−-- Done -> False
859+filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
860−-- Skip s' -> loop_elem s'
860+ where
861−-- Yield x s' | x == w -> True
861+ next !s = case next0 s of
862−-- | otherwise -> loop_elem s'
862+ Done -> Done
863−-- {-# INLINE [0] elem #-}
863+ Skip s' -> Skip s'
864−
864+ Yield x s' | p x -> Yield x s'
865−-- -------------------------------------------------------------------------------
865+ | otherwise -> Skip s'
866−-- -- ** Searching with a predicate
866+{-# INLINE [0] filter #-}
867−
867+
868−-- -- | /O(n)/ The 'findBy' function takes a predicate and a stream,
868+{-# RULES
869−-- -- and returns the first element in matching the predicate, or 'Nothing'
869+ "STREAM filter/filter fusion" forall p q s.
870−-- -- if there is no such element.
870+ filter p (filter q s) = filter (\x -> q x && p x) s
871−
871+ #-}
872−-- findBy :: (Char -> Bool) -> Stream Char -> Maybe Char
872+
873−-- -- findBy p (Stream next s0 _len) = loop_find s0
873+-- | The 'findIndexI' function takes a predicate and a stream and
874−-- findBy p (Stream next s0) = loop_find s0
874+-- returns the index of the first element in the stream satisfying the
875−-- where
875+-- predicate.
876−-- loop_find !s = case next s of
876+findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a
877−-- Done -> Nothing
877+findIndexI p s = case findIndicesI p s of
878−-- Skip s' -> loop_find s'
878+ (i:_) -> Just i
879−-- Yield x s' | p x -> Just x
879+ _ -> Nothing
880−-- | otherwise -> loop_find s'
880+{-# INLINE [0] findIndexI #-}
881−-- {-# INLINE [0] findBy #-}
881+
882−
882+-- | The 'findIndicesI' function takes a predicate and a stream and
883−-- -- | /O(n)/ Stream index (subscript) operator, starting from 0.
883+-- returns all indices of the elements in the stream satisfying the
884−-- indexI :: Integral a => Stream Char -> a -> Char
884+-- predicate.
885−-- -- indexI (Stream next s0 _len) n0
885+findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]
886−-- indexI (Stream next s0) n0
886+findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
887−-- | n0 < 0 = streamError "index" "Negative index"
887+ where
888−-- | otherwise = loop_index n0 s0
888+ loop_findIndex !i !s = case next s of
889−-- where
889+ Done -> []
890−-- loop_index !n !s = case next s of
890+ Skip s' -> loop_findIndex i s' -- hmm. not caught by QC
891−-- Done -> streamError "index" "Index too large"
891+ Yield x s' | p x -> i : loop_findIndex (i+1) s'
892−-- Skip s' -> loop_index n s'
892+ | otherwise -> loop_findIndex (i+1) s'
893−-- Yield x s' | n == 0 -> x
893+{-# INLINE [0] findIndicesI #-}
894−-- | otherwise -> loop_index (n-1) s'
894+
895−-- {-# INLINE [0] indexI #-}
895+-------------------------------------------------------------------------------
896−
896+-- * Zipping
897−-- -- | /O(n)/ 'filter', applied to a predicate and a stream,
897+
898−-- -- returns a stream containing those characters that satisfy the
898+-- | Strict triple.
899−-- -- predicate.
899+data Zip a b m = Z1 !a !b
900−-- filter :: (Char -> Bool) -> Stream Char -> Stream Char
900+ | Z2 !a !b !m
901−-- -- filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
901+
902−-- filter p (Stream next0 s0) = Stream next s0 -- len -- HINT maybe too high
902+-- | zipWith generalises 'zip' by zipping with the function given as
903−-- where
903+-- the first argument, instead of a tupling function.
904−-- next !s = case next0 s of
904+zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b
905−-- Done -> Done
905+zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =
906−-- Skip s' -> Skip s'
906+ Stream next (Z1 sa0 sb0) (smaller len1 len2)
907−-- Yield x s' | p x -> Yield x s'
907+ where
908−-- | otherwise -> Skip s'
908+ next (Z1 sa sb) = case next0 sa of
909−-- {-# INLINE [0] filter #-}
909+ Done -> Done
910−
910+ Skip sa' -> Skip (Z1 sa' sb)
911−-- {-# RULES
911+ Yield a sa' -> Skip (Z2 sa' sb a)
912−-- "STREAM filter/filter fusion" forall p q s.
912+
913−-- filter p (filter q s) = filter (\x -> q x && p x) s
913+ next (Z2 sa' sb a) = case next1 sb of
914−-- #-}
914+ Done -> Done
915−
915+ Skip sb' -> Skip (Z2 sa' sb' a)
916−-- -- | The 'findIndexI' function takes a predicate and a stream and
916+ Yield b sb' -> Yield (f a b) (Z1 sa' sb')
917−-- -- returns the index of the first element in the stream satisfying the
917+{-# INLINE [0] zipWith #-}
918−-- -- predicate.
918+
919−-- findIndexI :: Integral a => (Char -> Bool) -> Stream Char -> Maybe a
919+-- | /O(n)/ The 'countCharI' function returns the number of times the
920−-- findIndexI p s = case findIndicesI p s of
920+-- query element appears in the given stream.
921−-- (i:_) -> Just i
921+countCharI :: Integral a => Char -> Stream Char -> a
922−-- _ -> Nothing
922+countCharI a (Stream next s0 _len) = loop 0 s0
923−-- {-# INLINE [0] findIndexI #-}
923+ where
924−
924+ loop !i !s = case next s of
925−-- -- | The 'findIndicesI' function takes a predicate and a stream and
925+ Done -> i
926−-- -- returns all indices of the elements in the stream satisfying the
926+ Skip s' -> loop i s'
927−-- -- predicate.
927+ Yield x s' | a == x -> loop (i+1) s'
928−-- findIndicesI :: Integral a => (Char -> Bool) -> Stream Char -> [a]
928+ | otherwise -> loop i s'
929−-- -- findIndicesI p (Stream next s0 _len) = loop_findIndex 0 s0
929+{-# INLINE [0] countCharI #-}
930−-- findIndicesI p (Stream next s0) = loop_findIndex 0 s0
930+
931−-- where
931+streamError :: String -> String -> a
932−-- loop_findIndex !i !s = case next s of
932+streamError func msg = P.error $ "Data.Text.Internal.Fusion.Common." ++ func ++ ": " ++ msg
933−-- Done -> []
933+
934−-- Skip s' -> loop_findIndex i s' -- hmm. not caught by QC
934+emptyError :: String -> a
935−-- Yield x s' | p x -> i : loop_findIndex (i+1) s'
935+emptyError func = internalError func "Empty input"
936−-- | otherwise -> loop_findIndex (i+1) s'
936+
937−-- {-# INLINE [0] findIndicesI #-}
937+internalError :: String -> a
938−
938+internalError func = streamError func "Internal error"
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+7−33
@@ -1,4 +1,4 @@
1−{-# LANGUAGE CPP, PatternGuards #-}
1+{-# LANGUAGE CPP #-}
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,16 +19,11 @@
19module Data.Text.Internal.Fusion.Size
19module Data.Text.Internal.Fusion.Size
20 (
20 (
21 Size
21 Size
22− -- * Sizes
22+ , exactly
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
32 , smaller
27 , smaller
33 , larger
28 , larger
34 , upperBound
29 , upperBound
@@ -37,13 +32,11 @@ module Data.Text.Internal.Fusion.Size
37 , isEmpty
32 , isEmpty
38 ) where
33 ) where
39
34
40−import Data.Char (ord)
41import Data.Text.Internal (mul)
35import Data.Text.Internal (mul)
42#if defined(ASSERTS)
36#if defined(ASSERTS)
43import Control.Exception (assert)
37import Control.Exception (assert)
44#endif
38#endif
45
39
46−-- | A size in UTF-16 code units.
47data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
40data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
48 | Unknown -- ^ Unknown size.
41 | Unknown -- ^ Unknown size.
49 deriving (Eq, Show)
42 deriving (Eq, Show)
@@ -53,17 +46,6 @@ exactly (Between na nb) | na == nb = Just na
53exactly _ = Nothing
46exactly _ = Nothing
54{-# INLINE exactly #-}
47{-# INLINE exactly #-}
55
48
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−
67exactSize :: Int -> Size
49exactSize :: Int -> Size
68exactSize n =
50exactSize n =
69#if defined(ASSERTS)
51#if defined(ASSERTS)
@@ -89,10 +71,6 @@ betweenSize m n =
89 Between m n
71 Between m n
90{-# INLINE betweenSize #-}
72{-# INLINE betweenSize #-}
91
73
92−unionSize :: Size -> Size -> Size
93−unionSize (Between a b) (Between c d) = Between (min a c) (max b d)
94−unionSize _ _ = Unknown
95−
96unknownSize :: Size
74unknownSize :: Size
97unknownSize = Unknown
75unknownSize = Unknown
98{-# INLINE unknownSize #-}
76{-# INLINE unknownSize #-}
@@ -162,15 +140,11 @@ lowerBound _ (Between n _) = n
162lowerBound k _ = k
140lowerBound k _ = k
163{-# INLINE lowerBound #-}
141{-# INLINE lowerBound #-}
164
142
165−-- | Determine the ordering relationship between two 'Size's, or 'Nothing' in
166−-- the indeterminate case.
167−compareSize :: Size -> Size -> Maybe Ordering
143+compareSize :: Size -> Int -> Maybe Ordering
168−compareSize (Between ma mb) (Between na nb)
144+compareSize (Between ma mb) n
169− | mb < na = Just LT
145+ | mb < n = Just LT
170− | ma > nb = Just GT
146+ | ma > n = Just GT
171− | ma == mb
172− , ma == na
173− , ma == nb = Just EQ
147+ | ma == n && mb == n = Just EQ
174compareSize _ _ = Nothing
148compareSize _ _ = Nothing
175
149
176
150
Data/Text/Internal/Fusion/Types.hs+99−102
@@ -19,107 +19,104 @@
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
30 ) where
29 ) where
31
30
32−-- import Data.Text.Internal.Fusion.Size
31+import Data.Text.Internal.Fusion.Size
33−-- import Data.Word (Word8)
32+import Data.Word (Word8)
34−
33+
35−import Data.JSString.Internal.Fusion.Types
36−
37−-- -- | Specialised tuple for case conversion.
34+-- | Specialised tuple for case conversion.
38−-- data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
35+data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char
39−
36+
40−-- -- | Restreaming state.
37+-- | Restreaming state.
41−-- data RS s
38+data RS s
42−-- = RS0 !s
39+ = RS0 !s
43−-- | RS1 !s {-# UNPACK #-} !Word8
40+ | RS1 !s {-# UNPACK #-} !Word8
44−-- | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
41+ | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
45−-- | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
42+ | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
46−
43+
47−-- -- | Strict pair.
44+-- | Strict pair.
48−-- data PairS a b = !a :*: !b
45+data PairS a b = !a :*: !b
49−-- -- deriving (Eq, Ord, Show)
46+ -- deriving (Eq, Ord, Show)
50−-- infixl 2 :*:
47+infixl 2 :*:
51−
48+
52−-- -- | An intermediate result in a scan.
49+-- | An intermediate result in a scan.
53−-- data Scan s = Scan1 {-# UNPACK #-} !Char !s
50+data Scan s = Scan1 {-# UNPACK #-} !Char !s
54−-- | Scan2 {-# UNPACK #-} !Char !s
51+ | Scan2 {-# UNPACK #-} !Char !s
55−
52+
56−-- -- | Intermediate result in a processing pipeline.
53+-- | Intermediate result in a processing pipeline.
57−-- data Step s a = Done
54+data Step s a = Done
58−-- | Skip !s
55+ | Skip !s
59−-- | Yield !a !s
56+ | Yield !a !s
60−
57+
61−-- {-
58+{-
62−-- instance (Show a) => Show (Step s a)
59+instance (Show a) => Show (Step s a)
63−-- where show Done = "Done"
60+ where show Done = "Done"
64−-- show (Skip _) = "Skip"
61+ show (Skip _) = "Skip"
65−-- show (Yield x _) = "Yield " ++ show x
62+ show (Yield x _) = "Yield " ++ show x
66−-- -}
63+-}
67−
64+
68−-- instance (Eq a) => Eq (Stream a) where
65+instance (Eq a) => Eq (Stream a) where
69−-- (==) = eq
66+ (==) = eq
70−
67+
71−-- instance (Ord a) => Ord (Stream a) where
68+instance (Ord a) => Ord (Stream a) where
72−-- compare = cmp
69+ compare = cmp
73−
70+
74−-- -- The length hint in a Stream has two roles. If its value is zero,
71+-- The length hint in a Stream has two roles. If its value is zero,
75−-- -- we trust it, and treat the stream as empty. Otherwise, we treat it
72+-- we trust it, and treat the stream as empty. Otherwise, we treat it
76−-- -- as a hint: it should usually be accurate, so we use it when
73+-- as a hint: it should usually be accurate, so we use it when
77−-- -- unstreaming to decide what size array to allocate. However, the
74+-- unstreaming to decide what size array to allocate. However, the
78−-- -- unstreaming functions must be able to cope with the hint being too
75+-- unstreaming functions must be able to cope with the hint being too
79−-- -- small or too large.
76+-- small or too large.
80−-- --
77+--
81−-- -- The size hint tries to track the UTF-16 code units in a stream,
78+-- The size hint tries to track the UTF-16 code points in a stream,
82−-- -- but often counts the number of code points instead. It can easily
79+-- but often counts the number of characters instead. It can easily
83−-- -- undercount if, for instance, a transformed stream contains astral
80+-- undercount if, for instance, a transformed stream contains astral
84−-- -- plane code points (those above 0x10000).
81+-- plane characters (those above 0x10000).
85−
82+
86−-- data Stream a =
83+data Stream a =
87−-- forall s. Stream
84+ forall s. Stream
88−-- (s -> Step s a) -- stepper function
85+ (s -> Step s a) -- stepper function
89−-- !s -- current state
86+ !s -- current state
90−-- !Size -- size hint in code units
87+ !Size -- size hint
91−
88+
92−-- -- | /O(n)/ Determines if two streams are equal.
89+-- | /O(n)/ Determines if two streams are equal.
93−-- eq :: (Eq a) => Stream a -> Stream a -> Bool
90+eq :: (Eq a) => Stream a -> Stream a -> Bool
94−-- eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
91+eq (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
95−-- where
92+ where
96−-- loop Done Done = True
93+ loop Done Done = True
97−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
94+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
98−-- loop (Skip s1') x2 = loop (next1 s1') x2
95+ loop (Skip s1') x2 = loop (next1 s1') x2
99−-- loop x1 (Skip s2') = loop x1 (next2 s2')
96+ loop x1 (Skip s2') = loop x1 (next2 s2')
100−-- loop Done _ = False
97+ loop Done _ = False
101−-- loop _ Done = False
98+ loop _ Done = False
102−-- loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
99+ loop (Yield x1 s1') (Yield x2 s2') = x1 == x2 &&
103−-- loop (next1 s1') (next2 s2')
100+ loop (next1 s1') (next2 s2')
104−-- {-# INLINE [0] eq #-}
101+{-# INLINE [0] eq #-}
105−
102+
106−-- cmp :: (Ord a) => Stream a -> Stream a -> Ordering
103+cmp :: (Ord a) => Stream a -> Stream a -> Ordering
107−-- cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
104+cmp (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
108−-- where
105+ where
109−-- loop Done Done = EQ
106+ loop Done Done = EQ
110−-- loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
107+ loop (Skip s1') (Skip s2') = loop (next1 s1') (next2 s2')
111−-- loop (Skip s1') x2 = loop (next1 s1') x2
108+ loop (Skip s1') x2 = loop (next1 s1') x2
112−-- loop x1 (Skip s2') = loop x1 (next2 s2')
109+ loop x1 (Skip s2') = loop x1 (next2 s2')
113−-- loop Done _ = LT
110+ loop Done _ = LT
114−-- loop _ Done = GT
111+ loop _ Done = GT
115−-- loop (Yield x1 s1') (Yield x2 s2') =
112+ loop (Yield x1 s1') (Yield x2 s2') =
116−-- case compare x1 x2 of
113+ case compare x1 x2 of
117−-- EQ -> loop (next1 s1') (next2 s2')
114+ EQ -> loop (next1 s1') (next2 s2')
118−-- other -> other
115+ other -> other
119−-- {-# INLINE [0] cmp #-}
116+{-# INLINE [0] cmp #-}
120−
117+
121−-- -- | The empty stream.
118+-- | The empty stream.
122−-- empty :: Stream a
119+empty :: Stream a
123−-- empty = Stream next () 0
120+empty = Stream next () 0
124−-- where next _ = Done
121+ where next _ = Done
125−-- {-# INLINE [0] empty #-}
122+{-# INLINE [0] empty #-}
Data/Text/Internal/IO.hs−8
@@ -95,11 +95,7 @@ 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__
99 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))
98 go pbuf = return $! unstream (Stream next r (exactSize (w-r)))
100−#else
101− go pbuf = return $! unstream (Stream next r)
102−#endif
103 where
99 where
104 next !i | i >= w = Done
100 next !i | i >= w = Done
105 | otherwise = Yield (ix i) (i+1)
101 | otherwise = Yield (ix i) (i+1)
@@ -112,11 +108,7 @@ unpack_nl !buf !r !w
112 | otherwise = withRawBuffer buf $ go
108 | otherwise = withRawBuffer buf $ go
113 where
109 where
114 go pbuf = do
110 go pbuf = do
115−#ifndef __GHCJS__
116 let !t = unstream (Stream next r (maxSize (w-r)))
111 let !t = unstream (Stream next r (maxSize (w-r)))
117−#else
118− let !t = unstream (Stream next r)
119−#endif
120 w' = w - 1
112 w' = w - 1
121 return $ if ix w' == '\r'
113 return $ if ix w' == '\r'
122 then (t,w')
114 then (t,w')
Data/Text/Internal/Lazy.hs+1−20
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, DeriveDataTypeable, CPP #-}
1+{-# LANGUAGE BangPatterns, DeriveDataTypeable #-}
2{-# OPTIONS_HADDOCK not-home #-}
2{-# OPTIONS_HADDOCK not-home #-}
3
3
4-- |
4-- |
@@ -44,10 +44,6 @@ 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−
51data Text = Empty
47data Text = Empty
52 | Chunk {-# UNPACK #-} !T.Text Text
48 | Chunk {-# UNPACK #-} !T.Text Text
53 deriving (Typeable)
49 deriving (Typeable)
@@ -61,26 +57,16 @@ data Text = Empty
61-- | Check the invariant strictly.
57-- | Check the invariant strictly.
62strictInvariant :: Text -> Bool
58strictInvariant :: Text -> Bool
63strictInvariant Empty = True
59strictInvariant Empty = True
64−#ifndef __GHCJS__
65strictInvariant x@(Chunk (T.Text _ _ len) cs)
60strictInvariant x@(Chunk (T.Text _ _ len) cs)
66 | len > 0 = strictInvariant cs
61 | len > 0 = strictInvariant cs
67−#else
68−strictInvariant x@(Chunk t cs)
69− | TT.length t > 0 = strictInvariant cs
70−#endif
71 | otherwise = error $ "Data.Text.Lazy: invariant violation: "
62 | otherwise = error $ "Data.Text.Lazy: invariant violation: "
72 ++ showStructure x
63 ++ showStructure x
73
64
74-- | Check the invariant lazily.
65-- | Check the invariant lazily.
75lazyInvariant :: Text -> Text
66lazyInvariant :: Text -> Text
76lazyInvariant Empty = Empty
67lazyInvariant Empty = Empty
77−#ifndef __GHCJS__
78lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
68lazyInvariant x@(Chunk c@(T.Text _ _ len) cs)
79 | len > 0 = Chunk c (lazyInvariant cs)
69 | 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
84 | otherwise = error $ "Data.Text.Lazy: invariant violation: "
70 | otherwise = error $ "Data.Text.Lazy: invariant violation: "
85 ++ showStructure x
71 ++ showStructure x
86
72
@@ -94,13 +80,8 @@ showStructure (Chunk t ts) =
94-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
80-- | Smart constructor for 'Chunk'. Guarantees the data type invariant.
95chunk :: T.Text -> Text -> Text
81chunk :: T.Text -> Text -> Text
96{-# INLINE chunk #-}
82{-# INLINE chunk #-}
97−#ifndef __GHCJS__
98chunk t@(T.Text _ _ len) ts | len == 0 = ts
83chunk t@(T.Text _ _ len) ts | len == 0 = ts
99 | otherwise = Chunk t ts
84 | otherwise = Chunk t ts
100−#else
101−chunk t ts | TT.null t = ts
102− | otherwise = Chunk t ts
103−#endif
104
85
105-- | Smart constructor for 'Empty'.
86-- | Smart constructor for 'Empty'.
106empty :: Text
87empty :: Text
Data/Text/Internal/Lazy/Encoding/Fusion.hs−26
@@ -38,9 +38,7 @@ 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__
42import Data.Text.Internal.Fusion.Size
41import Data.Text.Internal.Fusion.Size
43−#endif
44import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
42import Data.Text.Internal.Unsafe.Char (unsafeChr, unsafeChr8, unsafeChr32)
45import Data.Text.Internal.Unsafe.Shift (shiftL)
43import Data.Text.Internal.Unsafe.Shift (shiftL)
46import Data.Word (Word8, Word16, Word32)
44import Data.Word (Word8, Word16, Word32)
@@ -67,11 +65,7 @@ data T = T !ByteString !S {-# UNPACK #-} !Int
67-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
65-- | /O(n)/ Convert a lazy 'ByteString' into a 'Stream Char', using
68-- UTF-8 encoding.
66-- UTF-8 encoding.
69streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
67streamUtf8 :: OnDecodeError -> ByteString -> Stream Char
70−#ifndef __GHCJS__
71streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize
68streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) unknownSize
72−#else
73−streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
74−#endif
75 where
69 where
76 next (T bs@(Chunk ps _) S0 i)
70 next (T bs@(Chunk ps _) S0 i)
77 | i < len && U8.validate1 a =
71 | i < len && U8.validate1 a =
@@ -113,11 +107,7 @@ streamUtf8 onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
113-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
107-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
114-- endian UTF-16 encoding.
108-- endian UTF-16 encoding.
115streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
109streamUtf16LE :: OnDecodeError -> ByteString -> Stream Char
116−#ifndef __GHCJS__
117streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
110streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
118−#else
119−streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
120−#endif
121 where
111 where
122 next (T bs@(Chunk ps _) S0 i)
112 next (T bs@(Chunk ps _) S0 i)
123 | i + 1 < len && U16.validate1 x1 =
113 | i + 1 < len && U16.validate1 x1 =
@@ -157,11 +147,7 @@ streamUtf16LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
157-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
147-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
158-- endian UTF-16 encoding.
148-- endian UTF-16 encoding.
159streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
149streamUtf16BE :: OnDecodeError -> ByteString -> Stream Char
160−#ifndef __GHCJS__
161streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
150streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
162−#else
163−streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
164−#endif
165 where
151 where
166 next (T bs@(Chunk ps _) S0 i)
152 next (T bs@(Chunk ps _) S0 i)
167 | i + 1 < len && U16.validate1 x1 =
153 | i + 1 < len && U16.validate1 x1 =
@@ -201,11 +187,7 @@ streamUtf16BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
201-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
187-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using big
202-- endian UTF-32 encoding.
188-- endian UTF-32 encoding.
203streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
189streamUtf32BE :: OnDecodeError -> ByteString -> Stream Char
204−#ifndef __GHCJS__
205streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
190streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
206−#else
207−streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
208−#endif
209 where
191 where
210 next (T bs@(Chunk ps _) S0 i)
192 next (T bs@(Chunk ps _) S0 i)
211 | i + 3 < len && U32.validate x =
193 | i + 3 < len && U32.validate x =
@@ -249,11 +231,7 @@ streamUtf32BE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
249-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
231-- | /O(n)/ Convert a 'ByteString' into a 'Stream Char', using little
250-- endian UTF-32 encoding.
232-- endian UTF-32 encoding.
251streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
233streamUtf32LE :: OnDecodeError -> ByteString -> Stream Char
252−#ifndef __GHCJS__
253streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
234streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) unknownSize
254−#else
255−streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
256−#endif
257 where
235 where
258 next (T bs@(Chunk ps _) S0 i)
236 next (T bs@(Chunk ps _) S0 i)
259 | i + 3 < len && U32.validate x =
237 | i + 3 < len && U32.validate x =
@@ -296,11 +274,7 @@ streamUtf32LE onErr bs0 = Stream next (T bs0 S0 0) -- unknownSize
296
274
297-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
275-- | /O(n)/ Convert a 'Stream' 'Word8' to a lazy 'ByteString'.
298unstreamChunks :: Int -> Stream Word8 -> ByteString
276unstreamChunks :: Int -> Stream Word8 -> ByteString
299−#ifndef __GHCJS__
300unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
277unstreamChunks chunkSize (Stream next s0 len0) = chunk s0 (upperBound 4 len0)
301−#else
302−unstreamChunks chunkSize (Stream next s0) = chunk s0 4
303−#endif
304 where chunk s1 len1 = unsafeDupablePerformIO $ do
278 where chunk s1 len1 = unsafeDupablePerformIO $ do
305 let len = max 4 (min len1 chunkSize)
279 let len = max 4 (min len1 chunkSize)
306 mallocByteString len >>= loop len 0 s1
280 mallocByteString len >>= loop len 0 s1
Data/Text/Internal/Lazy/Fusion.hs−62
@@ -1,10 +1,4 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE CPP #-}
3−#ifdef __GHCJS__
4−{-# LANGUAGE ForeignFunctionInterface #-}
5−{-# LANGUAGE MagicHash #-}
6−{-# LANGUAGE UnliftedFFITypes #-}
7−#endif
8-- |
2-- |
9-- Module : Data.Text.Lazy.Fusion
3-- Module : Data.Text.Lazy.Fusion
10-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010 Bryan O'Sullivan
@@ -35,14 +29,7 @@ import Prelude hiding (length)
35import qualified Data.Text.Internal.Fusion.Common as S
29import qualified Data.Text.Internal.Fusion.Common as S
36import Control.Monad.ST (runST)
30import Control.Monad.ST (runST)
37import Data.Text.Internal.Fusion.Types
31import Data.Text.Internal.Fusion.Types
38−#ifndef __GHCJS__
39import Data.Text.Internal.Fusion.Size (isEmpty, unknownSize)
32import 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
46import Data.Text.Internal.Lazy
33import Data.Text.Internal.Lazy
47import qualified Data.Text.Internal as I
34import qualified Data.Text.Internal as I
48import qualified Data.Text.Array as A
35import qualified Data.Text.Array as A
@@ -55,7 +42,6 @@ default(Int64)
55
42
56-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
43-- | /O(n)/ Convert a 'Text' into a 'Stream Char'.
57stream :: Text -> Stream Char
44stream :: Text -> Stream Char
58−#ifndef __GHCJS__
59stream text = Stream next (text :*: 0) unknownSize
45stream text = Stream next (text :*: 0) unknownSize
60 where
46 where
61 next (Empty :*: _) = Done
47 next (Empty :*: _) = Done
@@ -63,22 +49,11 @@ stream text = Stream next (text :*: 0) unknownSize
63 | i >= len = next (ts :*: 0)
49 | i >= len = next (ts :*: 0)
64 | otherwise = Yield c (txt :*: i+d)
50 | otherwise = Yield c (txt :*: i+d)
65 where Iter c d = iter t i
51 where Iter c d = iter t i
66−#else
67−stream text = Stream next (text :*: 0) -- unknownSize
68− where
69− next (Empty :*: _) = Done
70− next (txt@(Chunk t@(I.Text jst) ts) :*: i)
71− | i >= JSS.length jst = next (ts :*: 0)
72− | otherwise = Yield c (txt :*: i+d)
73− where Iter c d = iter t i
74−#endif
75{-# INLINE [0] stream #-}
52{-# INLINE [0] stream #-}
76
53
77−-- TODO
78-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
54-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using the given
79-- chunk size.
55-- chunk size.
80unstreamChunks :: Int -> Stream Char -> Text
56unstreamChunks :: Int -> Stream Char -> Text
81−#ifndef __GHCJS__
82unstreamChunks !chunkSize (Stream next s0 len0)
57unstreamChunks !chunkSize (Stream next s0 len0)
83 | isEmpty len0 = Empty
58 | isEmpty len0 = Empty
84 | otherwise = outer s0
59 | otherwise = outer s0
@@ -109,36 +84,6 @@ unstreamChunks !chunkSize (Stream next s0 len0)
109 finish marr len s' = do
84 finish marr len s' = do
110 arr <- A.unsafeFreeze marr
85 arr <- A.unsafeFreeze marr
111 return (I.Text arr 0 len `Chunk` outer s')
86 return (I.Text arr 0 len `Chunk` outer s')
112−#else
113−unstreamChunks !chunkSize (Stream next s0) = outer s0
114− where
115− outer so = {-# SCC "unstreamChunks/outer" #-}
116− case next so of
117− Done -> Empty
118− Skip s' -> outer s'
119− Yield x s' -> runST $ do
120− a <- A.new unknownLength
121− unsafeWrite a 0 x >>= inner a unknownLength s'
122− where unknownLength = 4
123− where
124− inner marr !len s !i
125− | i + 1 >= chunkSize = finish marr i s
126− | i + 1 >= len = {-# SCC "unstreamChunks/resize" #-} do
127− let newLen = min (len `shiftL` 1) chunkSize
128− marr' <- A.new newLen
129− A.copyM marr' 0 marr 0 len
130− inner marr' newLen s i
131− | otherwise =
132− {-# SCC "unstreamChunks/inner" #-}
133− case next s of
134− Done -> finish marr i s
135− Skip s' -> inner marr len s' i
136− Yield x s' -> do d <- unsafeWrite marr i x
137− inner marr len s' (i+d)
138− finish marr (I# len#) s' = do
139− arr <- A.unsafeFreeze marr
140− return (I.Text (js_toString (A.aBA arr) 0# len#) `Chunk` outer s')
141−#endif
142{-# INLINE [0] unstreamChunks #-}
87{-# INLINE [0] unstreamChunks #-}
143
88
144-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
89-- | /O(n)/ Convert a 'Stream Char' into a 'Text', using
@@ -173,10 +118,3 @@ index = S.indexI
173countChar :: Char -> Stream Char -> Int64
118countChar :: Char -> Stream Char -> Int64
174countChar = S.countCharI
119countChar = S.countCharI
175{-# INLINE [0] countChar #-}
120{-# INLINE [0] countChar #-}
176−
177−#ifdef __GHCJS__
178−foreign import javascript unsafe
179− "h$textToString($1,$2,$3)"
180− js_toString :: ByteArray# -> Int# -> Int# -> JSString
181−#endif
182−
Data/Text/Internal/Lazy/Search.hs+11−71
@@ -1,7 +1,4 @@
1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
1{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
2−{-# LANGUAGE ForeignFunctionInterface, UnliftedFFITypes, JavaScriptFFI,
3− UnboxedTuples, DeriveDataTypeable, GHCForeignImportPrim,
4− MagicHash, FlexibleInstances, BangPatterns, Rank2Types, CPP #-}
5
2
6-- |
3-- |
7-- Module : Data.Text.Lazy.Search
4-- Module : Data.Text.Lazy.Search
@@ -34,17 +31,6 @@ import Data.Text.Internal.Lazy (Text(..), foldlChunks)
34import Data.Bits ((.|.), (.&.))
31import Data.Bits ((.|.), (.&.))
35import Data.Text.Internal.Unsafe.Shift (shiftL)
32import Data.Text.Internal.Unsafe.Shift (shiftL)
36
33
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−
48-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
34-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
49-- @needle@ within @haystack@.
35-- @needle@ within @haystack@.
50--
36--
@@ -61,10 +47,8 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
61 | nlen == 1 = indicesOne (nindex 0) 0 k ks
47 | nlen == 1 = indicesOne (nindex 0) 0 k ks
62 | otherwise = advance k ks 0 0
48 | otherwise = advance k ks 0 0
63 where
49 where
64− -- advance x@(T.Text _ _ l) xs = scan
50+ advance x@(T.Text _ _ l) xs = scan
65− advance x xs = scan
66 where
51 where
67− l = TT.length x
68 scan !g !i
52 scan !g !i
69 | i >= m = case xs of
53 | i >= m = case xs of
70 Empty -> []
54 Empty -> []
@@ -88,31 +72,11 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
88 nlast = nlen - 1
72 nlast = nlen - 1
89 nindex = index n ns
73 nindex = index n ns
90 z = foldlChunks fin 0 needle
74 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
102− in A.unsafeIndex farr (foff+flen-1)
75+ where fin _ (T.Text farr foff flen) = A.unsafeIndex farr (foff+flen-1)
103 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)
76 (mask :: Word64) :*: skip = buildTable n ns 0 0 0 (nlen-2)
104 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)
77 swizzle w = 1 `shiftL` (fromIntegral w .&. 0x3f)
105− -- buildTable (T.Text xarr xoff xlen) xs = go
78+ buildTable (T.Text xarr xoff xlen) xs = go
106− buildTable t xs = go
107 where
79 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
116 go !(g::Int64) !i !msk !skp
80 go !(g::Int64) !i !msk !skp
117 | i >= xlast = case xs of
81 | i >= xlast = case xs of
118 Empty -> (msk .|. swizzle z) :*: skp
82 Empty -> (msk .|. swizzle z) :*: skp
@@ -127,22 +91,17 @@ indices needle@(Chunk n ns) _haystack@(Chunk k ks)
127 -- given offset would fail.
91 -- given offset would fail.
128 lackingHay q = go 0
92 lackingHay q = go 0
129 where
93 where
130− -- go p (T.Text _ _ l) ps = p' < q && case ps of
94+ go p (T.Text _ _ l) ps = p' < q && case ps of
131− go p t ps = p' < q && case ps of
132− Empty -> True
95+ Empty -> True
133− Chunk r rs -> go p' r rs
96+ Chunk r rs -> go p' r rs
134− where
135− l = TT.length t
136− p' = p + fromIntegral l
97+ where p' = p + fromIntegral l
137−
138indices _ _ = []
98indices _ _ = []
139
99
140-- | Fast index into a partly unpacked 'Text'. We take into account
100-- | Fast index into a partly unpacked 'Text'. We take into account
141-- the possibility that the caller might try to access one element
101-- the possibility that the caller might try to access one element
142-- past the end.
102-- past the end.
143index :: T.Text -> Text -> Int64 -> Word16
103index :: T.Text -> Text -> Int64 -> Word16
144−-- index (T.Text arr off len) xs !i
104+index (T.Text arr off len) xs !i
145−index t xs !i
146 | j < len = A.unsafeIndex arr (off+j)
105 | j < len = A.unsafeIndex arr (off+j)
147 | otherwise = case xs of
106 | otherwise = case xs of
148 Empty
107 Empty
@@ -151,32 +110,14 @@ index t xs !i
151 -- should never happen, due to lackingHay above
110 -- should never happen, due to lackingHay above
152 | otherwise -> emptyError "index"
111 | otherwise -> emptyError "index"
153 Chunk c cs -> index c cs (i-fromIntegral len)
112 Chunk c cs -> index c cs (i-fromIntegral len)
154− where
155− j = fromIntegral i
113+ where 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
164
114
165-- | A variant of 'indices' that scans linearly for a single 'Word16'.
115-- | A variant of 'indices' that scans linearly for a single 'Word16'.
166indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]
116indicesOne :: Word16 -> Int64 -> T.Text -> Text -> [Int64]
167indicesOne c = chunk
117indicesOne c = chunk
168 where
118 where
169− -- chunk !i (T.Text oarr ooff olen) os = go 0
119+ chunk !i (T.Text oarr ooff olen) os = go 0
170− chunk !i t os = go 0
171 where
120 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
180 go h | h >= olen = case os of
121 go h | h >= olen = case os of
181 Empty -> []
122 Empty -> []
182 Chunk y ys -> chunk (i+fromIntegral olen) y ys
123 Chunk y ys -> chunk (i+fromIntegral olen) y ys
@@ -187,8 +128,7 @@ indicesOne c = chunk
187-- | The number of 'Word16' values in a 'Text'.
128-- | The number of 'Word16' values in a 'Text'.
188wordLength :: Text -> Int64
129wordLength :: Text -> Int64
189wordLength = foldlChunks sumLength 0
130wordLength = foldlChunks sumLength 0
190− where sumLength i t = i + fromIntegral (TT.length t)
191− -- where sumLength i (T.Text _ _ l) = i + fromIntegral l
131+ where sumLength i (T.Text _ _ l) = i + fromIntegral l
192
132
193emptyError :: String -> a
133emptyError :: String -> a
194emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")
134emptyError fun = error ("Data.Text.Lazy.Search." ++ fun ++ ": empty input")
Data/Text/Internal/Private.hs+1−8
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples, CPP #-}
1+{-# LANGUAGE BangPatterns, Rank2Types, UnboxedTuples #-}
2
2
3-- |
3-- |
4-- Module : Data.Text.Internal.Private
4-- Module : Data.Text.Internal.Private
@@ -19,12 +19,8 @@ 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
25
22
26span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
23span_ :: (Char -> Bool) -> Text -> (# Text, Text #)
27−#ifndef __GHCJS__
28span_ p t@(Text arr off len) = (# hd,tl #)
24span_ p t@(Text arr off len) = (# hd,tl #)
29 where hd = text arr off k
25 where hd = text arr off k
30 tl = text arr (off+k) (len-k)
26 tl = text arr (off+k) (len-k)
@@ -32,9 +28,6 @@ span_ p t@(Text arr off len) = (# hd,tl #)
32 loop !i | i < len && p c = loop (i+d)
28 loop !i | i < len && p c = loop (i+d)
33 | otherwise = i
29 | otherwise = i
34 where Iter c d = iter t i
30 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
38{-# INLINE span_ #-}
31{-# INLINE span_ #-}
39
32
40runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
33runText :: (forall s. (A.MArray s -> Int -> ST s Text) -> ST s Text) -> Text
Data/Text/Internal/Search.hs+37−41
@@ -31,15 +31,12 @@ module Data.Text.Internal.Search
31 indices
31 indices
32 ) where
32 ) where
33
33
34−import Data.Coerce
35import qualified Data.Text.Array as A
34import qualified Data.Text.Array as A
36import Data.Word (Word64)
35import Data.Word (Word64)
37import Data.Text.Internal (Text(..))
36import Data.Text.Internal (Text(..))
38import Data.Bits ((.|.), (.&.))
37import Data.Bits ((.|.), (.&.))
39import Data.Text.Internal.Unsafe.Shift (shiftL)
38import Data.Text.Internal.Unsafe.Shift (shiftL)
40
39
41−import qualified Data.JSString.Internal.Search as JSS
42−
43data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
40data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
44
41
45-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
42-- | /O(n+m)/ Find the offsets of all non-overlapping indices of
@@ -52,42 +49,41 @@ data T = {-# UNPACK #-} !Word64 :* {-# UNPACK #-} !Int
52indices :: Text -- ^ Substring to search for (@needle@)
49indices :: Text -- ^ Substring to search for (@needle@)
53 -> Text -- ^ Text to search in (@haystack@)
50 -> Text -- ^ Text to search in (@haystack@)
54 -> [Int]
51 -> [Int]
55−indices = coerce JSS.indices
56−-- indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
52+indices _needle@(Text narr noff nlen) _haystack@(Text harr hoff hlen)
57−-- | nlen == 1 = scanOne (nindex 0)
53+ | nlen == 1 = scanOne (nindex 0)
58−-- | nlen <= 0 || ldiff < 0 = []
54+ | nlen <= 0 || ldiff < 0 = []
59−-- | otherwise = scan 0
55+ | otherwise = scan 0
60−-- where
56+ where
61−-- ldiff = hlen - nlen
57+ ldiff = hlen - nlen
62−-- nlast = nlen - 1
58+ nlast = nlen - 1
63−-- z = nindex nlast
59+ z = nindex nlast
64−-- nindex k = A.unsafeIndex narr (noff+k)
60+ nindex k = A.unsafeIndex narr (noff+k)
65−-- hindex k = A.unsafeIndex harr (hoff+k)
61+ hindex k = A.unsafeIndex harr (hoff+k)
66−-- hindex' k | k == hlen = 0
62+ hindex' k | k == hlen = 0
67−-- | otherwise = A.unsafeIndex harr (hoff+k)
63+ | otherwise = A.unsafeIndex harr (hoff+k)
68−-- buildTable !i !msk !skp
64+ buildTable !i !msk !skp
69−-- | i >= nlast = (msk .|. swizzle z) :* skp
65+ | i >= nlast = (msk .|. swizzle z) :* skp
70−-- | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
66+ | otherwise = buildTable (i+1) (msk .|. swizzle c) skp'
71−-- where c = nindex i
67+ where c = nindex i
72−-- skp' | c == z = nlen - i - 2
68+ skp' | c == z = nlen - i - 2
73−-- | otherwise = skp
69+ | otherwise = skp
74−-- swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)
70+ swizzle k = 1 `shiftL` (fromIntegral k .&. 0x3f)
75−-- scan !i
71+ scan !i
76−-- | i > ldiff = []
72+ | i > ldiff = []
77−-- | c == z && candidateMatch 0 = i : scan (i + nlen)
73+ | c == z && candidateMatch 0 = i : scan (i + nlen)
78−-- | otherwise = scan (i + delta)
74+ | otherwise = scan (i + delta)
79−-- where c = hindex (i + nlast)
75+ where c = hindex (i + nlast)
80−-- candidateMatch !j
76+ candidateMatch !j
81−-- | j >= nlast = True
77+ | j >= nlast = True
82−-- | hindex (i+j) /= nindex j = False
78+ | hindex (i+j) /= nindex j = False
83−-- | otherwise = candidateMatch (j+1)
79+ | otherwise = candidateMatch (j+1)
84−-- delta | nextInPattern = nlen + 1
80+ delta | nextInPattern = nlen + 1
85−-- | c == z = skip + 1
81+ | c == z = skip + 1
86−-- | otherwise = 1
82+ | otherwise = 1
87−-- where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
83+ where nextInPattern = mask .&. swizzle (hindex' (i+nlen)) == 0
88−-- !(mask :* skip) = buildTable 0 0 (nlen-2)
84+ !(mask :* skip) = buildTable 0 0 (nlen-2)
89−-- scanOne c = loop 0
85+ scanOne c = loop 0
90−-- where loop !i | i >= hlen = []
86+ where loop !i | i >= hlen = []
91−-- | hindex i == c = i : loop (i+1)
87+ | hindex i == c = i : loop (i+1)
92−-- | otherwise = loop (i+1)
88+ | otherwise = loop (i+1)
93{-# INLINE indices #-}
89{-# INLINE indices #-}
Data/Text/Lazy.hs+21−103
@@ -6,15 +6,14 @@
6#if __GLASGOW_HASKELL__ >= 708
6#if __GLASGOW_HASKELL__ >= 708
7{-# LANGUAGE TypeFamilies #-}
7{-# LANGUAGE TypeFamilies #-}
8#endif
8#endif
9−#ifdef __GHCJS__
9+
10−{-# LANGUAGE ForeignFunctionInterface #-}
11−#endif
12-- |
10-- |
13-- Module : Data.Text.Lazy
11-- Module : Data.Text.Lazy
14-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
12-- Copyright : (c) 2009, 2010, 2012 Bryan O'Sullivan
15--
13--
16-- License : BSD-style
14-- License : BSD-style
17-- Maintainer : bos@serpentine.com
15-- Maintainer : bos@serpentine.com
16+-- Stability : experimental
18-- Portability : GHC
17-- Portability : GHC
19--
18--
20-- A time and space-efficient implementation of Unicode text using
19-- A time and space-efficient implementation of Unicode text using
@@ -69,7 +68,6 @@ module Data.Text.Lazy
69 , snoc
68 , snoc
70 , append
69 , append
71 , uncons
70 , uncons
72− , unsnoc
73 , head
71 , head
74 , last
72 , last
75 , tail
73 , tail
@@ -246,9 +244,6 @@ import GHC.Prim (Addr#)
246#if MIN_VERSION_base(4,7,0)
244#if MIN_VERSION_base(4,7,0)
247import Text.Printf (PrintfArg, formatArg, formatString)
245import Text.Printf (PrintfArg, formatArg, formatString)
248#endif
246#endif
249−#ifdef __GHCJS__
250−import Data.JSString (JSString)
251−#endif
252
247
253-- $fusion
248-- $fusion
254--
249--
@@ -278,16 +273,14 @@ import Data.JSString (JSString)
278-- $replacement
273-- $replacement
279--
274--
280-- A 'Text' value is a sequence of Unicode scalar values, as defined
275-- A 'Text' value is a sequence of Unicode scalar values, as defined
281−-- in
282−-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35 §3.9, definition D76 of the Unicode 5.2 standard >.
276+-- in &#xa7;3.9, definition D76 of the Unicode 5.2 standard:
277+-- <http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=35>. As
283−-- As such, a 'Text' cannot contain values in the range U+D800 to
278+-- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF
284−-- U+DFFF inclusive. Haskell implementations admit all Unicode code
279+-- inclusive. Haskell implementations admit all Unicode code points
285−-- points
286−-- (<http://www.unicode.org/versions/Unicode5.2.0/ch03.pdf#page=13 §3.4, definition D10 >)
287−-- as 'Char' values, including code points from this invalid range.
280+-- (&#xa7;3.4, definition D10) as 'Char' values, including code points
288−-- This means that there are some 'Char' values that are not valid
281+-- from this invalid range. This means that there are some 'Char'
289−-- Unicode scalar values, and the functions in this module must handle
282+-- values that are not valid Unicode scalar values, and the functions
290−-- those cases.
283+-- in this module must handle those cases.
291--
284--
292-- Within this module, many functions construct a 'Text' from one or
285-- Within this module, many functions construct a 'Text' from one or
293-- more 'Char' values. Those functions will substitute 'Char' values
286-- more 'Char' values. Those functions will substitute 'Char' values
@@ -301,8 +294,8 @@ import Data.JSString (JSString)
301-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
294-- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate
302-- code points, and so cannot be represented. The functions replace
295-- code points, and so cannot be represented. The functions replace
303-- invalid scalar values, instead of dropping them, as a security
296-- invalid scalar values, instead of dropping them, as a security
304−-- measure. For details, see
297+-- measure. For details, see Unicode Technical Report 36, &#xa7;3.5:
305−-- <http://unicode.org/reports/tr36/#Deletion_of_Noncharacters Unicode Technical Report 36, §3.5 >.)
298+-- <http://unicode.org/reports/tr36#Deletion_of_Noncharacters>)
306
299
307equal :: Text -> Text -> Bool
300equal :: Text -> Text -> Bool
308equal Empty Empty = True
301equal Empty Empty = True
@@ -331,7 +324,6 @@ compareText Empty _ = LT
331compareText _ Empty = GT
324compareText _ Empty = GT
332compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
325compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
333 where
326 where
334−#ifndef __GHCJS__
335 outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
327 outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0
336 where
328 where
337 go !i !j
329 go !i !j
@@ -342,20 +334,6 @@ compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0
342 | otherwise = go (i+di) (j+dj)
334 | otherwise = go (i+di) (j+dj)
343 where T.Iter a di = T.iter ta i
335 where T.Iter a di = T.iter ta i
344 T.Iter b dj = T.iter tb j
336 T.Iter b dj = T.iter tb j
345−#else
346− outer ta@(T.Text jsa) tb@(T.Text jsb) = go 0 0
347− where
348− go !i !j
349− | i >= lenA = compareText as (chunk (T.Text (js_substr1 j jsb)) bs)
350− | j >= lenB = compareText (chunk (T.Text (js_substr1 i jsa)) as) bs
351− | a < b = LT
352− | a > b = GT
353− | otherwise = go (i+di) (j+dj)
354− where T.Iter a di = T.iter ta i
355− T.Iter b dj = T.iter tb j
356− lenA = T.length ta
357− lenB = T.length tb
358−#endif
359
337
360instance Show Text where
338instance Show Text where
361 showsPrec p ps r = showsPrec p (unpack ps) r
339 showsPrec p ps r = showsPrec p (unpack ps) r
@@ -364,13 +342,9 @@ instance Read Text where
364 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
342 readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str]
365
343
366#if MIN_VERSION_base(4,9,0)
344#if MIN_VERSION_base(4,9,0)
367−-- | Non-orphan 'Semigroup' instance only defined for
368−-- @base-4.9.0.0@ and later; orphan instances for older GHCs are
345+-- Semigroup orphan instances for older GHCs are provided by
369−-- provided by
370−-- the [semigroups](http://hackage.haskell.org/package/semigroups)
371−-- package
346+-- 'semigroups` package
372−--
347+
373−-- @since 1.2.2.0
374instance Semigroup Text where
348instance Semigroup Text where
375 (<>) = append
349 (<>) = append
376#endif
350#endif
@@ -388,7 +362,6 @@ instance IsString Text where
388 fromString = pack
362 fromString = pack
389
363
390#if __GLASGOW_HASKELL__ >= 708
364#if __GLASGOW_HASKELL__ >= 708
391−-- | @since 1.2.0.0
392instance Exts.IsList Text where
365instance Exts.IsList Text where
393 type Item Text = Char
366 type Item Text = Char
394 fromList = pack
367 fromList = pack
@@ -401,7 +374,6 @@ instance NFData Text where
401 rnf (Chunk _ ts) = rnf ts
374 rnf (Chunk _ ts) = rnf ts
402#endif
375#endif
403
376
404−-- | @since 1.2.1.0
405instance Binary Text where
377instance Binary Text where
406 put t = put (encodeUtf8 t)
378 put t = put (encodeUtf8 t)
407 get = do
379 get = do
@@ -425,8 +397,6 @@ instance Data Text where
425
397
426#if MIN_VERSION_base(4,7,0)
398#if MIN_VERSION_base(4,7,0)
427-- | Only defined for @base-4.7.0.0@ and later
399-- | Only defined for @base-4.7.0.0@ and later
428−--
429−-- @since 1.2.2.0
430instance PrintfArg Text where
400instance PrintfArg Text where
431 formatArg txt = formatString $ unpack txt
401 formatArg txt = formatString $ unpack txt
432#endif
402#endif
@@ -505,7 +475,9 @@ fromStrict t = chunk t Empty
505-- -----------------------------------------------------------------------------
475-- -----------------------------------------------------------------------------
506-- * Basic functions
476-- * Basic functions
507
477
508−-- | /O(1)/ Adds a character to the front of a 'Text'. Subject to fusion.
478+-- | /O(n)/ Adds a character to the front of a 'Text'. This function
479+-- is more costly than its 'List' counterpart because it requires
480+-- copying a new array. Subject to fusion.
509cons :: Char -> Text -> Text
481cons :: Char -> Text -> Text
510cons c t = Chunk (T.singleton c) t
482cons c t = Chunk (T.singleton c) t
511{-# INLINE [1] cons #-}
483{-# INLINE [1] cons #-}
@@ -589,17 +561,6 @@ init Empty = emptyError "init"
589 unstream (S.init (stream t)) = init t
561 unstream (S.init (stream t)) = init t
590 #-}
562 #-}
591
563
592−-- | /O(n\/c)/ Returns the 'init' and 'last' of a 'Text', or 'Nothing' if
593−-- empty.
594−--
595−-- * It is no faster than using 'init' and 'last'.
596−--
597−-- @since 1.2.3.0
598−unsnoc :: Text -> Maybe (Text, Char)
599−unsnoc Empty = Nothing
600−unsnoc ts@(Chunk _ _) = Just (init ts, last ts)
601−{-# INLINE unsnoc #-}
602−
603-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
564-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
604-- fusion.
565-- fusion.
605null :: Text -> Bool
566null :: Text -> Bool
@@ -859,8 +820,6 @@ toUpper t = unstream (S.toUpper (stream t))
859-- guides disagree on whether the book name \"The Hill of the Red
820-- guides disagree on whether the book name \"The Hill of the Red
860-- Fox\" is correctly title cased&#x2014;but this function will
821-- Fox\" is correctly title cased&#x2014;but this function will
861-- capitalize /every/ word.
822-- capitalize /every/ word.
862−--
863−-- @since 1.0.0.0
864toTitle :: Text -> Text
823toTitle :: Text -> Text
865toTitle t = unstream (S.toTitle (stream t))
824toTitle t = unstream (S.toTitle (stream t))
866{-# INLINE toTitle #-}
825{-# INLINE toTitle #-}
@@ -1013,8 +972,6 @@ mapAccumR f = go
1013
972
1014-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every
973-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every
1015-- element.
974-- element.
1016−--
1017−-- @since 1.2.0.5
1018repeat :: Char -> Text
975repeat :: Char -> Text
1019repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t
976repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t
1020 in t
977 in t
@@ -1032,8 +989,6 @@ replicate n t
1032
989
1033-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or
990-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or
1034-- equivalently, the infinite repetition of the original 'Text'.
991-- equivalently, the infinite repetition of the original 'Text'.
1035−--
1036−-- @since 1.2.0.5
1037cycle :: Text -> Text
992cycle :: Text -> Text
1038cycle Empty = emptyError "cycle"
993cycle Empty = emptyError "cycle"
1039cycle t = let t' = foldrChunks Chunk t' t
994cycle t = let t' = foldrChunks Chunk t' t
@@ -1043,8 +998,6 @@ cycle t = let t' = foldrChunks Chunk t' t
1043-- of @f@ to @x@:
998-- of @f@ to @x@:
1044--
999--
1045-- > iterate f x == [x, f x, f (f x), ...]
1000-- > iterate f x == [x, f x, f (f x), ...]
1046−--
1047−-- @since 1.2.0.5
1048iterate :: (Char -> Char) -> Char -> Text
1001iterate :: (Char -> Char) -> Char -> Text
1049iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))
1002iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))
1050 in t c
1003 in t c
@@ -1108,8 +1061,6 @@ take i t0 = take' i t0
1108-- Examples:
1061-- Examples:
1109--
1062--
1110-- > takeEnd 3 "foobar" == "bar"
1063-- > takeEnd 3 "foobar" == "bar"
1111−--
1112−-- @since 1.1.1.0
1113takeEnd :: Int64 -> Text -> Text
1064takeEnd :: Int64 -> Text -> Text
1114takeEnd n t0
1065takeEnd n t0
1115 | n <= 0 = empty
1066 | n <= 0 = empty
@@ -1148,8 +1099,6 @@ drop i t0
1148-- Examples:
1099-- Examples:
1149--
1100--
1150-- > dropEnd 3 "foobar" == "foo"
1101-- > dropEnd 3 "foobar" == "foo"
1151−--
1152−-- @since 1.1.1.0
1153dropEnd :: Int64 -> Text -> Text
1102dropEnd :: Int64 -> Text -> Text
1154dropEnd n t0
1103dropEnd n t0
1155 | n <= 0 = t0
1104 | n <= 0 = t0
@@ -1170,20 +1119,11 @@ dropWords i t0
1170 | otherwise = drop' i t0
1119 | otherwise = drop' i t0
1171 where drop' 0 ts = ts
1120 where drop' 0 ts = ts
1172 drop' _ Empty = Empty
1121 drop' _ Empty = Empty
1173−#ifndef __GHCJS__
1174 drop' n (Chunk (T.Text arr off len) ts)
1122 drop' n (Chunk (T.Text arr off len) ts)
1175 | n < len' = chunk (text arr (off+n') (len-n')) ts
1123 | n < len' = chunk (text arr (off+n') (len-n')) ts
1176 | otherwise = drop' (n - len') ts
1124 | otherwise = drop' (n - len') ts
1177 where len' = fromIntegral len
1125 where len' = fromIntegral len
1178 n' = fromIntegral n
1126 n' = fromIntegral n
1179−#else
1180− drop' n (Chunk t@(T.Text jst) ts)
1181− | n < len' = chunk (T.Text $ js_substr1 n' jst) ts
1182− | otherwise = drop' (n - len') ts
1183− where len' = fromIntegral len
1184− len = T.length t
1185− n' = fromIntegral n
1186−#endif
1187
1127
1188-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1128-- | /O(n)/ 'takeWhile', applied to a predicate @p@ and a 'Text',
1189-- returns the longest prefix (possibly empty) of elements that
1129-- returns the longest prefix (possibly empty) of elements that
@@ -1210,15 +1150,12 @@ takeWhile p t0 = takeWhile' t0
1210-- Examples:
1150-- Examples:
1211--
1151--
1212-- > takeWhileEnd (=='o') "foo" == "oo"
1152-- > takeWhileEnd (=='o') "foo" == "oo"
1213−--
1214−-- @since 1.2.2.0
1215takeWhileEnd :: (Char -> Bool) -> Text -> Text
1153takeWhileEnd :: (Char -> Bool) -> Text -> Text
1216takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1154takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1217 where takeChunk acc [] = acc
1155 where takeChunk acc [] = acc
1218− takeChunk acc (t:ts)
1156+ takeChunk acc (t:ts) = if T.length t' < T.length t
1219− | T.lengthWord16 t' < T.lengthWord16 t
1157+ then (Chunk t' acc)
1220− = chunk t' acc
1221− | otherwise = takeChunk (Chunk t' acc) ts
1158+ else takeChunk (Chunk t' acc) ts
1222 where t' = T.takeWhileEnd p t
1159 where t' = T.takeWhileEnd p t
1223{-# INLINE takeWhileEnd #-}
1160{-# INLINE takeWhileEnd #-}
1224
1161
@@ -1307,22 +1244,12 @@ splitAt = loop
1307-- values, and whose second is the remainder of the string.
1244-- values, and whose second is the remainder of the string.
1308splitAtWord :: Int64 -> Text -> PairS Text Text
1245splitAtWord :: Int64 -> Text -> PairS Text Text
1309splitAtWord _ Empty = empty :*: empty
1246splitAtWord _ Empty = empty :*: empty
1310−#ifndef __GHCJS__
1311splitAtWord x (Chunk c@(T.Text arr off len) cs)
1247splitAtWord x (Chunk c@(T.Text arr off len) cs)
1312 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1248 | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1313 in Chunk c h :*: t
1249 in Chunk c h :*: t
1314 | otherwise = chunk (text arr off y) empty :*:
1250 | otherwise = chunk (text arr off y) empty :*:
1315 chunk (text arr (off+y) (len-y)) cs
1251 chunk (text arr (off+y) (len-y)) cs
1316 where y = fromIntegral x
1252 where y = fromIntegral x
1317−#else
1318−splitAtWord x (Chunk c@(T.Text jst) cs)
1319− | y >= len = let h :*: t = splitAtWord (x-fromIntegral len) cs
1320− in Chunk c h :*: t
1321− | otherwise = chunk (T.Text (js_substr 0 (y-1) jst)) empty :*:
1322− chunk (T.Text (js_substr1 y jst)) cs
1323− where y = fromIntegral x
1324− len = T.length c
1325−#endif
1326
1253
1327-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1254-- | /O(n+m)/ Find the first instance of @needle@ (which must be
1328-- non-'null') in @haystack@. The first element of the returned tuple
1255-- non-'null') in @haystack@. The first element of the returned tuple
@@ -1502,11 +1429,7 @@ splitOn pat src
1502 go _ [] cs = [cs]
1429 go _ [] cs = [cs]
1503 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1430 go !i (x:xs) cs = let h :*: t = splitAtWord (x-i) cs
1504 in h : go (x+l) xs (dropWords l t)
1431 in h : go (x+l) xs (dropWords l t)
1505−#ifndef __GHCJS__
1506 l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1432 l = foldlChunks (\a (T.Text _ _ b) -> a + fromIntegral b) 0 pat
1507−#else
1508− l = foldlChunks (\a t -> a + fromIntegral (T.length t)) 0 pat
1509−#endif
1510{-# INLINE [1] splitOn #-}
1433{-# INLINE [1] splitOn #-}
1511
1434
1512{-# RULES
1435{-# RULES
@@ -1770,8 +1693,3 @@ emptyError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": empty input")
1770
1693
1771impossibleError :: String -> a
1694impossibleError :: String -> a
1772impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")
1695impossibleError fun = P.error ("Data.Text.Lazy." ++ fun ++ ": impossible case")
1773−
1774−#ifdef __GHCJS__
1775−foreign import javascript unsafe "$2.substr($1)" js_substr1 :: Exts.Int -> JSString -> JSString
1776−foreign import javascript unsafe "$3.substr($1,$2)" js_substr :: Exts.Int -> Exts.Int -> JSString -> JSString
1777−#endif
Data/Text/Lazy/Builder.hs+1
@@ -11,6 +11,7 @@
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
14-- Portability : portable to Hugs and GHC
15-- Portability : portable to Hugs and GHC
15--
16--
16-- Efficient construction of lazy @Text@ values. The principal
17-- Efficient construction of lazy @Text@ values. The principal
Data/Text/Lazy/Builder/Int.hs+1−3
@@ -9,6 +9,7 @@
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
12-- Portability: portable
13-- Portability: portable
13--
14--
14-- Efficiently write an integral value to a 'Builder'.
15-- Efficiently write an integral value to a 'Builder'.
@@ -31,9 +32,6 @@ import GHC.Base (quotInt, remInt)
31import GHC.Num (quotRemInteger)
32import GHC.Num (quotRemInteger)
32import GHC.Types (Int(..))
33import GHC.Types (Int(..))
33import Control.Monad.ST
34import Control.Monad.ST
34−#if MIN_VERSION_base(4,11,0)
35−import Prelude hiding ((<>))
36−#endif
37
35
38#ifdef __GLASGOW_HASKELL__
36#ifdef __GLASGOW_HASKELL__
39# if defined(INTEGER_GMP)
37# if defined(INTEGER_GMP)
Data/Text/Lazy/Builder/RealFloat.hs+15−20
@@ -11,23 +11,19 @@
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−
31
27
32-- | Control the rendering of floating point numbers.
28-- | Control the rendering of floating point numbers.
33data FPFormat = Exponent
29data FPFormat = Exponent
@@ -37,7 +33,7 @@ data FPFormat = Exponent
37 | Generic
33 | Generic
38 -- ^ Use decimal notation for values between @0.1@ and
34 -- ^ Use decimal notation for values between @0.1@ and
39 -- @9,999,999@, and scientific notation otherwise.
35 -- @9,999,999@, and scientific notation otherwise.
40− deriving (Enum, Read, Show)
36+ deriving (Enum, Read, Show)
41
37
42-- | Show a signed 'RealFloat' value to full precision,
38-- | Show a signed 'RealFloat' value to full precision,
43-- using standard decimal notation for arguments whose absolute value lies
39-- using standard decimal notation for arguments whose absolute value lies
@@ -232,16 +228,15 @@ maxExpt = 1100
232
228
233expt :: Integer -> Int -> Integer
229expt :: Integer -> Int -> Integer
234expt base n
230expt base n
235− | base == 2 && n >= minExpt && n <= maxExpt = expts !! n
231+ | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n
236− | base == 10 && n <= maxExpt10 = expts10 !! n
232+ | base == 10 && n <= maxExpt10 = expts10 `unsafeAt` n
237 | otherwise = base^n
233 | otherwise = base^n
238
234
239−expts :: [Integer]
235+expts :: Array Int Integer
240−expts = [2^n | n <- [minExpt .. maxExpt]]
236+expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]
241
237
242maxExpt10 :: Int
238maxExpt10 :: Int
243maxExpt10 = 324
239maxExpt10 = 324
244
240
245−expts10 :: [Integer]
241+expts10 :: Array Int Integer
246−expts10 = [10^n | n <- [minExpt .. maxExpt10]]
242+expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]
247−
Data/Text/Lazy/Encoding.hs+3−13
@@ -8,13 +8,14 @@
8--
8--
9-- License : BSD-style
9-- License : BSD-style
10-- Maintainer : bos@serpentine.com
10-- Maintainer : bos@serpentine.com
11+-- Stability : experimental
11-- Portability : portable
12-- Portability : portable
12--
13--
13-- Functions for converting lazy 'Text' values to and from lazy
14-- Functions for converting lazy 'Text' values to and from lazy
14-- 'ByteString', using several standard encodings.
15-- 'ByteString', using several standard encodings.
15--
16--
16−-- To gain access to a much larger family of encodings, use the
17+-- To gain access to a much larger variety of encodings, use the
17−-- <http://hackage.haskell.org/package/text-icu text-icu package>.
18+-- @text-icu@ package: <http://hackage.haskell.org/package/text-icu>
18
19
19module Data.Text.Lazy.Encoding
20module Data.Text.Lazy.Encoding
20 (
21 (
@@ -140,7 +141,6 @@ decodeUtf8' bs = unsafeDupablePerformIO $ do
140 rnf (Chunk _ ts) = rnf ts
141 rnf (Chunk _ ts) = rnf ts
141{-# INLINE decodeUtf8' #-}
142{-# INLINE decodeUtf8' #-}
142
143
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,20 +154,10 @@ 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
160encodeUtf8Builder :: Text -> B.Builder
157encodeUtf8Builder :: Text -> B.Builder
161encodeUtf8Builder =
158encodeUtf8Builder =
162 foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty
159 foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty
163
160
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
171{-# INLINE encodeUtf8BuilderEscaped #-}
161{-# INLINE encodeUtf8BuilderEscaped #-}
172encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
162encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder
173encodeUtf8BuilderEscaped prim =
163encodeUtf8BuilderEscaped prim =
Data/Text/Lazy/IO.hs+1
@@ -8,6 +8,7 @@
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
11-- Portability : GHC
12-- Portability : GHC
12--
13--
13-- Efficient locale-sensitive support for lazy text I\/O.
14-- Efficient locale-sensitive support for lazy text I\/O.
Data/Text/Lazy/Read.hs+4−3
@@ -11,6 +11,7 @@
11--
11--
12-- License : BSD-style
12-- License : BSD-style
13-- Maintainer : bos@serpentine.com
13-- Maintainer : bos@serpentine.com
14+-- Stability : experimental
14-- Portability : GHC
15-- Portability : GHC
15--
16--
16-- Functions used frequently when reading textual data.
17-- Functions used frequently when reading textual data.
@@ -67,9 +68,9 @@ decimal txt
67 go n d = (n * 10 + fromIntegral (digitToInt d))
68 go n d = (n * 10 + fromIntegral (digitToInt d))
68
69
69-- | Read a hexadecimal integer, consisting of an optional leading
70-- | Read a hexadecimal integer, consisting of an optional leading
70−-- @\"0x\"@ followed by at least one hexadecimal digit. Input is
71+-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
71−-- consumed until a non-hex-digit or end of string is reached.
72+-- until a non-hex-digit or end of string is reached. This function
72−-- This function is case insensitive.
73+-- is case insensitive.
73--
74--
74-- This function does not handle leading sign characters. If you need
75-- This function does not handle leading sign characters. If you need
75-- to handle signed input, use @'signed' 'hexadecimal'@.
76-- to handle signed input, use @'signed' 'hexadecimal'@.
Data/Text/Read.hs+4−3
@@ -9,6 +9,7 @@
9--
9--
10-- License : BSD-style
10-- License : BSD-style
11-- Maintainer : bos@serpentine.com
11-- Maintainer : bos@serpentine.com
12+-- Stability : experimental
12-- Portability : GHC
13-- Portability : GHC
13--
14--
14-- Functions used frequently when reading textual data.
15-- Functions used frequently when reading textual data.
@@ -66,9 +67,9 @@ decimal txt
66 go n d = (n * 10 + fromIntegral (digitToInt d))
67 go n d = (n * 10 + fromIntegral (digitToInt d))
67
68
68-- | Read a hexadecimal integer, consisting of an optional leading
69-- | Read a hexadecimal integer, consisting of an optional leading
69−-- @\"0x\"@ followed by at least one hexadecimal digit. Input is
70+-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
70−-- consumed until a non-hex-digit or end of string is reached.
71+-- until a non-hex-digit or end of string is reached. This function
71−-- This function is case insensitive.
72+-- is case insensitive.
72--
73--
73-- This function does not handle leading sign characters. If you need
74-- This function does not handle leading sign characters. If you need
74-- to handle signed input, use @'signed' 'hexadecimal'@.
75-- to handle signed input, use @'signed' 'hexadecimal'@.
Data/Text/Show.hs−2
@@ -46,8 +46,6 @@ 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
51unpackCString# :: Addr# -> Text
49unpackCString# :: Addr# -> Text
52unpackCString# addr# = unstream (S.streamCString# addr#)
50unpackCString# addr# = unstream (S.streamCString# addr#)
53{-# NOINLINE unpackCString# #-}
51{-# NOINLINE unpackCString# #-}
Data/Text/Unsafe.hs+1−89
@@ -1,12 +1,10 @@
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
1{-# LANGUAGE CPP, MagicHash, UnboxedTuples #-}
2−#ifdef __GHCJS__
3−{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes #-}
4−#endif
5-- |
2-- |
6-- Module : Data.Text.Unsafe
3-- Module : Data.Text.Unsafe
7-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
4-- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan
8-- License : BSD-style
5-- License : BSD-style
9-- Maintainer : bos@serpentine.com
6-- Maintainer : bos@serpentine.com
7+-- Stability : experimental
10-- Portability : portable
8-- Portability : portable
11--
9--
12-- A module containing unsafe 'Text' operations, for very very careful
10-- A module containing unsafe 'Text' operations, for very very careful
@@ -34,47 +32,31 @@ import Control.Exception (assert)
34import Data.Text.Internal.Encoding.Utf16 (chr2)
32import Data.Text.Internal.Encoding.Utf16 (chr2)
35import Data.Text.Internal (Text(..))
33import Data.Text.Internal (Text(..))
36import Data.Text.Internal.Unsafe (inlineInterleaveST, inlinePerformIO)
34import 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
44import Data.Text.Internal.Unsafe.Char (unsafeChr)
35import Data.Text.Internal.Unsafe.Char (unsafeChr)
45import qualified Data.Text.Array as A
36import qualified Data.Text.Array as A
46−#endif
47import GHC.IO (unsafeDupablePerformIO)
37import GHC.IO (unsafeDupablePerformIO)
48
38
49-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
39-- | /O(1)/ A variant of 'head' for non-empty 'Text'. 'unsafeHead'
50-- omits the check for the empty case, so there is an obligation on
40-- omits the check for the empty case, so there is an obligation on
51-- the programmer to provide a proof that the 'Text' is non-empty.
41-- the programmer to provide a proof that the 'Text' is non-empty.
52unsafeHead :: Text -> Char
42unsafeHead :: Text -> Char
53−#ifndef __GHCJS__
54unsafeHead (Text arr off _len)
43unsafeHead (Text arr off _len)
55 | m < 0xD800 || m > 0xDBFF = unsafeChr m
44 | m < 0xD800 || m > 0xDBFF = unsafeChr m
56 | otherwise = chr2 m n
45 | otherwise = chr2 m n
57 where m = A.unsafeIndex arr off
46 where m = A.unsafeIndex arr off
58 n = A.unsafeIndex arr (off+1)
47 n = A.unsafeIndex arr (off+1)
59−#else
60−unsafeHead = coerce JSS.rawHead
61−#endif
62{-# INLINE unsafeHead #-}
48{-# INLINE unsafeHead #-}
63
49
64-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'
50-- | /O(1)/ A variant of 'tail' for non-empty 'Text'. 'unsafeTail'
65-- omits the check for the empty case, so there is an obligation on
51-- omits the check for the empty case, so there is an obligation on
66-- the programmer to provide a proof that the 'Text' is non-empty.
52-- the programmer to provide a proof that the 'Text' is non-empty.
67unsafeTail :: Text -> Text
53unsafeTail :: Text -> Text
68−#ifndef __GHCJS__
69unsafeTail t@(Text arr off len) =
54unsafeTail t@(Text arr off len) =
70#if defined(ASSERTS)
55#if defined(ASSERTS)
71 assert (d <= len) $
56 assert (d <= len) $
72#endif
57#endif
73 Text arr (off+d) (len-d)
58 Text arr (off+d) (len-d)
74 where d = iter_ t 0
59 where d = iter_ t 0
75−#else
76−unsafeTail = coerce JSS.rawTail
77−#endif
78{-# INLINE unsafeTail #-}
60{-# INLINE unsafeTail #-}
79
61
80data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
62data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
@@ -83,7 +65,6 @@ data Iter = Iter {-# UNPACK #-} !Char {-# UNPACK #-} !Int
83-- array, returning the current character and the delta to add to give
65-- array, returning the current character and the delta to add to give
84-- the next offset to iterate at.
66-- the next offset to iterate at.
85iter :: Text -> Int -> Iter
67iter :: Text -> Int -> Iter
86−#ifndef __GHCJS__
87iter (Text arr off _len) i
68iter (Text arr off _len) i
88 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
69 | m < 0xD800 || m > 0xDBFF = Iter (unsafeChr m) 1
89 | otherwise = Iter (chr2 m n) 2
70 | otherwise = Iter (chr2 m n) 2
@@ -91,40 +72,20 @@ iter (Text arr off _len) i
91 n = A.unsafeIndex arr k
72 n = A.unsafeIndex arr k
92 j = off + i
73 j = off + i
93 k = j + 1
74 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
106{-# INLINE iter #-}
75{-# INLINE iter #-}
107
76
108-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
77-- | /O(1)/ Iterate one step through a UTF-16 array, returning the
109-- delta to add to give the next offset to iterate at.
78-- delta to add to give the next offset to iterate at.
110iter_ :: Text -> Int -> Int
79iter_ :: Text -> Int -> Int
111−#ifndef __GHCJS__
112iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1
80iter_ (Text arr off _len) i | m < 0xD800 || m > 0xDBFF = 1
113 | otherwise = 2
81 | otherwise = 2
114 where m = A.unsafeIndex arr (off+i)
82 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
121{-# INLINE iter_ #-}
83{-# INLINE iter_ #-}
122
84
123-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
85-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
124-- returning the current character and the delta to add (i.e. a
86-- returning the current character and the delta to add (i.e. a
125-- negative number) to give the next offset to iterate at.
87-- negative number) to give the next offset to iterate at.
126reverseIter :: Text -> Int -> (Char,Int)
88reverseIter :: Text -> Int -> (Char,Int)
127−#ifndef __GHCJS__
128reverseIter (Text arr off _len) i
89reverseIter (Text arr off _len) i
129 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)
90 | m < 0xDC00 || m > 0xDFFF = (unsafeChr m, -1)
130 | otherwise = (chr2 n m, -2)
91 | otherwise = (chr2 n m, -2)
@@ -132,80 +93,31 @@ reverseIter (Text arr off _len) i
132 n = A.unsafeIndex arr k
93 n = A.unsafeIndex arr k
133 j = off + i
94 j = off + i
134 k = j - 1
95 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
147{-# INLINE reverseIter #-}
96{-# INLINE reverseIter #-}
148
97
149-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
98-- | /O(1)/ Iterate one step backwards through a UTF-16 array,
150-- returning the delta to add (i.e. a negative number) to give the
99-- returning the delta to add (i.e. a negative number) to give the
151-- next offset to iterate at.
100-- next offset to iterate at.
152−--
153−-- @since 1.1.1.0
154reverseIter_ :: Text -> Int -> Int
101reverseIter_ :: Text -> Int -> Int
155−#ifndef __GHCJS__
156reverseIter_ (Text arr off _len) i
102reverseIter_ (Text arr off _len) i
157 | m < 0xDC00 || m > 0xDFFF = -1
103 | m < 0xDC00 || m > 0xDFFF = -1
158 | otherwise = -2
104 | otherwise = -2
159 where m = A.unsafeIndex arr (off+i)
105 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
168{-# INLINE reverseIter_ #-}
106{-# INLINE reverseIter_ #-}
169
107
170-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
108-- | /O(1)/ Return the length of a 'Text' in units of 'Word16'. This
171-- is useful for sizing a target array appropriately before using
109-- is useful for sizing a target array appropriately before using
172-- 'unsafeCopyToPtr'.
110-- 'unsafeCopyToPtr'.
173lengthWord16 :: Text -> Int
111lengthWord16 :: Text -> Int
174−#ifndef __GHCJS__
175lengthWord16 (Text _arr _off len) = len
112lengthWord16 (Text _arr _off len) = len
176−#else
177−lengthWord16 (Text t) = js_length t
178−#endif
179{-# INLINE lengthWord16 #-}
113{-# INLINE lengthWord16 #-}
180
114
181-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.
115-- | /O(1)/ Unchecked take of 'k' 'Word16's from the front of a 'Text'.
182takeWord16 :: Int -> Text -> Text
116takeWord16 :: Int -> Text -> Text
183−#ifndef __GHCJS__
184takeWord16 k (Text arr off _len) = Text arr off k
117takeWord16 k (Text arr off _len) = Text arr off k
185−#else
186−takeWord16 k (Text txt) = Text $ js_take k txt
187−#endif
188{-# INLINE takeWord16 #-}
118{-# INLINE takeWord16 #-}
189
119
190-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.
120-- | /O(1)/ Unchecked drop of 'k' 'Word16's from the front of a 'Text'.
191dropWord16 :: Int -> Text -> Text
121dropWord16 :: Int -> Text -> Text
192−#ifndef __GHCJS__
193dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)
122dropWord16 k (Text arr off len) = Text arr (off+k) (len-k)
194−#else
195−dropWord16 k (Text txt) = Text $ js_drop k txt
196−#endif
197{-# INLINE dropWord16 #-}
123{-# INLINE dropWord16 #-}
198−
199−#ifdef __GHCJS__
200−foreign import javascript unsafe
201− "$2.charCodeAt($1)" js_charCodeAt :: Int -> JSString -> Int#
202−
203−foreign import javascript unsafe
204− "h$jsstringTake" js_take :: Int -> JSString -> JSString
205−
206−foreign import javascript unsafe
207− "h$jsstringDrop" js_drop :: Int -> JSString -> JSString
208−
209−foreign import javascript unsafe
210− "$1.length" js_length :: JSString -> Int
211−#endif
README.markdown+16−5
@@ -1,18 +1,29 @@
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−**Please refer to the [package description on Hackage](https://hackage.haskell.org/package/text#description) for more information.**
6+
7+# Normalization, conversion, and collation, oh my!
8+
9+This library intentionally provides a simple API based on the
10+Haskell prelude's list manipulation functions. For more complicated
11+real-world tasks, such as Unicode normalization, conversion to and
12+from a larger variety of encodings, and collation, use the [text-icu
13+package](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/text-icu).
14+
15+That library uses the well-respected and liberally licensed ICU
16+library to provide these facilities.
17+
7
18
8# Get involved!
19# Get involved!
9
20
10Please report bugs via the
21Please report bugs via the
11−[github issue tracker](https://github.com/haskell/text/issues).
22+[github issue tracker](https://github.com/bos/text/issues).
12
23
13−Master [git repository](https://github.com/haskell/text):
24+Master [git repository](https://github.com/bos/text):
14
25
15−* `git clone git://github.com/haskell/text.git`
26+* `git clone git://github.com/bos/text.git`
16
27
17There's also a [Mercurial mirror](https://bitbucket.org/bos/text):
28There's also a [Mercurial mirror](https://bitbucket.org/bos/text):
18
29
benchmarks/.gitignore+1−4
@@ -1,4 +1 @@
1−/dist/
2−/dist-newstyle/
1+dist
3−/.ghc.environment.*
4−/cabal.project.local
benchmarks/cabal.projectdeleted−2
@@ -1,2 +0,0 @@
1−-- NB: we use a separate project
2−packages: .
benchmarks/haskell/Benchmarks.hs−2
@@ -10,7 +10,6 @@ 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
14import qualified Benchmarks.DecodeUtf8 as DecodeUtf8
13import qualified Benchmarks.DecodeUtf8 as DecodeUtf8
15import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
14import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
16import qualified Benchmarks.Equality as Equality
15import qualified Benchmarks.Equality as Equality
@@ -42,7 +41,6 @@ benchmarks = do
42 -- Traditional benchmarks
41 -- Traditional benchmarks
43 bs <- sequence
42 bs <- sequence
44 [ Builder.benchmark
43 [ Builder.benchmark
45− , Concat.benchmark
46 , DecodeUtf8.benchmark "html" (tf "libya-chinese.html")
44 , DecodeUtf8.benchmark "html" (tf "libya-chinese.html")
47 , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml")
45 , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml")
48 , DecodeUtf8.benchmark "ascii" (tf "ascii.txt")
46 , DecodeUtf8.benchmark "ascii" (tf "ascii.txt")
benchmarks/haskell/Benchmarks/Concat.hsdeleted−25
@@ -1,25 +0,0 @@
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+8−82
@@ -12,7 +12,8 @@ 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+
15−cabal-version: >=1.8
16+cabal-version: >=1.2
16
17
17flag bytestring-builder
18flag bytestring-builder
18 description: Depend on the bytestring-builder package for backwards compatibility.
19 description: Depend on the bytestring-builder package for backwards compatibility.
@@ -25,12 +26,16 @@ flag llvm
25 manual: True
26 manual: True
26
27
27executable text-benchmarks
28executable 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
28 ghc-options: -Wall -O2 -rtsopts
34 ghc-options: -Wall -O2 -rtsopts
29 if flag(llvm)
35 if flag(llvm)
30 ghc-options: -fllvm
36 ghc-options: -fllvm
31 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
37 cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP
32− build-depends: array,
38+ build-depends: base == 4.*,
33− base == 4.*,
34 binary,
39 binary,
35 blaze-builder,
40 blaze-builder,
36 bytestring-lexing >= 0.5.0,
41 bytestring-lexing >= 0.5.0,
@@ -42,7 +47,6 @@ executable text-benchmarks
42 ghc-prim,
47 ghc-prim,
43 integer-gmp,
48 integer-gmp,
44 stringsearch,
49 stringsearch,
45− transformers,
46 utf8-string,
50 utf8-string,
47 vector
51 vector
48
52
@@ -52,87 +56,9 @@ executable text-benchmarks
52 else
56 else
53 build-depends: bytestring >= 0.10.4
57 build-depends: bytestring >= 0.10.4
54
58
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−
132executable text-multilang
59executable text-multilang
133 hs-source-dirs: haskell
60 hs-source-dirs: haskell
134 main-is: Multilang.hs
61 main-is: Multilang.hs
135− other-modules: Timer
136 ghc-options: -Wall -O2
62 ghc-options: -Wall -O2
137 build-depends: base == 4.*,
63 build-depends: base == 4.*,
138 bytestring,
64 bytestring,
cabal.projectdeleted−3
@@ -1,3 +0,0 @@
1−-- See http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html
2−packages: .
3−tests: True
cbits/cbits.c+11−6
@@ -206,9 +206,11 @@ _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− _hs_text_decode_utf8_int(dest, destoff, src, srcend, codepoint0, state0);
209+ uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,
210−
210+ codepoint0, state0);
211+ if (*state0 == UTF8_REJECT)
212+ ret -=1;
211− return *src;
213+ return ret;
212}
214}
213
215
214/*
216/*
@@ -220,9 +222,12 @@ _hs_text_decode_utf8(uint16_t *const dest, size_t *destoff,
220{
222{
221 uint32_t codepoint;
223 uint32_t codepoint;
222 uint32_t state = UTF8_ACCEPT;
224 uint32_t state = UTF8_ACCEPT;
223− _hs_text_decode_utf8_int(dest, destoff, &src, srcend,
225+ uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, &src, srcend,
224− &codepoint, &state);
226+ &codepoint, &state);
227+ /* Back up if we have an incomplete or invalid encoding */
228+ if (state != UTF8_ACCEPT)
229+ ret -= 1;
225− return src;
230+ return ret;
226}
231}
227
232
228void
233void
changelog.md+19−61
@@ -1,57 +1,15 @@
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−
43−#### 1.2.2.1
1+1.2.2.1
44
2
45* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.
3* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.
46 The build flag has been renamed accordingly. Your army of diligent
4 The build flag has been renamed accordingly. Your army of diligent
47 maintainers apologizes for the churn.
5 maintainers apologizes for the churn.
48
6
49−* Spec compliance: `toCaseFold` now follows the Unicode 8.0 spec
7+* Spec compliance: toCaseFold now follows the Unicode 8.0 spec
50 (updated from 7.0)
8 (updated from 7.0)
51
9
52* An STG lint error has been fixed
10* An STG lint error has been fixed
53
11
54−### 1.2.2.0
12+1.2.2.0
55
13
56* The `integer-simple` package, upon which this package optionally
14* The `integer-simple` package, upon which this package optionally
57 depended, has been replaced with `integer-pure`. The build flag has
15 depended, has been replaced with `integer-pure`. The build flag has
@@ -67,7 +25,7 @@
67 * if `base` >= 4.7: `PrintfArg`
25 * if `base` >= 4.7: `PrintfArg`
68 * if `base` >= 4.9: `Semigroup`
26 * if `base` >= 4.9: `Semigroup`
69
27
70−#### 1.2.1.3
28+1.2.1.3
71
29
72* Bug fix: As it turns out, moving the literal rewrite rules to simplifier
30* Bug fix: As it turns out, moving the literal rewrite rules to simplifier
73 phase 2 does not prevent competition with the `unpack` rule, which is
31 phase 2 does not prevent competition with the `unpack` rule, which is
@@ -75,7 +33,7 @@
75 test environment mistake. Moving literal rules back to phase 1 finally
33 test environment mistake. Moving literal rules back to phase 1 finally
76 fixes GHC Trac #10528 correctly.
34 fixes GHC Trac #10528 correctly.
77
35
78−#### 1.2.1.2
36+1.2.1.2
79
37
80* Bug fix: Run literal rewrite rules in simplifier phase 2.
38* Bug fix: Run literal rewrite rules in simplifier phase 2.
81 The behavior of the simplifier changed in GHC 7.10.2,
39 The behavior of the simplifier changed in GHC 7.10.2,
@@ -83,21 +41,21 @@
83 and long compilation times. See
41 and long compilation times. See
84 [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528).
42 [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528).
85
43
86−#### 1.2.1.1
44+1.2.1.1
87
45
88* Expose unpackCString#, which you should never use.
46* Expose unpackCString#, which you should never use.
89
47
90−### 1.2.1.0
48+1.2.1.0
91
49
92* Added Binary instances for both Text types. (If you have previously
50* Added Binary instances for both Text types. (If you have previously
93 been using the text-binary package to get a Binary instance, it is
51 been using the text-binary package to get a Binary instance, it is
94 now obsolete.)
52 now obsolete.)
95
53
96−#### 1.2.0.6
54+1.2.0.6
97
55
98* Fixed a space leak in UTF-8 decoding
56* Fixed a space leak in UTF-8 decoding
99
57
100−#### 1.2.0.5
58+1.2.0.5
101
59
102* Feature parity: repeat, cycle, iterate are now implemented for lazy
60* Feature parity: repeat, cycle, iterate are now implemented for lazy
103 Text, and the Data instance is more complete
61 Text, and the Data instance is more complete
@@ -117,26 +75,26 @@
117* Spec compliance: toCaseFold now follows the Unicode 7.0 spec
75* Spec compliance: toCaseFold now follows the Unicode 7.0 spec
118 (updated from 6.3)
76 (updated from 6.3)
119
77
120−#### 1.2.0.4
78+1.2.0.4
121
79
122* Fixed an incompatibility with base < 4.5
80* Fixed an incompatibility with base < 4.5
123
81
124−#### 1.2.0.3
82+1.2.0.3
125
83
126* Update formatRealFloat to correspond to the definition in versions
84* Update formatRealFloat to correspond to the definition in versions
127 of base newer than 4.5 (https://github.com/bos/text/issues/105)
85 of base newer than 4.5 (https://github.com/bos/text/issues/105)
128
86
129−#### 1.2.0.2
87+1.2.0.2
130
88
131* Bumped lower bound on deepseq to 1.4 for compatibility with the
89* Bumped lower bound on deepseq to 1.4 for compatibility with the
132 upcoming GHC 7.10
90 upcoming GHC 7.10
133
91
134−#### 1.2.0.1
92+1.2.0.1
135
93
136* Fixed a buffer overflow in rendering of large Integers
94* Fixed a buffer overflow in rendering of large Integers
137 (https://github.com/bos/text/issues/99)
95 (https://github.com/bos/text/issues/99)
138
96
139−## 1.2.0.0
97+1.2.0.0
140
98
141* Fixed an integer overflow in the replace function
99* Fixed an integer overflow in the replace function
142 (https://github.com/bos/text/issues/81)
100 (https://github.com/bos/text/issues/81)
@@ -149,7 +107,7 @@
149
107
150* Added an instance of IsList for GHC 7.8 and above
108* Added an instance of IsList for GHC 7.8 and above
151
109
152−### 1.1.1.0
110+1.1.1.0
153
111
154* The Data.Data instance now allows gunfold to work, via a virtual
112* The Data.Data instance now allows gunfold to work, via a virtual
155 pack constructor
113 pack constructor
@@ -159,12 +117,12 @@
159* Comparing the length of a Text against a number can now
117* Comparing the length of a Text against a number can now
160 short-circuit in more cases
118 short-circuit in more cases
161
119
162−#### 1.1.0.1
120+1.1.0.1
163
121
164* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes
122* streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes
165 in single-byte chunks
123 in single-byte chunks
166
124
167−## 1.1.0.0
125+1.1.0.0
168
126
169* encodeUtf8: Performance is improved by up to 4x.
127* encodeUtf8: Performance is improved by up to 4x.
170
128
@@ -183,12 +141,12 @@
183 use at your own risk - there are no API stability guarantees for
141 use at your own risk - there are no API stability guarantees for
184 internal modules!
142 internal modules!
185
143
186−#### 1.0.0.1
144+1.0.0.1
187
145
188* decodeUtf8: Fixed a regression that caused us to incorrectly
146* decodeUtf8: Fixed a regression that caused us to incorrectly
189 identify truncated UTF-8 as valid (gh-61)
147 identify truncated UTF-8 as valid (gh-61)
190
148
191−# 1.0.0.0
149+1.0.0.0
192
150
193* Added support for Unicode 6.3.0 to case conversion functions
151* Added support for Unicode 6.3.0 to case conversion functions
194
152
tests-and-benchmarks.markdown+8−13
@@ -13,13 +13,10 @@ 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 can clone either repository into the `tests` subdirectory using
16+You should clone that repository into the `tests` subdirectory (your
17−
17+clone must be named `text-test-data` locally), then run `make -C
18− cd tests/
18+tests/text-test-data` to uncompress the test files. Many tests and
19− make text-test-data # to clone from mercurial, OR
20− make VCS=git text-test-data # to clone from git
21−
22−Many tests and benchmarks will fail if the test files are missing.
19+benchmarks will fail if the test files are missing.
23
20
24Functional tests
21Functional tests
25----------------
22----------------
@@ -57,12 +54,10 @@ To compile the benchmarks, navigate to the `benchmarks` subdirectory and run
57
54
58 ./dist/build/text-benchmarks/text-benchmarks
55 ./dist/build/text-benchmarks/text-benchmarks
59
56
60−Or if you have a recent enough `cabal`, you can build and run the
57+However, since there's quite a lot of benchmarks, you usually don't want to
61−benchmarks via
58+run them all. Instead, use the `-l` flag to get a list of benchmarks:
62
59
63− cabal new-run exe:text-benchmarks -- --help
60+ ./dist/build/text-benchmarks/text-benchmarks
64
61
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
67−and run the ones you want to inspect. If you want to configure the benchmarks
62+And run the ones you want to inspect. If you want to configure the benchmarks
68further, the exact parameters can be changed in `Benchmarks.hs`.
63further, the exact parameters can be changed in `Benchmarks.hs`.
tests/Makefile+1−6
@@ -1,4 +1,3 @@
1−VCS = hg
2count = 1000
1count = 1000
3
2
4all: coverage literal-rule-test
3all: coverage literal-rule-test
@@ -13,11 +12,7 @@ build: text-test-data
13 cabal build
12 cabal build
14
13
15text-test-data:
14text-test-data:
16−ifeq ($(VCS),git)
17− git clone https://github.com/bos/text-test-data.git
18−else
19 hg clone https://bitbucket.org/bos/text-test-data
15 hg clone https://bitbucket.org/bos/text-test-data
20−endif
21 $(MAKE) -C text-test-data
16 $(MAKE) -C text-test-data
22
17
23coverage/text-tests.tix:
18coverage/text-tests.tix:
@@ -42,4 +37,4 @@ coverage/hpc_index.html: coverage/coverage.tix
42clean:
37clean:
43 rm -rf dist coverage .hpc
38 rm -rf dist coverage .hpc
44
39
45−.PHONY: all build clean coverage literal-rule-test
40+.PHONY: build coverage all 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+20−99
@@ -2,7 +2,6 @@
2
2
3{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
3{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,
4 ScopedTypeVariables, TypeSynonymInstances #-}
4 ScopedTypeVariables, TypeSynonymInstances #-}
5−{-# LANGUAGE CPP #-}
6{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
5{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
7module Tests.Properties
6module Tests.Properties
8 (
7 (
@@ -10,9 +9,9 @@ module Tests.Properties
10 ) where
9 ) where
11
10
12import Control.Applicative ((<$>), (<*>))
11import Control.Applicative ((<$>), (<*>))
13−import Control.Arrow ((***), first, second)
12+import Control.Arrow ((***), second)
14import Data.Bits ((.&.))
13import Data.Bits ((.&.))
15−import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isLetter, isUpper, ord)
14+import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
16import Data.Int (Int8, Int16, Int32, Int64)
15import Data.Int (Int8, Int16, Int32, Int64)
17import Data.Monoid (Monoid(..))
16import Data.Monoid (Monoid(..))
18import Data.String (IsString(fromString))
17import Data.String (IsString(fromString))
@@ -24,7 +23,6 @@ import Data.Text.Internal.Search (indices)
24import Data.Text.Lazy.Read as TL
23import Data.Text.Lazy.Read as TL
25import Data.Text.Read as T
24import Data.Text.Read as T
26import Data.Word (Word, Word8, Word16, Word32, Word64)
25import Data.Word (Word, Word8, Word16, Word32, Word64)
27−import Data.Maybe (mapMaybe)
28import Numeric (showEFloat, showFFloat, showGFloat, showHex)
26import Numeric (showEFloat, showFFloat, showGFloat, showHex)
29import Prelude hiding (replicate)
27import Prelude hiding (replicate)
30import Test.Framework (Test, testGroup)
28import Test.Framework (Test, testGroup)
@@ -32,7 +30,6 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
32import Test.QuickCheck hiding ((.&.))
30import Test.QuickCheck hiding ((.&.))
33import Test.QuickCheck.Monadic
31import Test.QuickCheck.Monadic
34import Test.QuickCheck.Property (Property(..))
32import Test.QuickCheck.Property (Property(..))
35−import Test.QuickCheck.Unicode (char)
36import Tests.QuickCheckUtils
33import Tests.QuickCheckUtils
37import Tests.Utils
34import Tests.Utils
38import Text.Show.Functions ()
35import Text.Show.Functions ()
@@ -40,7 +37,6 @@ import qualified Control.Exception as Exception
40import qualified Data.Bits as Bits (shiftL, shiftR)
37import qualified Data.Bits as Bits (shiftL, shiftR)
41import qualified Data.ByteString as B
38import qualified Data.ByteString as B
42import qualified Data.ByteString.Lazy as BL
39import qualified Data.ByteString.Lazy as BL
43−import qualified Data.Char as C
44import qualified Data.List as L
40import qualified Data.List as L
45import qualified Data.Text as T
41import qualified Data.Text as T
46import qualified Data.Text.Encoding as E
42import qualified Data.Text.Encoding as E
@@ -64,10 +60,10 @@ t_pack_unpack = (T.unpack . T.pack) `eq` id
64tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
60tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
65t_stream_unstream = (S.unstream . S.stream) `eq` id
61t_stream_unstream = (S.unstream . S.stream) `eq` id
66tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
62tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
67−t_reverse_stream t = (S.reverse . S.reverseStream) t === t
63+t_reverse_stream t = (S.reverse . S.reverseStream) t == t
68−t_singleton c = [c] === (T.unpack . T.singleton) c
64+t_singleton c = [c] == (T.unpack . T.singleton) c
69−tl_singleton c = [c] === (TL.unpack . TL.singleton) c
65+tl_singleton c = [c] == (TL.unpack . TL.singleton) c
70−tl_unstreamChunks x = f 11 x === f 1000 x
66+tl_unstreamChunks x = f 11 x == f 1000 x
71 where f n = SL.unstreamChunks n . S.streamList
67 where f n = SL.unstreamChunks n . S.streamList
72tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
68tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
73tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
69tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
@@ -78,13 +74,13 @@ encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
78encodeLazyL1 :: TL.Text -> BL.ByteString
74encodeLazyL1 :: TL.Text -> BL.ByteString
79encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
75encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
80
76
81−t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a
77+t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
82 where a = T.map (\c -> chr (ord c `mod` 128)) t
78 where a = T.map (\c -> chr (ord c `mod` 128)) t
83−tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) === a
79+tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
84 where a = TL.map (\c -> chr (ord c `mod` 128)) t
80 where a = TL.map (\c -> chr (ord c `mod` 128)) t
85−t_latin1 t = E.decodeLatin1 (encodeL1 a) === a
81+t_latin1 t = E.decodeLatin1 (encodeL1 a) == a
86 where a = T.map (\c -> chr (ord c `mod` 256)) t
82 where a = T.map (\c -> chr (ord c `mod` 256)) t
87−tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) === a
83+tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a
88 where a = TL.map (\c -> chr (ord c `mod` 256)) t
84 where a = TL.map (\c -> chr (ord c `mod` 256)) t
89t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
85t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
90t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
86t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
@@ -115,7 +111,7 @@ t_utf8_undecoded = forAll genUnicode $ \t ->
115 let b = E.encodeUtf8 t
111 let b = E.encodeUtf8 t
116 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
112 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
117 leftover = (++ [B.empty]) . init . tail . B.inits
113 leftover = (++ [B.empty]) . init . tail . B.inits
118− in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b === ls
114+ in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls
119
115
120data Badness = Solo | Leading | Trailing
116data Badness = Solo | Leading | Trailing
121 deriving (Eq, Show)
117 deriving (Eq, Show)
@@ -181,33 +177,6 @@ genInvalidUTF8 = B.pack <$> oneof [
181 k <- choose (0,n)
177 k <- choose (0,n)
182 vectorOf k gen
178 vectorOf k gen
183
179
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−
211s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
180s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
212 where _types = s :: String
181 where _types = s :: String
213sf_Eq p s =
182sf_Eq p s =
@@ -232,8 +201,8 @@ t_mconcat = unsquare $
232 mconcat `eq` (unpackS . mconcat . L.map T.pack)
201 mconcat `eq` (unpackS . mconcat . L.map T.pack)
233tl_mconcat = unsquare $
202tl_mconcat = unsquare $
234 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
203 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
235−t_mempty = mempty === (unpackS (mempty :: T.Text))
204+t_mempty = mempty == (unpackS (mempty :: T.Text))
236−tl_mempty = mempty === (unpackS (mempty :: TL.Text))
205+tl_mempty = mempty == (unpackS (mempty :: TL.Text))
237t_IsString = fromString `eqP` (T.unpack . fromString)
206t_IsString = fromString `eqP` (T.unpack . fromString)
238tl_IsString = fromString `eqP` (TL.unpack . fromString)
207tl_IsString = fromString `eqP` (TL.unpack . fromString)
239
208
@@ -260,13 +229,6 @@ sf_uncons p = (uncons . L.filter p) `eqP`
260 (fmap (second unpackS) . S.uncons . S.filter p)
229 (fmap (second unpackS) . S.uncons . S.filter p)
261t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
230t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
262tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
231tl_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−
270s_head = head `eqP` S.head
232s_head = head `eqP` S.head
271sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
233sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
272t_head = head `eqP` T.head
234t_head = head `eqP` T.head
@@ -364,19 +326,6 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
364 where p = T.length . T.filter isUpper
326 where p = T.length . T.filter isUpper
365tl_toUpper_upper t = p (TL.toUpper t) >= p t
327tl_toUpper_upper t = p (TL.toUpper t) >= p t
366 where p = TL.length . TL.filter isUpper
328 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'
380
329
381justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
330justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
382justifyRight m n xs = L.replicate (m - length xs) n ++ xs
331justifyRight m n xs = L.replicate (m - length xs) n ++ xs
@@ -565,20 +514,12 @@ s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
565s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
514s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
566sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
515sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
567 (unpackS . S.takeWhile p . S.filter q)
516 (unpackS . S.takeWhile p . S.filter q)
568−noMatch = do
569− c <- char
570− d <- suchThat char (/= c)
571− return (c,d)
572t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
573tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
574t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
519t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
575 (unpackS . T.takeWhileEnd p)
520 (unpackS . T.takeWhileEnd p)
576−t_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> T.null $
577− T.takeWhileEnd (==d) (T.snoc t c)
578tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
521tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
579 (unpackS . TL.takeWhileEnd p)
522 (unpackS . TL.takeWhileEnd p)
580−tl_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> TL.null $
581− TL.takeWhileEnd (==d) (TL.snoc t c)
582s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
583s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
524s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
584sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -779,7 +720,7 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
779 conc = T.concat . TL.toChunks
720 conc = T.concat . TL.toChunks
780t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
721t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
781 let s = T.intercalate t ts
722 let s = T.intercalate t ts
782− in Slow.indices t s === indices t s
723+ in Slow.indices t s == indices t s
783
724
784-- Bit shifts.
725-- Bit shifts.
785shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -871,18 +812,18 @@ tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
871-- Reading.
812-- Reading.
872
813
873t_decimal (n::Int) s =
814t_decimal (n::Int) s =
874− T.signed T.decimal (T.pack (show n) `T.append` t) === Right (n,t)
815+ T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)
875 where t = T.dropWhile isDigit s
816 where t = T.dropWhile isDigit s
876tl_decimal (n::Int) s =
817tl_decimal (n::Int) s =
877− TL.signed TL.decimal (TL.pack (show n) `TL.append` t) === Right (n,t)
818+ TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
878 where t = TL.dropWhile isDigit s
819 where t = TL.dropWhile isDigit s
879t_hexadecimal m s ox =
820t_hexadecimal m s ox =
880− T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) === Right (n,t)
821+ T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
881 where t = T.dropWhile isHexDigit s
822 where t = T.dropWhile isHexDigit s
882 p = if ox then "0x" else ""
823 p = if ox then "0x" else ""
883 n = getPositive m :: Int
824 n = getPositive m :: Int
884tl_hexadecimal m s ox =
825tl_hexadecimal m s ox =
885− TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) === Right (n,t)
826+ TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
886 where t = TL.dropWhile isHexDigit s
827 where t = TL.dropWhile isHexDigit s
887 p = if ox then "0x" else ""
828 p = if ox then "0x" else ""
888 n = getPositive m :: Int
829 n = getPositive m :: Int
@@ -926,11 +867,11 @@ tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
926
867
927t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
868t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
928t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
869t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
929−t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) === t
870+t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t
930 where n = small m
871 where n = small m
931t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
932
873
933−t_copy t = T.copy t === t
874+t_copy t = T.copy t == t
934
875
935-- Regression tests.
876-- Regression tests.
936s_filter_eq s = S.filter p t == S.streamList (filter p s)
877s_filter_eq s = S.filter p t == S.streamList (filter p s)
@@ -941,13 +882,8 @@ s_filter_eq s = S.filter p t == S.streamList (filter p s)
941-- functions that consume inaccurately sized streams behave
882-- functions that consume inaccurately sized streams behave
942-- themselves.
883-- themselves.
943shorten :: Int -> S.Stream a -> S.Stream a
884shorten :: 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
948shorten n t@(S.Stream arr off len)
885shorten n t@(S.Stream arr off len)
949 | n > 0 = S.Stream arr off (smaller (exactSize n) len)
886 | n > 0 = S.Stream arr off (smaller (exactSize n) len)
950−#endif
951 | otherwise = t
887 | otherwise = t
952
888
953tests :: Test
889tests :: Test
@@ -988,15 +924,6 @@ tests =
988 testGroup "errors" [
924 testGroup "errors" [
989 testProperty "t_utf8_err" t_utf8_err,
925 testProperty "t_utf8_err" t_utf8_err,
990 testProperty "t_utf8_err'" t_utf8_err'
926 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
1000 ]
927 ]
1001 ],
928 ],
1002
929
@@ -1040,8 +967,6 @@ tests =
1040 testProperty "sf_uncons" sf_uncons,
967 testProperty "sf_uncons" sf_uncons,
1041 testProperty "t_uncons" t_uncons,
968 testProperty "t_uncons" t_uncons,
1042 testProperty "tl_uncons" tl_uncons,
969 testProperty "tl_uncons" tl_uncons,
1043− testProperty "t_unsnoc" t_unsnoc,
1044− testProperty "tl_unsnoc" tl_unsnoc,
1045 testProperty "s_head" s_head,
970 testProperty "s_head" s_head,
1046 testProperty "sf_head" sf_head,
971 testProperty "sf_head" sf_head,
1047 testProperty "t_head" t_head,
972 testProperty "t_head" t_head,
@@ -1106,8 +1031,6 @@ tests =
1106 testProperty "t_toUpper_length" t_toUpper_length,
1031 testProperty "t_toUpper_length" t_toUpper_length,
1107 testProperty "t_toUpper_upper" t_toUpper_upper,
1032 testProperty "t_toUpper_upper" t_toUpper_upper,
1108 testProperty "tl_toUpper_upper" tl_toUpper_upper
1033 testProperty "tl_toUpper_upper" tl_toUpper_upper
1109− -- testProperty "t_toTitle_title" t_toTitle_title,
1110− -- testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower
1111 ],
1034 ],
1112
1035
1113 testGroup "justification" [
1036 testGroup "justification" [
@@ -1224,9 +1147,7 @@ tests =
1224 testProperty "t_takeWhile" t_takeWhile,
1147 testProperty "t_takeWhile" t_takeWhile,
1225 testProperty "tl_takeWhile" tl_takeWhile,
1148 testProperty "tl_takeWhile" tl_takeWhile,
1226 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1149 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1227− testProperty "t_takeWhileEnd_null" t_takeWhileEnd_null,
1228 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1150 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1229− testProperty "tl_takeWhileEnd_null" tl_takeWhileEnd_null,
1230 testProperty "sf_dropWhile" sf_dropWhile,
1151 testProperty "sf_dropWhile" sf_dropWhile,
1231 testProperty "s_dropWhile" s_dropWhile,
1152 testProperty "s_dropWhile" s_dropWhile,
1232 testProperty "s_dropWhile_s" s_dropWhile_s,
1153 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` string
109+ arbitrary = T.pack `fmap` arbitrary
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,16 +72,6 @@ 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−
85tests :: F.Test
75tests :: F.Test
86tests = F.testGroup "Regressions"
76tests = F.testGroup "Regressions"
87 [ F.testCase "hGetContents_crash" hGetContents_crash
77 [ F.testCase "hGetContents_crash" hGetContents_crash
@@ -89,5 +79,4 @@ tests = F.testGroup "Regressions"
89 , F.testCase "mapAccumL_resize" mapAccumL_resize
79 , F.testCase "mapAccumL_resize" mapAccumL_resize
90 , F.testCase "replicate_crash" replicate_crash
80 , F.testCase "replicate_crash" replicate_crash
91 , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
81 , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
92− , F.testCase "t197" t197
93 ]
82 ]
tests/Tests/SlowFunctions.hs−22
@@ -1,6 +1,4 @@
1{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
2−{-# LANGUAGE CPP #-}
3−{-# LANGUAGE JavaScriptFFI, ForeignFunctionInterface, UnliftedFFITypes, MagicHash #-}
4module Tests.SlowFunctions
2module Tests.SlowFunctions
5 (
3 (
6 indices
4 indices
@@ -10,31 +8,18 @@ module Tests.SlowFunctions
10import qualified Data.Text as T
8import qualified Data.Text as T
11import Data.Text.Internal (Text(..))
9import Data.Text.Internal (Text(..))
12import Data.Text.Unsafe (iter_, unsafeHead, unsafeTail)
10import Data.Text.Unsafe (iter_, unsafeHead, unsafeTail)
13−#ifdef __GHCJS__
14−import Data.JSString (JSString)
15−#endif
16
11
17indices :: T.Text -- ^ Substring to search for (@needle@)
12indices :: T.Text -- ^ Substring to search for (@needle@)
18 -> T.Text -- ^ Text to search in (@haystack@)
13 -> T.Text -- ^ Text to search in (@haystack@)
19 -> [Int]
14 -> [Int]
20−#ifdef __GHCJS__
21−indices needle@(Text njst) haystack@(Text hjst)
22−#else
23indices needle@(Text _narr _noff nlen) haystack@(Text harr hoff hlen)
15indices needle@(Text _narr _noff nlen) haystack@(Text harr hoff hlen)
24−#endif
25 | T.null needle = []
16 | T.null needle = []
26 | otherwise = scan 0
17 | otherwise = scan 0
27 where
18 where
28 scan i | i >= hlen = []
19 scan i | i >= hlen = []
29 | needle `T.isPrefixOf` t = i : scan (i+nlen)
20 | needle `T.isPrefixOf` t = i : scan (i+nlen)
30 | otherwise = scan (i+d)
21 | 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
36 where t = Text harr (hoff+i) (hlen-i)
22 where t = Text harr (hoff+i) (hlen-i)
37−#endif
38 d = iter_ haystack i
23 d = iter_ haystack i
39
24
40splitOn :: T.Text -- ^ Text to split on
25splitOn :: T.Text -- ^ Text to split on
@@ -52,10 +37,3 @@ splitOn pat src0
52 | T.null s = [src] -- not found
37 | T.null s = [src] -- not found
53 | pat `T.isPrefixOf` s = T.take n src : go (T.drop l s)
38 | pat `T.isPrefixOf` s = T.take n src : go (T.drop l s)
54 | otherwise = search (n+1) (unsafeTail s)
39 | 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+3−18
@@ -20,11 +20,6 @@ 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−
28executable text-tests
23executable text-tests
29 main-is: Tests.hs
24 main-is: Tests.hs
30
25
@@ -53,21 +48,16 @@ executable text-tests
53 HUnit >= 1.2,
48 HUnit >= 1.2,
54 QuickCheck >= 2.7,
49 QuickCheck >= 2.7,
55 base == 4.*,
50 base == 4.*,
51+ bytestring,
56 deepseq,
52 deepseq,
57 directory,
53 directory,
58− quickcheck-unicode >= 1.0.1.0,
54+ quickcheck-unicode,
59 random,
55 random,
60 test-framework >= 0.4,
56 test-framework >= 0.4,
61 test-framework-hunit >= 0.2,
57 test-framework-hunit >= 0.2,
62 test-framework-quickcheck2 >= 0.2,
58 test-framework-quickcheck2 >= 0.2,
63 text-tests
59 text-tests
64
60
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−
71executable text-tests-stdio
61executable text-tests-stdio
72 main-is: Tests/IO.hs
62 main-is: Tests/IO.hs
73
63
@@ -147,12 +137,7 @@ library
147 array,
137 array,
148 base == 4.*,
138 base == 4.*,
149 binary,
139 binary,
140+ bytestring,
150 deepseq,
141 deepseq,
151 ghc-prim,
142 ghc-prim,
152 integer-gmp
143 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+27−106
@@ -1,7 +1,7 @@
1name: text
1name: text
2−version: 1.2.3.0
2+version: 1.2.2.1
3−homepage: https://github.com/haskell/text
3+homepage: https://github.com/bos/text
4−bug-reports: https://github.com/haskell/text/issues
4+bug-reports: https://github.com/bos/text/issues
5synopsis: An efficient packed Unicode text type.
5synopsis: An efficient packed Unicode text type.
6description:
6description:
7 .
7 .
@@ -14,13 +14,11 @@ 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 (see "Data.Text").
17+ conversion via whole-string case conversion functions. It also
18− It also provides a range of functions for converting 'Text' values to
18+ provides a range of functions for converting 'Text' values to and from
19− and from 'ByteStrings', using several standard encodings
19+ 'ByteStrings', using several standard encodings.
20− (see "Data.Text.Encoding").
21 .
20 .
22− Efficient locale-sensitive support for text IO is also supported
21+ Efficient locale-sensitive support for text IO is also supported.
23− (see "Data.Text.IO").
24 .
22 .
25 These modules are intended to be imported qualified, to avoid name
23 These modules are intended to be imported qualified, to avoid name
26 clashes with Prelude functions, e.g.
24 clashes with Prelude functions, e.g.
@@ -30,9 +28,8 @@ description:
30 To use an extended and very rich family of functions for working
28 To use an extended and very rich family of functions for working
31 with Unicode text (including normalization, regular expressions,
29 with Unicode text (including normalization, regular expressions,
32 non-standard encodings, text breaking, and locales), see
30 non-standard encodings, text breaking, and locales), see
31+ the @text-icu@ package:
33− the [text-icu package](https://hackage.haskell.org/package/text-icu)
32+ <http://hackage.haskell.org/package/text-icu>
34− based on the well-respected and liberally
35− licensed [ICU library](http://site.icu-project.org/).
36
33
37license: BSD2
34license: BSD2
38license-file: LICENSE
35license-file: LICENSE
@@ -42,8 +39,6 @@ copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper
42category: Data, Text
39category: Data, Text
43build-type: Simple
40build-type: Simple
44cabal-version: >= 1.8
41cabal-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
47extra-source-files:
42extra-source-files:
48 -- scripts/CaseFolding.txt
43 -- scripts/CaseFolding.txt
49 -- scripts/SpecialCasing.txt
44 -- scripts/SpecialCasing.txt
@@ -70,9 +65,7 @@ extra-source-files:
70 tests/text-tests.cabal
65 tests/text-tests.cabal
71
66
72flag bytestring-builder
67flag bytestring-builder
73− description:
74− Depend on the [bytestring-builder](https://hackage.haskell.org/package/bytestring-builder)
75− package for backwards compatibility.
68+ description: Depend on the bytestring-builder package for backwards compatibility.
76 default: False
69 default: False
77 manual: False
70 manual: False
78
71
@@ -82,9 +75,7 @@ flag developer
82 manual: True
75 manual: True
83
76
84flag integer-simple
77flag integer-simple
85− description:
86− Use the [simple integer library](http://hackage.haskell.org/package/integer-simple)
78+ description: Use the simple integer library instead of GMP
87− instead of [integer-gmp](http://hackage.haskell.org/package/integer-gmp)
88 default: False
79 default: False
89 manual: False
80 manual: False
90
81
@@ -97,13 +88,13 @@ library
97 Data.Text.Array
88 Data.Text.Array
98 Data.Text.Encoding
89 Data.Text.Encoding
99 Data.Text.Encoding.Error
90 Data.Text.Encoding.Error
100− -- Data.Text.Foreign
91+ Data.Text.Foreign
101 Data.Text.IO
92 Data.Text.IO
102 Data.Text.Internal
93 Data.Text.Internal
103 Data.Text.Internal.Builder
94 Data.Text.Internal.Builder
104− -- Data.Text.Internal.Builder.Functions
95+ Data.Text.Internal.Builder.Functions
105− -- Data.Text.Internal.Builder.Int.Digits
96+ Data.Text.Internal.Builder.Int.Digits
106− -- Data.Text.Internal.Builder.RealFloat.Functions
97+ Data.Text.Internal.Builder.RealFloat.Functions
107 Data.Text.Internal.Encoding.Fusion
98 Data.Text.Internal.Encoding.Fusion
108 Data.Text.Internal.Encoding.Fusion.Common
99 Data.Text.Internal.Encoding.Fusion.Common
109 Data.Text.Internal.Encoding.Utf16
100 Data.Text.Internal.Encoding.Utf16
@@ -115,14 +106,14 @@ library
115 Data.Text.Internal.Fusion.Common
106 Data.Text.Internal.Fusion.Common
116 Data.Text.Internal.Fusion.Size
107 Data.Text.Internal.Fusion.Size
117 Data.Text.Internal.Fusion.Types
108 Data.Text.Internal.Fusion.Types
118− -- Data.Text.Internal.IO
109+ Data.Text.Internal.IO
119 Data.Text.Internal.Lazy
110 Data.Text.Internal.Lazy
120− -- Data.Text.Internal.Lazy.Encoding.Fusion
111+ Data.Text.Internal.Lazy.Encoding.Fusion
121 Data.Text.Internal.Lazy.Fusion
112 Data.Text.Internal.Lazy.Fusion
122 Data.Text.Internal.Lazy.Search
113 Data.Text.Internal.Lazy.Search
123 Data.Text.Internal.Private
114 Data.Text.Internal.Private
124 Data.Text.Internal.Read
115 Data.Text.Internal.Read
125− -- Data.Text.Internal.Search
116+ Data.Text.Internal.Search
126 Data.Text.Internal.Unsafe
117 Data.Text.Internal.Unsafe
127 Data.Text.Internal.Unsafe.Char
118 Data.Text.Internal.Unsafe.Char
128 Data.Text.Internal.Unsafe.Shift
119 Data.Text.Internal.Unsafe.Shift
@@ -133,23 +124,18 @@ library
133 Data.Text.Lazy.Encoding
124 Data.Text.Lazy.Encoding
134 Data.Text.Lazy.IO
125 Data.Text.Lazy.IO
135 Data.Text.Lazy.Internal
126 Data.Text.Lazy.Internal
136− -- Data.Text.Lazy.Read
127+ Data.Text.Lazy.Read
137 Data.Text.Read
128 Data.Text.Read
138 Data.Text.Unsafe
129 Data.Text.Unsafe
139− -- moved from ghcjs-base
140− -- reflex-dom depends in it
141− Data.JSString.Text
142
130
143− -- other-modules:
131+ other-modules:
144− -- Data.Text.Show
132+ Data.Text.Show
145
133
146 build-depends:
134 build-depends:
147 array >= 0.3,
135 array >= 0.3,
148 base >= 4.2 && < 5,
136 base >= 4.2 && < 5,
149 binary,
137 binary,
150 deepseq >= 1.1.0.0,
138 deepseq >= 1.1.0.0,
151− ghcjs-base,
152− ghcjs-prim,
153 ghc-prim >= 0.2
139 ghc-prim >= 0.2
154
140
155 if flag(bytestring-builder)
141 if flag(bytestring-builder)
@@ -174,92 +160,27 @@ library
174
160
175test-suite tests
161test-suite tests
176 type: exitcode-stdio-1.0
162 type: exitcode-stdio-1.0
163+ hs-source-dirs: tests .
164+ main-is: Tests.hs
177 c-sources: cbits/cbits.c
165 c-sources: cbits/cbits.c
178 include-dirs: include
166 include-dirs: include
179
167
180 ghc-options:
168 ghc-options:
181− -Wall -threaded -rtsopts
169+ -Wall -threaded -O0 -rtsopts
182
170
183 cpp-options:
171 cpp-options:
184 -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
172 -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
185
173
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−
251 build-depends:
174 build-depends:
252 HUnit >= 1.2,
175 HUnit >= 1.2,
253− QuickCheck >= 2.7 && < 2.12,
176+ QuickCheck >= 2.7,
254 array,
177 array,
255 base,
178 base,
256 binary,
179 binary,
257 deepseq,
180 deepseq,
258 directory,
181 directory,
259 ghc-prim,
182 ghc-prim,
260− ghcjs-prim,
261− ghcjs-base,
262− quickcheck-unicode >= 1.0.1.0,
183+ quickcheck-unicode,
263 random,
184 random,
264 test-framework >= 0.4,
185 test-framework >= 0.4,
265 test-framework-hunit >= 0.2,
186 test-framework-hunit >= 0.2,
@@ -280,7 +201,7 @@ test-suite tests
280
201
281source-repository head
202source-repository head
282 type: git
203 type: git
283− location: https://github.com/haskell/text
204+ location: https://github.com/bos/text
284
205
285source-repository head
206source-repository head
286 type: mercurial
207 type: mercurial