on master help sign in
.gitignore−4
since splitsnapshots
unifiedsplit
@@ -1,7 +1,3 @@
1dist
1dist
2−dist-boot
3−dist-install
4cabal-dev
2cabal-dev
5cabal.sandbox.config
3cabal.sandbox.config
6−ghc.mk
7−GNUmakefile
.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/Text.hs+1−28
@@ -34,7 +34,6 @@
34-- with Unicode text (including normalization, regular expressions,
34-- with Unicode text (including normalization, regular expressions,
35-- non-standard encodings, text breaking, and locales), see
35-- non-standard encodings, text breaking, and locales), see
36-- <http://hackage.haskell.org/package/text-icu the text-icu package >.
36-- <http://hackage.haskell.org/package/text-icu the text-icu package >.
37−--
38
37
39module Data.Text
38module Data.Text
40 (
39 (
@@ -44,9 +43,6 @@ module Data.Text
44 -- * Acceptable data
43 -- * Acceptable data
45 -- $replacement
44 -- $replacement
46
45
47− -- * Definition of character
48− -- $character_definition
49−
50 -- * Fusion
46 -- * Fusion
51 -- $fusion
47 -- $fusion
52
48
@@ -64,7 +60,6 @@ module Data.Text
64 , snoc
60 , snoc
65 , append
61 , append
66 , uncons
62 , uncons
67− , unsnoc
68 , head
63 , head
69 , last
64 , last
70 , tail
65 , tail
@@ -251,17 +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−-- $character-definition
255−--
256−-- This package uses the word /character/ to denote Unicode code points.
257−--
258−-- Note that this is not the same thing as a grapheme (e.g. a composition of
259−-- code points that form one visual symbol). For instance, consider the grapheme
260−-- @ä@. This symbol has two Unicode representations: a single code-point
261−-- representation @U+00E4@ (the @LATIN SMALL LETTER A WITH DIAERESIS@ code
262−-- point), and a two code point representation @U+0061@ (the @A@ code point) and
263−-- @U+0308@ (the @COMBINING DIAERESIS@ code point).
264−
265-- $strict
249-- $strict
266--
250--
267-- This package provides both strict and lazy 'Text' types. The
251-- This package provides both strict and lazy 'Text' types. The
@@ -561,17 +545,6 @@ init (Text arr off len) | len <= 0 = emptyError "init"
561 unstream (S.init (stream t)) = init t
545 unstream (S.init (stream t)) = init t
562 #-}
546 #-}
563
547
564−-- | /O(1)/ Returns all but the last character and the last character of a
565−-- 'Text', or 'Nothing' if empty.
566−unsnoc :: Text -> Maybe (Text, Char)
567−unsnoc (Text arr off len)
568− | len <= 0 = Nothing
569− | n < 0xDC00 || n > 0xDFFF = Just (text arr off (len-1), unsafeChr n)
570− | otherwise = Just (text arr off (len-2), U16.chr2 n0 n)
571− where n = A.unsafeIndex arr (off+len-1)
572− n0 = A.unsafeIndex arr (off+len-2)
573−{-# INLINE [1] unsnoc #-}
574−
575-- | /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
576-- fusion.
549-- fusion.
577null :: Text -> Bool
550null :: Text -> Bool
@@ -1126,8 +1099,8 @@ takeEnd n t@(Text arr off len)
1126iterNEnd :: Int -> Text -> Int
1099iterNEnd :: Int -> Text -> Int
1127iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1100iterNEnd n t@(Text _arr _off len) = loop (len-1) n
1128 where loop i !m
1101 where loop i !m
1129− | m <= 0 = i+1
1130 | i <= 0 = 0
1102 | i <= 0 = 0
1103+ | m <= 1 = i
1131 | otherwise = loop (i+d) (m-1)
1104 | otherwise = loop (i+d) (m-1)
1132 where d = reverseIter_ t i
1105 where d = reverseIter_ t i
1133
1106
Data/Text/Encoding.hs+1−1
@@ -373,7 +373,7 @@ encodeUtf8 :: Text -> ByteString
373encodeUtf8 (Text arr off len)
373encodeUtf8 (Text arr off len)
374 | len == 0 = B.empty
374 | len == 0 = B.empty
375 | otherwise = unsafeDupablePerformIO $ do
375 | otherwise = unsafeDupablePerformIO $ do
376− fp <- mallocByteString (len*3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough
376+ fp <- mallocByteString (len*4)
377 withForeignPtr fp $ \ptr ->
377 withForeignPtr fp $ \ptr ->
378 with ptr $ \destPtr -> do
378 with ptr $ \destPtr -> do
379 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
379 c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len)
Data/Text/Foreign.hs+1−1
@@ -108,7 +108,7 @@ takeWord16 (I16 n) t@(Text arr off len)
108 | n >= len || m >= len = t
108 | n >= len || m >= len = t
109 | otherwise = Text arr off m
109 | otherwise = Text arr off m
110 where
110 where
111− m | w < 0xD800 || w > 0xDBFF = n
111+ m | w < 0xDB00 || w > 0xD8FF = n
112 | otherwise = n+1
112 | otherwise = n+1
113 w = A.unsafeIndex arr (off+n-1)
113 w = A.unsafeIndex arr (off+n-1)
114
114
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+37−44
@@ -1,4 +1,4 @@
1−{-# LANGUAGE PatternGuards, BangPatterns, MagicHash, Rank2Types #-}
1+{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}
2-- |
2-- |
3-- Module : Data.Text.Internal.Fusion.Common
3-- Module : Data.Text.Internal.Fusion.Common
4-- Copyright : (c) Bryan O'Sullivan 2009, 2012
4-- Copyright : (c) Bryan O'Sullivan 2009, 2012
@@ -107,7 +107,7 @@ import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
107import qualified Data.List as L
107import qualified Data.List as L
108import qualified Prelude as P
108import qualified Prelude as P
109import Data.Bits (shiftL)
109import Data.Bits (shiftL)
110−import Data.Char (isLetter, isSpace)
110+import Data.Char (isLetter)
111import Data.Int (Int64)
111import Data.Int (Int64)
112import Data.Text.Internal.Fusion.Types
112import Data.Text.Internal.Fusion.Types
113import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
113import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
@@ -117,7 +117,7 @@ import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
117import GHC.Types (Char(..), Int(..))
117import GHC.Types (Char(..), Int(..))
118
118
119singleton :: Char -> Stream Char
119singleton :: Char -> Stream Char
120−singleton c = Stream next False (codePointsSize 1)
120+singleton c = Stream next False 1
121 where next False = Yield c True
121 where next False = Yield c True
122 next True = Done
122 next True = Done
123{-# INLINE [0] singleton #-}
123{-# INLINE [0] singleton #-}
@@ -175,7 +175,7 @@ data C s = C0 !s
175
175
176-- | /O(n)/ Adds a character to the front of a Stream Char.
176-- | /O(n)/ Adds a character to the front of a Stream Char.
177cons :: Char -> Stream Char -> Stream Char
177cons :: Char -> Stream Char -> Stream Char
178−cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len + codePointsSize 1)
178+cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
179 where
179 where
180 next (C1 s) = Yield w (C0 s)
180 next (C1 s) = Yield w (C0 s)
181 next (C0 s) = case next0 s of
181 next (C0 s) = case next0 s of
@@ -189,7 +189,7 @@ data Snoc a = N
189
189
190-- | /O(n)/ Adds a character to the end of a stream.
190-- | /O(n)/ Adds a character to the end of a stream.
191snoc :: Stream Char -> Char -> Stream Char
191snoc :: Stream Char -> Char -> Stream Char
192−snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len + codePointsSize 1)
192+snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
193 where
193 where
194 next (J xs) = case next0 xs of
194 next (J xs) = case next0 xs of
195 Done -> Yield w N
195 Done -> Yield w N
@@ -237,7 +237,7 @@ uncons :: Stream Char -> Maybe (Char, Stream Char)
237uncons (Stream next s0 len) = loop_uncons s0
237uncons (Stream next s0 len) = loop_uncons s0
238 where
238 where
239 loop_uncons !s = case next s of
239 loop_uncons !s = case next s of
240− Yield x s1 -> Just (x, Stream next s1 (len - codePointsSize 1))
240+ Yield x s1 -> Just (x, Stream next s1 (len-1))
241 Skip s' -> loop_uncons s'
241 Skip s' -> loop_uncons s'
242 Done -> Nothing
242 Done -> Nothing
243{-# INLINE [0] uncons #-}
243{-# INLINE [0] uncons #-}
@@ -260,7 +260,7 @@ last (Stream next s0 _len) = loop0_last s0
260-- | /O(1)/ Returns all characters after the head of a Stream Char, which must
260-- | /O(1)/ Returns all characters after the head of a Stream Char, which must
261-- be non-empty.
261-- be non-empty.
262tail :: Stream Char -> Stream Char
262tail :: Stream Char -> Stream Char
263−tail (Stream next0 s0 len) = Stream next (C0 s0) (len - codePointsSize 1)
263+tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
264 where
264 where
265 next (C0 s) = case next0 s of
265 next (C0 s) = case next0 s of
266 Done -> emptyError "tail"
266 Done -> emptyError "tail"
@@ -278,7 +278,7 @@ data Init s = Init0 !s
278-- | /O(1)/ Returns all but the last character of a Stream Char, which
278-- | /O(1)/ Returns all but the last character of a Stream Char, which
279-- must be non-empty.
279-- must be non-empty.
280init :: Stream Char -> Stream Char
280init :: Stream Char -> Stream Char
281−init (Stream next0 s0 len) = Stream next (Init0 s0) (len - codePointsSize 1)
281+init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
282 where
282 where
283 next (Init0 s) = case next0 s of
283 next (Init0 s) = case next0 s of
284 Done -> emptyError "init"
284 Done -> emptyError "init"
@@ -318,14 +318,11 @@ lengthI (Stream next s0 _len) = loop_length 0 s0
318-- greater than the number or if the stream can't possibly be as long
318-- greater than the number or if the stream can't possibly be as long
319-- as the number supplied, and hence be more efficient.
319-- as the number supplied, and hence be more efficient.
320compareLengthI :: Integral a => Stream Char -> a -> Ordering
320compareLengthI :: Integral a => Stream Char -> a -> Ordering
321−compareLengthI (Stream next s0 len) n
321+compareLengthI (Stream next s0 len) n =
322− -- Note that @len@ tracks code units whereas we want to compare the length
322+ case compareSize len (fromIntegral n) of
323− -- in code points. Specifically, a stream with hint @len@ may consist of
323+ Just o -> o
324− -- anywhere from @len/2@ to @len@ code points.
325− | Just r <- compareSize len n' = r
326− | otherwise = loop_cmp 0 s0
324+ Nothing -> loop_cmp 0 s0
327 where
325 where
328− n' = codePointsSize $ fromIntegral n
329 loop_cmp !z s = case next s of
326 loop_cmp !z s = case next s of
330 Done -> compare z n
327 Done -> compare z n
331 Skip s' -> loop_cmp z s'
328 Skip s' -> loop_cmp z s'
@@ -371,7 +368,7 @@ data I s = I1 !s
371-- | /O(n)/ Take a character and place it between each of the
368-- | /O(n)/ Take a character and place it between each of the
372-- characters of a 'Stream Char'.
369-- characters of a 'Stream Char'.
373intersperse :: Char -> Stream Char -> Stream Char
370intersperse :: Char -> Stream Char -> Stream Char
374−intersperse c (Stream next0 s0 len) = Stream next (I1 s0) (len + unknownSize)
371+intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
375 where
372 where
376 next (I1 s) = case next0 s of
373 next (I1 s) = case next0 s of
377 Done -> Done
374 Done -> Done
@@ -396,11 +393,9 @@ intersperse c (Stream next0 s0 len) = Stream next (I1 s0) (len + unknownSize)
396-- functions may map one input character to two or three output
393-- functions may map one input character to two or three output
397-- characters.
394-- characters.
398
395
399−-- | Map a 'Stream' through the given case-mapping function.
400caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
396caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
401 -> Stream Char -> Stream Char
397 -> Stream Char -> Stream Char
402−caseConvert remap (Stream next0 s0 len) =
398+caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
403− Stream next (CC s0 '\0' '\0') (len `unionSize` 3*len)
404 where
399 where
405 next (CC s '\0' _) =
400 next (CC s '\0' _) =
406 case next0 s of
401 case next0 s of
@@ -463,20 +458,19 @@ toLower = caseConvert lowerMapping
463-- Fox\" is correctly title cased&#x2014;but this function will
458-- Fox\" is correctly title cased&#x2014;but this function will
464-- capitalize /every/ word.
459-- capitalize /every/ word.
465toTitle :: Stream Char -> Stream Char
460toTitle :: Stream Char -> Stream Char
466−toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') (len + unknownSize)
461+toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
467 where
462 where
468 next (CC (letter :*: s) '\0' _) =
463 next (CC (letter :*: s) '\0' _) =
469 case next0 s of
464 case next0 s of
470− Done -> Done
465+ Done -> Done
471− Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
466+ Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
472 Yield c s'
467 Yield c s'
473− | nonSpace -> if letter
468+ | letter' -> if letter
474− then lowerMapping c (nonSpace :*: s')
469+ then lowerMapping c (letter' :*: s')
475− else titleMapping c (letter' :*: s')
470+ else titleMapping c (letter' :*: s')
476− | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
471+ | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
477− where nonSpace = P.not (isSpace c)
478− letter' = isLetter c
472+ where letter' = isLetter c
479− next (CC s a b) = Yield a (CC s b '\0')
473+ next (CC s a b) = Yield a (CC s b '\0')
480{-# INLINE [0] toTitle #-}
474{-# INLINE [0] toTitle #-}
481
475
482data Justify i s = Just1 !i !s
476data Justify i s = Just1 !i !s
@@ -484,7 +478,7 @@ data Justify i s = Just1 !i !s
484
478
485justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
479justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
486justifyLeftI k c (Stream next0 s0 len) =
480justifyLeftI k c (Stream next0 s0 len) =
487− Stream next (Just1 0 s0) (larger (fromIntegral k * charSize c + len) len)
481+ Stream next (Just1 0 s0) (larger (fromIntegral k) len)
488 where
482 where
489 next (Just1 n s) =
483 next (Just1 n s) =
490 case next0 s of
484 case next0 s of
@@ -704,7 +698,7 @@ replicateI n (Stream next0 s0 len) =
704-- (a,b), in which case, a is the next Char in the string, and b is
698-- (a,b), in which case, a is the next Char in the string, and b is
705-- the seed value for further production.
699-- the seed value for further production.
706unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
700unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
707−unfoldr f s0 = Stream next s0 unknownSize
701+unfoldr f s0 = Stream next s0 1 -- HINT maybe too low
708 where
702 where
709 {-# INLINE next #-}
703 {-# INLINE next #-}
710 next !s = case f s of
704 next !s = case f s of
@@ -718,7 +712,7 @@ unfoldr f s0 = Stream next s0 unknownSize
718-- 'unfoldr' when the length of the result is known.
712-- 'unfoldr' when the length of the result is known.
719unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
713unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
720unfoldrNI n f s0 | n < 0 = empty
714unfoldrNI n f s0 | n < 0 = empty
721− | otherwise = Stream next (0 :*: s0) (maxSize $ fromIntegral (n*2))
715+ | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high
722 where
716 where
723 {-# INLINE next #-}
717 {-# INLINE next #-}
724 next (z :*: s) = case f s of
718 next (z :*: s) = case f s of
@@ -730,12 +724,12 @@ unfoldrNI n f s0 | n < 0 = empty
730-------------------------------------------------------------------------------
724-------------------------------------------------------------------------------
731-- * Substreams
725-- * Substreams
732
726
733−-- | /O(n)/ @'take' n@, applied to a stream, returns the prefix of the
727+-- | /O(n)/ take n, applied to a stream, returns the prefix of the
734-- stream of length @n@, or the stream itself if @n@ is greater than the
728-- stream of length @n@, or the stream itself if @n@ is greater than the
735-- length of the stream.
729-- length of the stream.
736take :: Integral a => a -> Stream Char -> Stream Char
730take :: Integral a => a -> Stream Char -> Stream Char
737take n0 (Stream next0 s0 len) =
731take n0 (Stream next0 s0 len) =
738− Stream next (n0 :*: s0) (smaller len (codePointsSize $ fromIntegral n0))
732+ Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))
739 where
733 where
740 {-# INLINE next #-}
734 {-# INLINE next #-}
741 next (n :*: s) | n <= 0 = Done
735 next (n :*: s) | n <= 0 = Done
@@ -748,12 +742,12 @@ take n0 (Stream next0 s0 len) =
748data Drop a s = NS !s
742data Drop a s = NS !s
749 | JS !a !s
743 | JS !a !s
750
744
751−-- | /O(n)/ @'drop' n@, applied to a stream, returns the suffix of the
745+-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
752-- stream after the first @n@ characters, or the empty stream if @n@
746-- stream after the first @n@ characters, or the empty stream if @n@
753-- is greater than the length of the stream.
747-- is greater than the length of the stream.
754drop :: Integral a => a -> Stream Char -> Stream Char
748drop :: Integral a => a -> Stream Char -> Stream Char
755drop n0 (Stream next0 s0 len) =
749drop n0 (Stream next0 s0 len) =
756− Stream next (JS n0 s0) (len - codePointsSize (fromIntegral n0))
750+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
757 where
751 where
758 {-# INLINE next #-}
752 {-# INLINE next #-}
759 next (JS n s)
753 next (JS n s)
@@ -768,10 +762,10 @@ drop n0 (Stream next0 s0 len) =
768 Yield x s' -> Yield x (NS s')
762 Yield x s' -> Yield x (NS s')
769{-# INLINE [0] drop #-}
763{-# INLINE [0] drop #-}
770
764
771−-- | 'takeWhile', applied to a predicate @p@ and a stream, returns the
765+-- | takeWhile, applied to a predicate @p@ and a stream, returns the
772−-- longest prefix (possibly empty) of elements that satisfy @p@.
766+-- longest prefix (possibly empty) of elements that satisfy p.
773takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
767takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
774−takeWhile p (Stream next0 s0 len) = Stream next s0 (len - unknownSize)
768+takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
775 where
769 where
776 {-# INLINE next #-}
770 {-# INLINE next #-}
777 next !s = case next0 s of
771 next !s = case next0 s of
@@ -781,9 +775,9 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 (len - unknownSize)
781 | otherwise -> Done
775 | otherwise -> Done
782{-# INLINE [0] takeWhile #-}
776{-# INLINE [0] takeWhile #-}
783
777
784−-- | @'dropWhile' p xs@ returns the suffix remaining after @'takeWhile' p xs@.
778+-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
785dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
779dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
786−dropWhile p (Stream next0 s0 len) = Stream next (L s0) (len - unknownSize)
780+dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
787 where
781 where
788 {-# INLINE next #-}
782 {-# INLINE next #-}
789 next (L s) = case next0 s of
783 next (L s) = case next0 s of
@@ -817,7 +811,7 @@ isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
817-------------------------------------------------------------------------------
811-------------------------------------------------------------------------------
818-- ** Searching by equality
812-- ** Searching by equality
819
813
820−-- | /O(n)/ 'elem' is the stream membership predicate.
814+-- | /O(n)/ elem is the stream membership predicate.
821elem :: Char -> Stream Char -> Bool
815elem :: Char -> Stream Char -> Bool
822elem w (Stream next s0 _len) = loop_elem s0
816elem w (Stream next s0 _len) = loop_elem s0
823 where
817 where
@@ -862,8 +856,7 @@ indexI (Stream next s0 _len) n0
862-- returns a stream containing those characters that satisfy the
856-- returns a stream containing those characters that satisfy the
863-- predicate.
857-- predicate.
864filter :: (Char -> Bool) -> Stream Char -> Stream Char
858filter :: (Char -> Bool) -> Stream Char -> Stream Char
865−filter p (Stream next0 s0 len) =
866− Stream next s0 (len - unknownSize) -- HINT maybe too high
859+filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
867 where
860 where
868 next !s = case next0 s of
861 next !s = case next0 s of
869 Done -> Done
862 Done -> Done
Data/Text/Internal/Fusion/Size.hs+6−32
@@ -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+4−4
@@ -75,16 +75,16 @@ instance (Ord a) => Ord (Stream a) where
75-- 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
76-- small or too large.
76-- small or too large.
77--
77--
78−-- 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,
79−-- but often counts the number of code points instead. It can easily
79+-- but often counts the number of characters instead. It can easily
80-- undercount if, for instance, a transformed stream contains astral
80-- undercount if, for instance, a transformed stream contains astral
81−-- plane code points (those above 0x10000).
81+-- plane characters (those above 0x10000).
82
82
83data Stream a =
83data Stream a =
84 forall s. Stream
84 forall s. Stream
85 (s -> Step s a) -- stepper function
85 (s -> Step s a) -- stepper function
86 !s -- current state
86 !s -- current state
87− !Size -- size hint in code units
87+ !Size -- size hint
88
88
89-- | /O(n)/ Determines if two streams are equal.
89-- | /O(n)/ Determines if two streams are equal.
90eq :: (Eq a) => Stream a -> Stream a -> Bool
90eq :: (Eq a) => Stream a -> Stream a -> Bool
Data/Text/Lazy.hs+6−15
@@ -68,7 +68,6 @@ module Data.Text.Lazy
68 , snoc
68 , snoc
69 , append
69 , append
70 , uncons
70 , uncons
71− , unsnoc
72 , head
71 , head
73 , last
72 , last
74 , tail
73 , tail
@@ -476,7 +475,9 @@ fromStrict t = chunk t Empty
476-- -----------------------------------------------------------------------------
475-- -----------------------------------------------------------------------------
477-- * Basic functions
476-- * Basic functions
478
477
479−-- | /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.
480cons :: Char -> Text -> Text
481cons :: Char -> Text -> Text
481cons c t = Chunk (T.singleton c) t
482cons c t = Chunk (T.singleton c) t
482{-# INLINE [1] cons #-}
483{-# INLINE [1] cons #-}
@@ -560,15 +561,6 @@ init Empty = emptyError "init"
560 unstream (S.init (stream t)) = init t
561 unstream (S.init (stream t)) = init t
561 #-}
562 #-}
562
563
563−-- | /O(n\/c)/ Returns the 'init' and 'last' of a 'Text', or 'Nothing' if
564−-- empty.
565−--
566−-- * It is no faster than using 'init' and 'last'.
567−unsnoc :: Text -> Maybe (Text, Char)
568−unsnoc Empty = Nothing
569−unsnoc ts@(Chunk _ _) = Just (init ts, last ts)
570−{-# INLINE unsnoc #-}
571−
572-- | /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
573-- fusion.
565-- fusion.
574null :: Text -> Bool
566null :: Text -> Bool
@@ -1161,10 +1153,9 @@ takeWhile p t0 = takeWhile' t0
1161takeWhileEnd :: (Char -> Bool) -> Text -> Text
1153takeWhileEnd :: (Char -> Bool) -> Text -> Text
1162takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1154takeWhileEnd p = takeChunk empty . L.reverse . toChunks
1163 where takeChunk acc [] = acc
1155 where takeChunk acc [] = acc
1164− takeChunk acc (t:ts)
1156+ takeChunk acc (t:ts) = if T.length t' < T.length t
1165− | T.lengthWord16 t' < T.lengthWord16 t
1157+ then (Chunk t' acc)
1166− = chunk t' acc
1167− | otherwise = takeChunk (Chunk t' acc) ts
1158+ else takeChunk (Chunk t' acc) ts
1168 where t' = T.takeWhileEnd p t
1159 where t' = T.takeWhileEnd p t
1169{-# INLINE takeWhileEnd #-}
1160{-# INLINE takeWhileEnd #-}
1170
1161
Data/Text/Lazy/Builder/Int.hs−3
@@ -32,9 +32,6 @@ import GHC.Base (quotInt, remInt)
32import GHC.Num (quotRemInteger)
32import GHC.Num (quotRemInteger)
33import GHC.Types (Int(..))
33import GHC.Types (Int(..))
34import Control.Monad.ST
34import Control.Monad.ST
35−#if MIN_VERSION_base(4,11,0)
36−import Prelude hiding ((<>))
37−#endif
38
35
39#ifdef __GLASGOW_HASKELL__
36#ifdef __GLASGOW_HASKELL__
40# if defined(INTEGER_GMP)
37# if defined(INTEGER_GMP)
Data/Text/Lazy/Builder/RealFloat.hs−3
@@ -24,9 +24,6 @@ import Data.Text.Lazy.Builder.Int (decimal)
24import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
24import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
25import Data.Text.Lazy.Builder
25import Data.Text.Lazy.Builder
26import qualified Data.Text as T
26import qualified Data.Text as T
27−#if MIN_VERSION_base(4,11,0)
28−import Prelude hiding ((<>))
29−#endif
30
27
31-- | Control the rendering of floating point numbers.
28-- | Control the rendering of floating point numbers.
32data FPFormat = Exponent
29data FPFormat = Exponent
Data/Text/Lazy/Read.hs+3−3
@@ -68,9 +68,9 @@ decimal txt
68 go n d = (n * 10 + fromIntegral (digitToInt d))
68 go n d = (n * 10 + fromIntegral (digitToInt d))
69
69
70-- | Read a hexadecimal integer, consisting of an optional leading
70-- | Read a hexadecimal integer, consisting of an optional leading
71−-- @\"0x\"@ followed by at least one hexadecimal digit. Input is
71+-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
72−-- 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
73−-- This function is case insensitive.
73+-- is case insensitive.
74--
74--
75-- This function does not handle leading sign characters. If you need
75-- This function does not handle leading sign characters. If you need
76-- to handle signed input, use @'signed' 'hexadecimal'@.
76-- to handle signed input, use @'signed' 'hexadecimal'@.
Data/Text/Read.hs+3−3
@@ -67,9 +67,9 @@ decimal txt
67 go n d = (n * 10 + fromIntegral (digitToInt d))
67 go n d = (n * 10 + fromIntegral (digitToInt d))
68
68
69-- | Read a hexadecimal integer, consisting of an optional leading
69-- | Read a hexadecimal integer, consisting of an optional leading
70−-- @\"0x\"@ followed by at least one hexadecimal digit. Input is
70+-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
71−-- 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
72−-- This function is case insensitive.
72+-- is case insensitive.
73--
73--
74-- This function does not handle leading sign characters. If you need
74-- This function does not handle leading sign characters. If you need
75-- to handle signed input, use @'signed' 'hexadecimal'@.
75-- to handle signed input, use @'signed' 'hexadecimal'@.
README.markdown+3−3
@@ -19,11 +19,11 @@ library to provide these facilities.
19# Get involved!
19# Get involved!
20
20
21Please report bugs via the
21Please report bugs via the
22−[github issue tracker](https://github.com/haskell/text/issues).
22+[github issue tracker](https://github.com/bos/text/issues).
23
23
24−Master [git repository](https://github.com/haskell/text):
24+Master [git repository](https://github.com/bos/text):
25
25
26−* `git clone git://github.com/haskell/text.git`
26+* `git clone git://github.com/bos/text.git`
27
27
28There's also a [Mercurial mirror](https://bitbucket.org/bos/text):
28There's also a [Mercurial mirror](https://bitbucket.org/bos/text):
29
29
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−1
@@ -47,7 +47,6 @@ executable text-benchmarks
47 ghc-prim,
47 ghc-prim,
48 integer-gmp,
48 integer-gmp,
49 stringsearch,
49 stringsearch,
50− transformers,
51 utf8-string,
50 utf8-string,
52 vector
51 vector
53
52
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+1−35
@@ -1,44 +1,10 @@
1−1.2.3.0
2−
3−* `unsnoc` implemented
4−
5−* Bug fix: the lazy `takeWhileEnd` function violated the
6− [lazy text invariant](https://github.com/bos/text/blob/1.2.3.0/Data/Text/Internal/Lazy.hs#L51).
7−
8−* Spec compliance: `toCaseFold` now follows the Unicode 9.0 spec
9− (updated from 8.0)
10−
11−* Bug fix: Fixed usage of size hints causing incorrect behavior (gh-197).
12−
13−* Improve UTF8 decoder error-recovery (gh-182).
14−
15−* Reduce memory overhead in `encodeUTF8` (gh-194).
16−
17−
18−1.2.2.2
19−
20−* The `toTitle` function now correctly handles letters that
21− immediately follow punctuation. Before, `"there's"` would turn into
22− `"There'S"`. Now, it becomes `"There's"`.
23−
24−* The implementation of unstreaming is faster, resulting in operations
25− such as `map` and `intersperse` speeding up by up to 30%, with
26− smaller code generated.
27−
28−* The optimised length comparison function is now more likely to be
29− used after some rewrite rule tweaking.
30−
31−* Bug fix: an off-by-one bug in `takeEnd` is fixed.
32−
33−* Bug fix: a logic error in `takeWord16` is fixed.
34−
351.2.2.1
11.2.2.1
36
2
37* 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.
38 The build flag has been renamed accordingly. Your army of diligent
4 The build flag has been renamed accordingly. Your army of diligent
39 maintainers apologizes for the churn.
5 maintainers apologizes for the churn.
40
6
41−* Spec compliance: `toCaseFold` now follows the Unicode 8.0 spec
7+* Spec compliance: toCaseFold now follows the Unicode 8.0 spec
42 (updated from 7.0)
8 (updated from 7.0)
43
9
44* An STG lint error has been fixed
10* An STG lint error has been fixed
tests/Tests/Properties.hs+21−94
@@ -9,9 +9,9 @@ module Tests.Properties
9 ) where
9 ) where
10
10
11import Control.Applicative ((<$>), (<*>))
11import Control.Applicative ((<$>), (<*>))
12−import Control.Arrow ((***), first, second)
12+import Control.Arrow ((***), second)
13import Data.Bits ((.&.))
13import Data.Bits ((.&.))
14−import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isLetter, isUpper, ord)
14+import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
15import Data.Int (Int8, Int16, Int32, Int64)
15import Data.Int (Int8, Int16, Int32, Int64)
16import Data.Monoid (Monoid(..))
16import Data.Monoid (Monoid(..))
17import Data.String (IsString(fromString))
17import Data.String (IsString(fromString))
@@ -23,7 +23,6 @@ import Data.Text.Internal.Search (indices)
23import Data.Text.Lazy.Read as TL
23import Data.Text.Lazy.Read as TL
24import Data.Text.Read as T
24import Data.Text.Read as T
25import Data.Word (Word, Word8, Word16, Word32, Word64)
25import Data.Word (Word, Word8, Word16, Word32, Word64)
26−import Data.Maybe (mapMaybe)
27import Numeric (showEFloat, showFFloat, showGFloat, showHex)
26import Numeric (showEFloat, showFFloat, showGFloat, showHex)
28import Prelude hiding (replicate)
27import Prelude hiding (replicate)
29import Test.Framework (Test, testGroup)
28import Test.Framework (Test, testGroup)
@@ -31,7 +30,6 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
31import Test.QuickCheck hiding ((.&.))
30import Test.QuickCheck hiding ((.&.))
32import Test.QuickCheck.Monadic
31import Test.QuickCheck.Monadic
33import Test.QuickCheck.Property (Property(..))
32import Test.QuickCheck.Property (Property(..))
34−import Test.QuickCheck.Unicode (char)
35import Tests.QuickCheckUtils
33import Tests.QuickCheckUtils
36import Tests.Utils
34import Tests.Utils
37import Text.Show.Functions ()
35import Text.Show.Functions ()
@@ -39,7 +37,6 @@ import qualified Control.Exception as Exception
39import qualified Data.Bits as Bits (shiftL, shiftR)
37import qualified Data.Bits as Bits (shiftL, shiftR)
40import qualified Data.ByteString as B
38import qualified Data.ByteString as B
41import qualified Data.ByteString.Lazy as BL
39import qualified Data.ByteString.Lazy as BL
42−import qualified Data.Char as C
43import qualified Data.List as L
40import qualified Data.List as L
44import qualified Data.Text as T
41import qualified Data.Text as T
45import qualified Data.Text.Encoding as E
42import qualified Data.Text.Encoding as E
@@ -63,10 +60,10 @@ t_pack_unpack = (T.unpack . T.pack) `eq` id
63tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
60tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
64t_stream_unstream = (S.unstream . S.stream) `eq` id
61t_stream_unstream = (S.unstream . S.stream) `eq` id
65tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
62tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
66−t_reverse_stream t = (S.reverse . S.reverseStream) t === t
63+t_reverse_stream t = (S.reverse . S.reverseStream) t == t
67−t_singleton c = [c] === (T.unpack . T.singleton) c
64+t_singleton c = [c] == (T.unpack . T.singleton) c
68−tl_singleton c = [c] === (TL.unpack . TL.singleton) c
65+tl_singleton c = [c] == (TL.unpack . TL.singleton) c
69−tl_unstreamChunks x = f 11 x === f 1000 x
66+tl_unstreamChunks x = f 11 x == f 1000 x
70 where f n = SL.unstreamChunks n . S.streamList
67 where f n = SL.unstreamChunks n . S.streamList
71tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
68tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
72tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
69tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
@@ -77,13 +74,13 @@ encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
77encodeLazyL1 :: TL.Text -> BL.ByteString
74encodeLazyL1 :: TL.Text -> BL.ByteString
78encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
75encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
79
76
80−t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a
77+t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
81 where a = T.map (\c -> chr (ord c `mod` 128)) t
78 where a = T.map (\c -> chr (ord c `mod` 128)) t
82−tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) === a
79+tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
83 where a = TL.map (\c -> chr (ord c `mod` 128)) t
80 where a = TL.map (\c -> chr (ord c `mod` 128)) t
84−t_latin1 t = E.decodeLatin1 (encodeL1 a) === a
81+t_latin1 t = E.decodeLatin1 (encodeL1 a) == a
85 where a = T.map (\c -> chr (ord c `mod` 256)) t
82 where a = T.map (\c -> chr (ord c `mod` 256)) t
86−tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) === a
83+tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a
87 where a = TL.map (\c -> chr (ord c `mod` 256)) t
84 where a = TL.map (\c -> chr (ord c `mod` 256)) t
88t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
85t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
89t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
86t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
@@ -114,7 +111,7 @@ t_utf8_undecoded = forAll genUnicode $ \t ->
114 let b = E.encodeUtf8 t
111 let b = E.encodeUtf8 t
115 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
112 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
116 leftover = (++ [B.empty]) . init . tail . B.inits
113 leftover = (++ [B.empty]) . init . tail . B.inits
117− in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b === ls
114+ in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls
118
115
119data Badness = Solo | Leading | Trailing
116data Badness = Solo | Leading | Trailing
120 deriving (Eq, Show)
117 deriving (Eq, Show)
@@ -180,33 +177,6 @@ genInvalidUTF8 = B.pack <$> oneof [
180 k <- choose (0,n)
177 k <- choose (0,n)
181 vectorOf k gen
178 vectorOf k gen
182
179
183−-- See http://unicode.org/faq/utf_bom.html#gen8
184−-- A sequence such as <110xxxxx2 0xxxxxxx2> is illegal ...
185−-- When faced with this illegal byte sequence ... a UTF-8 conformant process
186−-- must treat the first byte 110xxxxx2 as an illegal termination error
187−-- (e.g. filter it out or replace by 0xFFFD) ...
188−-- ... and continue processing at the second byte 0xxxxxxx2
189−t_decode_with_error2 =
190− E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97]) === "xa"
191−t_decode_with_error3 =
192− E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xE0, 97, 97]) === "xaa"
193−t_decode_with_error4 =
194− E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xF0, 97, 97, 97]) === "xaaa"
195−
196−t_decode_with_error2' =
197− case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97]) of
198− E.Some x _ _ -> x === "xa"
199−t_decode_with_error3' =
200− case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97]) of
201− E.Some x _ _ -> x === "xaa"
202−t_decode_with_error4' =
203− case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97, 97]) of
204− E.Some x _ _ -> x === "xaaa"
205−
206−t_infix_concat bs1 text bs2 rep =
207− text `T.isInfixOf`
208− E.decodeUtf8With (\_ _ -> rep) (B.concat [bs1, E.encodeUtf8 text, bs2])
209−
210s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
180s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
211 where _types = s :: String
181 where _types = s :: String
212sf_Eq p s =
182sf_Eq p s =
@@ -231,8 +201,8 @@ t_mconcat = unsquare $
231 mconcat `eq` (unpackS . mconcat . L.map T.pack)
201 mconcat `eq` (unpackS . mconcat . L.map T.pack)
232tl_mconcat = unsquare $
202tl_mconcat = unsquare $
233 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
203 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
234−t_mempty = mempty === (unpackS (mempty :: T.Text))
204+t_mempty = mempty == (unpackS (mempty :: T.Text))
235−tl_mempty = mempty === (unpackS (mempty :: TL.Text))
205+tl_mempty = mempty == (unpackS (mempty :: TL.Text))
236t_IsString = fromString `eqP` (T.unpack . fromString)
206t_IsString = fromString `eqP` (T.unpack . fromString)
237tl_IsString = fromString `eqP` (TL.unpack . fromString)
207tl_IsString = fromString `eqP` (TL.unpack . fromString)
238
208
@@ -259,13 +229,6 @@ sf_uncons p = (uncons . L.filter p) `eqP`
259 (fmap (second unpackS) . S.uncons . S.filter p)
229 (fmap (second unpackS) . S.uncons . S.filter p)
260t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
230t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
261tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
231tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
262−
263−unsnoc xs@(_:_) = Just (init xs, last xs)
264−unsnoc [] = Nothing
265−
266−t_unsnoc = unsnoc `eqP` (fmap (first unpackS) . T.unsnoc)
267−tl_unsnoc = unsnoc `eqP` (fmap (first unpackS) . TL.unsnoc)
268−
269s_head = head `eqP` S.head
232s_head = head `eqP` S.head
270sf_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)
271t_head = head `eqP` T.head
234t_head = head `eqP` T.head
@@ -363,19 +326,6 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
363 where p = T.length . T.filter isUpper
326 where p = T.length . T.filter isUpper
364tl_toUpper_upper t = p (TL.toUpper t) >= p t
327tl_toUpper_upper t = p (TL.toUpper t) >= p t
365 where p = TL.length . TL.filter isUpper
328 where p = TL.length . TL.filter isUpper
366−t_toTitle_title t = all (<= 1) (caps w)
367− where caps = fmap (T.length . T.filter isUpper) . T.words . T.toTitle
368− -- TIL: there exist uppercase-only letters
369− w = T.filter (\c -> if C.isUpper c then C.toLower c /= c else True) t
370−t_toTitle_1stNotLower = and . notLow . T.toTitle . T.filter stable
371− where notLow = mapMaybe (fmap (not . isLower) . (T.find isLetter)) . T.words
372− -- Surprise! The Spanish/Portuguese ordinal indicators changed
373− -- from category Ll (letter, lowercase) to Lo (letter, other)
374− -- in Unicode 7.0
375− -- Oh, and there exist lowercase-only letters (see previous test)
376− stable c = if isLower c
377− then C.toUpper c /= c
378− else c /= '\170' && c /= '\186'
379
329
380justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
330justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
381justifyRight m n xs = L.replicate (m - length xs) n ++ xs
331justifyRight m n xs = L.replicate (m - length xs) n ++ xs
@@ -564,20 +514,12 @@ s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
564s_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)
565sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
515sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
566 (unpackS . S.takeWhile p . S.filter q)
516 (unpackS . S.takeWhile p . S.filter q)
567−noMatch = do
568− c <- char
569− d <- suchThat char (/= c)
570− return (c,d)
571t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
517t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
572tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
518tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
573t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
519t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
574 (unpackS . T.takeWhileEnd p)
520 (unpackS . T.takeWhileEnd p)
575−t_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> T.null $
576− T.takeWhileEnd (==d) (T.snoc t c)
577tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
521tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
578 (unpackS . TL.takeWhileEnd p)
522 (unpackS . TL.takeWhileEnd p)
579−tl_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> TL.null $
580− TL.takeWhileEnd (==d) (TL.snoc t c)
581s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
523s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
582s_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)
583sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
525sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -778,7 +720,7 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
778 conc = T.concat . TL.toChunks
720 conc = T.concat . TL.toChunks
779t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
721t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
780 let s = T.intercalate t ts
722 let s = T.intercalate t ts
781− in Slow.indices t s === indices t s
723+ in Slow.indices t s == indices t s
782
724
783-- Bit shifts.
725-- Bit shifts.
784shiftL 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
@@ -870,18 +812,18 @@ tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
870-- Reading.
812-- Reading.
871
813
872t_decimal (n::Int) s =
814t_decimal (n::Int) s =
873− 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)
874 where t = T.dropWhile isDigit s
816 where t = T.dropWhile isDigit s
875tl_decimal (n::Int) s =
817tl_decimal (n::Int) s =
876− 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)
877 where t = TL.dropWhile isDigit s
819 where t = TL.dropWhile isDigit s
878t_hexadecimal m s ox =
820t_hexadecimal m s ox =
879− 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)
880 where t = T.dropWhile isHexDigit s
822 where t = T.dropWhile isHexDigit s
881 p = if ox then "0x" else ""
823 p = if ox then "0x" else ""
882 n = getPositive m :: Int
824 n = getPositive m :: Int
883tl_hexadecimal m s ox =
825tl_hexadecimal m s ox =
884− 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)
885 where t = TL.dropWhile isHexDigit s
827 where t = TL.dropWhile isHexDigit s
886 p = if ox then "0x" else ""
828 p = if ox then "0x" else ""
887 n = getPositive m :: Int
829 n = getPositive m :: Int
@@ -925,11 +867,11 @@ tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
925
867
926t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
868t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
927t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
869t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
928−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
929 where n = small m
871 where n = small m
930t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
931
873
932−t_copy t = T.copy t === t
874+t_copy t = T.copy t == t
933
875
934-- Regression tests.
876-- Regression tests.
935s_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)
@@ -982,15 +924,6 @@ tests =
982 testGroup "errors" [
924 testGroup "errors" [
983 testProperty "t_utf8_err" t_utf8_err,
925 testProperty "t_utf8_err" t_utf8_err,
984 testProperty "t_utf8_err'" t_utf8_err'
926 testProperty "t_utf8_err'" t_utf8_err'
985− ],
986− testGroup "error recovery" [
987− testProperty "t_decode_with_error2" t_decode_with_error2,
988− testProperty "t_decode_with_error3" t_decode_with_error3,
989− testProperty "t_decode_with_error4" t_decode_with_error4,
990− testProperty "t_decode_with_error2'" t_decode_with_error2',
991− testProperty "t_decode_with_error3'" t_decode_with_error3',
992− testProperty "t_decode_with_error4'" t_decode_with_error4',
993− testProperty "t_infix_concat" t_infix_concat
994 ]
927 ]
995 ],
928 ],
996
929
@@ -1034,8 +967,6 @@ tests =
1034 testProperty "sf_uncons" sf_uncons,
967 testProperty "sf_uncons" sf_uncons,
1035 testProperty "t_uncons" t_uncons,
968 testProperty "t_uncons" t_uncons,
1036 testProperty "tl_uncons" tl_uncons,
969 testProperty "tl_uncons" tl_uncons,
1037− testProperty "t_unsnoc" t_unsnoc,
1038− testProperty "tl_unsnoc" tl_unsnoc,
1039 testProperty "s_head" s_head,
970 testProperty "s_head" s_head,
1040 testProperty "sf_head" sf_head,
971 testProperty "sf_head" sf_head,
1041 testProperty "t_head" t_head,
972 testProperty "t_head" t_head,
@@ -1099,9 +1030,7 @@ tests =
1099 testProperty "tl_toLower_lower" tl_toLower_lower,
1030 testProperty "tl_toLower_lower" tl_toLower_lower,
1100 testProperty "t_toUpper_length" t_toUpper_length,
1031 testProperty "t_toUpper_length" t_toUpper_length,
1101 testProperty "t_toUpper_upper" t_toUpper_upper,
1032 testProperty "t_toUpper_upper" t_toUpper_upper,
1102− testProperty "tl_toUpper_upper" tl_toUpper_upper,
1033+ testProperty "tl_toUpper_upper" tl_toUpper_upper
1103− testProperty "t_toTitle_title" t_toTitle_title,
1104− testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower
1105 ],
1034 ],
1106
1035
1107 testGroup "justification" [
1036 testGroup "justification" [
@@ -1218,9 +1147,7 @@ tests =
1218 testProperty "t_takeWhile" t_takeWhile,
1147 testProperty "t_takeWhile" t_takeWhile,
1219 testProperty "tl_takeWhile" tl_takeWhile,
1148 testProperty "tl_takeWhile" tl_takeWhile,
1220 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1149 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1221− testProperty "t_takeWhileEnd_null" t_takeWhileEnd_null,
1222 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1150 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1223− testProperty "tl_takeWhileEnd_null" tl_takeWhileEnd_null,
1224 testProperty "sf_dropWhile" sf_dropWhile,
1151 testProperty "sf_dropWhile" sf_dropWhile,
1225 testProperty "s_dropWhile" s_dropWhile,
1152 testProperty "s_dropWhile" s_dropWhile,
1226 testProperty "s_dropWhile_s" s_dropWhile_s,
1153 testProperty "s_dropWhile_s" s_dropWhile_s,
tests/Tests/QuickCheckUtils.hs+1−1
@@ -106,7 +106,7 @@ smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
106 where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
106 where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
107
107
108instance Arbitrary T.Text where
108instance Arbitrary T.Text where
109− arbitrary = T.pack `fmap` 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
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/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+7−9
@@ -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 .
@@ -39,8 +39,6 @@ copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper
39category: Data, Text
39category: Data, Text
40build-type: Simple
40build-type: Simple
41cabal-version: >= 1.8
41cabal-version: >= 1.8
42−tested-with: GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4,
43− GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4
44extra-source-files:
42extra-source-files:
45 -- scripts/CaseFolding.txt
43 -- scripts/CaseFolding.txt
46 -- scripts/SpecialCasing.txt
44 -- scripts/SpecialCasing.txt
@@ -168,21 +166,21 @@ test-suite tests
168 include-dirs: include
166 include-dirs: include
169
167
170 ghc-options:
168 ghc-options:
171− -Wall -threaded -O1 -rtsopts
169+ -Wall -threaded -O0 -rtsopts
172
170
173 cpp-options:
171 cpp-options:
174 -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
172 -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
175
173
176 build-depends:
174 build-depends:
177 HUnit >= 1.2,
175 HUnit >= 1.2,
178− QuickCheck >= 2.7 && < 2.10,
176+ QuickCheck >= 2.7,
179 array,
177 array,
180 base,
178 base,
181 binary,
179 binary,
182 deepseq,
180 deepseq,
183 directory,
181 directory,
184 ghc-prim,
182 ghc-prim,
185− quickcheck-unicode >= 1.0.1.0,
183+ quickcheck-unicode,
186 random,
184 random,
187 test-framework >= 0.4,
185 test-framework >= 0.4,
188 test-framework-hunit >= 0.2,
186 test-framework-hunit >= 0.2,
@@ -203,7 +201,7 @@ test-suite tests
203
201
204source-repository head
202source-repository head
205 type: git
203 type: git
206− location: https://github.com/haskell/text
204+ location: https://github.com/bos/text
207
205
208source-repository head
206source-repository head
209 type: mercurial
207 type: mercurial