on e37aa52 help sign in
27 files changed+625−113
since splitsnapshots
unifiedsplit
.gitignore+4 .hgtags+1 .travis.yml+111 Data/Text.hs+28−1 Data/Text/Encoding.hs+1−1 Data/Text/Foreign.hs+1−1 Data/Text/Internal/Fusion/CaseMapping.hs+164−4 Data/Text/Internal/Fusion/Common.hs+44−37 Data/Text/Internal/Fusion/Size.hs+32−6 Data/Text/Internal/Fusion/Types.hs+4−4 Data/Text/Lazy.hs+15−6 Data/Text/Lazy/Builder/Int.hs+3 Data/Text/Lazy/Builder/RealFloat.hs+3 Data/Text/Lazy/Read.hs+3−3 Data/Text/Read.hs+3−3 README.markdown+3−3 benchmarks/haskell/Benchmarks.hs+2 benchmarks/haskell/Benchmarks/Concat.hs+25 benchmarks/text-benchmarks.cabal+1 cabal.project+3 cbits/cbits.c+6−11 changelog.md+35−1 tests/Tests/Properties.hs+94−21 tests/Tests/QuickCheckUtils.hs+1−1 tests/Tests/Regressions.hs+11 tests/text-tests.cabal+18−3 text.cabal+9−7
.gitignore+4
@@ -1,3 +1,7 @@
11dist
2+dist-boot
3+dist-install
24cabal-dev
35cabal.sandbox.config
6+ghc.mk
7+GNUmakefile
.hgtags+1
@@ -64,3 +64,4 @@ f8a60279237c1c28e094868740d9188dd94fcc9e 1.2.0.0
6464631fd055e27fa10983e17e9ad36d1b285b85c661 1.2.1.3
65658221a68ed5ec37028357df9c6c25f52320e54ad9 1.2.2.0
6666ce1c5ac65eb9f5580114b4e380092b05a485e95d 1.2.2.1
67+d72c634a91ffe27ec5cd03921dd53efc8129d8f6 1.2.2.2
.travis.ymlnew file+111
@@ -0,0 +1,111 @@
1+# This Travis job script has been generated by a script via
2+#
3+# make_travis_yml_2.hs '-o' '.travis.yml' 'text.cabal'
4+#
5+# For more information, see https://github.com/hvr/multi-ghc-travis
6+#
7+language: c
8+sudo: false
9+
10+# Bryan threatens to turn off Travis-CI if he gets any email :-)
11+notifications:
12+ email: false
13+
14+cache:
15+ directories:
16+ - $HOME/.cabal/packages
17+ - $HOME/.cabal/store
18+
19+before_cache:
20+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
21+ # remove files that are regenerated by 'cabal update'
22+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
23+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
24+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
25+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
26+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
27+
28+matrix:
29+ include:
30+ - compiler: "ghc-7.0.4"
31+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
32+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.0.4], sources: [hvr-ghc]}}
33+ - compiler: "ghc-7.2.2"
34+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
35+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.2.2], sources: [hvr-ghc]}}
36+ - compiler: "ghc-7.4.2"
37+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
38+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.4.2], sources: [hvr-ghc]}}
39+ - compiler: "ghc-7.6.3"
40+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
41+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.6.3], sources: [hvr-ghc]}}
42+ - compiler: "ghc-7.8.4"
43+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
44+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}}
45+ - compiler: "ghc-7.10.3"
46+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
47+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}
48+ - compiler: "ghc-8.0.2"
49+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
50+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}
51+ - compiler: "ghc-8.2.2"
52+ # env: TEST=--disable-tests BENCH=--disable-benchmarks
53+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}
54+
55+before_install:
56+ - HC=${CC}
57+ - HCPKG=${HC/ghc/ghc-pkg}
58+ - unset CC
59+ - PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$PATH
60+ - PKGNAME='text'
61+
62+install:
63+ - cabal --version
64+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
65+ - BENCH=${BENCH---enable-benchmarks}
66+ - TEST=${TEST---enable-tests}
67+ - HADDOCK=${HADDOCK-true}
68+ - INSTALLED=${INSTALLED-true}
69+ - travis_retry cabal update -v
70+ - sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
71+ - rm -fv cabal.project.local
72+ - "echo 'packages: .' > cabal.project"
73+ - rm -f cabal.project.freeze
74+ - cabal new-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all
75+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all
76+
77+# Here starts the actual work to be performed for the package under test;
78+# any command which exits with a non-zero exit code causes the build to fail.
79+script:
80+ - if [ -f configure.ac ]; then autoreconf -i; fi
81+ - rm -rf .ghc.environment.* dist/
82+ - cabal sdist # test that a source-distribution can be generated
83+ - cd dist/
84+ - SRCTAR=(${PKGNAME}-*.tar.gz)
85+ - SRC_BASENAME="${SRCTAR/%.tar.gz}"
86+ - tar -xvf "./$SRC_BASENAME.tar.gz"
87+ - cd "$SRC_BASENAME/"
88+## from here on, CWD is inside the extracted source-tarball
89+ - rm -fv cabal.project.local
90+ - "echo 'packages: .' > cabal.project"
91+ # this builds all libraries and executables (without tests/benchmarks)
92+ - rm -f cabal.project.freeze
93+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all
94+ # this builds all libraries and executables (including tests/benchmarks)
95+ # - rm -rf ./dist-newstyle
96+
97+ # Build with installed constraints for packages in global-db
98+ - if $INSTALLED; then
99+ echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/\([a-zA-Z0-9-]\{1,\}\) */--constraint="\1 installed" /g') all | sh;
100+ else echo "Not building with installed constraints"; fi
101+
102+ # build & run tests, build benchmarks
103+ - cabal new-build -w ${HC} ${TEST} ${BENCH} all
104+ - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} all; fi
105+
106+ # haddock
107+ - rm -rf ./dist-newstyle
108+ - if $HADDOCK; then cabal new-haddock -w ${HC} --disable-tests --disable-benchmarks all; else echo "Skipping haddock generation";fi
109+
110+# REGENDATA ["-o",".travis.yml","text.cabal"]
111+# EOF
Data/Text.hs+28−1
@@ -34,6 +34,7 @@
3434-- with Unicode text (including normalization, regular expressions,
3535-- non-standard encodings, text breaking, and locales), see
3636-- <http://hackage.haskell.org/package/text-icu the text-icu package >.
37+--
3738
3839module Data.Text
3940 (
@@ -43,6 +44,9 @@ module Data.Text
4344 -- * Acceptable data
4445 -- $replacement
4546
47+ -- * Definition of character
48+ -- $character_definition
49+
4650 -- * Fusion
4751 -- $fusion
4852
@@ -60,6 +64,7 @@ module Data.Text
6064 , snoc
6165 , append
6266 , uncons
67+ , unsnoc
6368 , head
6469 , last
6570 , tail
@@ -246,6 +251,17 @@ import qualified GHC.Exts as Exts
246251import Text.Printf (PrintfArg, formatArg, formatString)
247252#endif
248253
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+
249265-- $strict
250266--
251267-- This package provides both strict and lazy 'Text' types. The
@@ -545,6 +561,17 @@ init (Text arr off len) | len <= 0 = emptyError "init"
545561 unstream (S.init (stream t)) = init t
546562 #-}
547563
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+
548575-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
549576-- fusion.
550577null :: Text -> Bool
@@ -1099,8 +1126,8 @@ takeEnd n t@(Text arr off len)
10991126iterNEnd :: Int -> Text -> Int
11001127iterNEnd n t@(Text _arr _off len) = loop (len-1) n
11011128 where loop i !m
1129+ | m <= 0 = i+1
11021130 | i <= 0 = 0
1103− | m <= 1 = i
11041131 | otherwise = loop (i+d) (m-1)
11051132 where d = reverseIter_ t i
11061133
Data/Text/Encoding.hs+1−1
@@ -373,7 +373,7 @@ encodeUtf8 :: Text -> ByteString
373373encodeUtf8 (Text arr off len)
374374 | len == 0 = B.empty
375375 | otherwise = unsafeDupablePerformIO $ do
376− fp <- mallocByteString (len*4)
376+ fp <- mallocByteString (len*3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough
377377 withForeignPtr fp $ \ptr ->
378378 with ptr $ \destPtr -> do
379379 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)
108108 | n >= len || m >= len = t
109109 | otherwise = Text arr off m
110110 where
111− m | w < 0xDB00 || w > 0xD8FF = n
111+ m | w < 0xD800 || w > 0xDBFF = n
112112 | otherwise = n+1
113113 w = A.unsafeIndex arr (off+n-1)
114114
Data/Text/Internal/Fusion/CaseMapping.hs+164−4
@@ -1,10 +1,10 @@
11{-# LANGUAGE Rank2Types #-}
22-- AUTOMATICALLY GENERATED - DO NOT EDIT
33-- Generated by scripts/CaseMapping.hs
4−-- CaseFolding-8.0.0.txt
5−-- Date: 2015-01-13, 18:16:36 GMT [MD]
6−-- SpecialCasing-8.0.0.txt
7−-- Date: 2014-12-16, 23:08:04 GMT [MD]
4+-- CaseFolding-9.0.0.txt
5+-- Date: 2016-03-02, 18:54:54 GMT
6+-- SpecialCasing-9.0.0.txt
7+-- Date: 2016-03-02, 18:55:13 GMT
88
99module Data.Text.Internal.Fusion.CaseMapping where
1010import Data.Char
@@ -371,6 +371,24 @@ foldMapping '\x13fb' s = Yield '\x13f3' (CC s '\x0000' '\x0000')
371371foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000')
372372-- CHEROKEE SMALL LETTER MV
373373foldMapping '\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')
374392-- LATIN SMALL LETTER H WITH LINE BELOW
375393foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000')
376394-- LATIN SMALL LETTER T WITH DIAERESIS
@@ -545,6 +563,8 @@ foldMapping '\x1ff6' s = Yield '\x03c9' (CC s '\x0342' '\x0000')
545563foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9')
546564-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI
547565foldMapping '\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')
548568-- LATIN CAPITAL LETTER J WITH CROSSED-TAIL
549569foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000')
550570-- LATIN CAPITAL LETTER CHI
@@ -737,6 +757,78 @@ foldMapping '\xfb15' s = Yield '\x0574' (CC s '\x056b' '\x0000')
737757foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000')
738758-- ARMENIAN SMALL LIGATURE MEN XEH
739759foldMapping '\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')
740832-- OLD HUNGARIAN CAPITAL LETTER A
741833foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000')
742834-- OLD HUNGARIAN CAPITAL LETTER AA
@@ -839,4 +931,72 @@ foldMapping '\x10cb0' s = Yield '\x10cf0' (CC s '\x0000' '\x0000')
839931foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000')
840932-- OLD HUNGARIAN CAPITAL LETTER US
841933foldMapping '\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')
8421002foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
Data/Text/Internal/Fusion/Common.hs+44−37
@@ -1,4 +1,4 @@
1−{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}
1+{-# LANGUAGE PatternGuards, BangPatterns, MagicHash, Rank2Types #-}
22-- |
33-- Module : Data.Text.Internal.Fusion.Common
44-- Copyright : (c) Bryan O'Sullivan 2009, 2012
@@ -107,7 +107,7 @@ import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),
107107import qualified Data.List as L
108108import qualified Prelude as P
109109import Data.Bits (shiftL)
110−import Data.Char (isLetter)
110+import Data.Char (isLetter, isSpace)
111111import Data.Int (Int64)
112112import Data.Text.Internal.Fusion.Types
113113import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,
@@ -117,7 +117,7 @@ import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)
117117import GHC.Types (Char(..), Int(..))
118118
119119singleton :: Char -> Stream Char
120−singleton c = Stream next False 1
120+singleton c = Stream next False (codePointsSize 1)
121121 where next False = Yield c True
122122 next True = Done
123123{-# INLINE [0] singleton #-}
@@ -175,7 +175,7 @@ data C s = C0 !s
175175
176176-- | /O(n)/ Adds a character to the front of a Stream Char.
177177cons :: Char -> Stream Char -> Stream Char
178−cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1)
178+cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len + codePointsSize 1)
179179 where
180180 next (C1 s) = Yield w (C0 s)
181181 next (C0 s) = case next0 s of
@@ -189,7 +189,7 @@ data Snoc a = N
189189
190190-- | /O(n)/ Adds a character to the end of a stream.
191191snoc :: Stream Char -> Char -> Stream Char
192−snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)
192+snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len + codePointsSize 1)
193193 where
194194 next (J xs) = case next0 xs of
195195 Done -> Yield w N
@@ -237,7 +237,7 @@ uncons :: Stream Char -> Maybe (Char, Stream Char)
237237uncons (Stream next s0 len) = loop_uncons s0
238238 where
239239 loop_uncons !s = case next s of
240− Yield x s1 -> Just (x, Stream next s1 (len-1))
240+ Yield x s1 -> Just (x, Stream next s1 (len - codePointsSize 1))
241241 Skip s' -> loop_uncons s'
242242 Done -> Nothing
243243{-# INLINE [0] uncons #-}
@@ -260,7 +260,7 @@ last (Stream next s0 _len) = loop0_last s0
260260-- | /O(1)/ Returns all characters after the head of a Stream Char, which must
261261-- be non-empty.
262262tail :: Stream Char -> Stream Char
263−tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1)
263+tail (Stream next0 s0 len) = Stream next (C0 s0) (len - codePointsSize 1)
264264 where
265265 next (C0 s) = case next0 s of
266266 Done -> emptyError "tail"
@@ -278,7 +278,7 @@ data Init s = Init0 !s
278278-- | /O(1)/ Returns all but the last character of a Stream Char, which
279279-- must be non-empty.
280280init :: Stream Char -> Stream Char
281−init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1)
281+init (Stream next0 s0 len) = Stream next (Init0 s0) (len - codePointsSize 1)
282282 where
283283 next (Init0 s) = case next0 s of
284284 Done -> emptyError "init"
@@ -318,11 +318,14 @@ lengthI (Stream next s0 _len) = loop_length 0 s0
318318-- greater than the number or if the stream can't possibly be as long
319319-- as the number supplied, and hence be more efficient.
320320compareLengthI :: Integral a => Stream Char -> a -> Ordering
321−compareLengthI (Stream next s0 len) n =
322− case compareSize len (fromIntegral n) of
323− Just o -> o
324− Nothing -> loop_cmp 0 s0
321+compareLengthI (Stream next s0 len) n
322+ -- Note that @len@ tracks code units whereas we want to compare the length
323+ -- in code points. Specifically, a stream with hint @len@ may consist of
324+ -- anywhere from @len/2@ to @len@ code points.
325+ | Just r <- compareSize len n' = r
326+ | otherwise = loop_cmp 0 s0
325327 where
328+ n' = codePointsSize $ fromIntegral n
326329 loop_cmp !z s = case next s of
327330 Done -> compare z n
328331 Skip s' -> loop_cmp z s'
@@ -368,7 +371,7 @@ data I s = I1 !s
368371-- | /O(n)/ Take a character and place it between each of the
369372-- characters of a 'Stream Char'.
370373intersperse :: Char -> Stream Char -> Stream Char
371−intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
374+intersperse c (Stream next0 s0 len) = Stream next (I1 s0) (len + unknownSize)
372375 where
373376 next (I1 s) = case next0 s of
374377 Done -> Done
@@ -393,9 +396,11 @@ intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len
393396-- functions may map one input character to two or three output
394397-- characters.
395398
399+-- | Map a 'Stream' through the given case-mapping function.
396400caseConvert :: (forall s. Char -> s -> Step (CC s) Char)
397401 -> Stream Char -> Stream Char
398−caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len
402+caseConvert remap (Stream next0 s0 len) =
403+ Stream next (CC s0 '\0' '\0') (len `unionSize` 3*len)
399404 where
400405 next (CC s '\0' _) =
401406 case next0 s of
@@ -458,19 +463,20 @@ toLower = caseConvert lowerMapping
458463-- Fox\" is correctly title cased&#x2014;but this function will
459464-- capitalize /every/ word.
460465toTitle :: Stream Char -> Stream Char
461−toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len
466+toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') (len + unknownSize)
462467 where
463468 next (CC (letter :*: s) '\0' _) =
464469 case next0 s of
465− Done -> Done
466− Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
470+ Done -> Done
471+ Skip s' -> Skip (CC (letter :*: s') '\0' '\0')
467472 Yield c s'
468− | letter' -> if letter
469− then lowerMapping c (letter' :*: s')
470− else titleMapping c (letter' :*: s')
471− | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
472− where letter' = isLetter c
473− next (CC s a b) = Yield a (CC s b '\0')
473+ | nonSpace -> if letter
474+ then lowerMapping c (nonSpace :*: s')
475+ else titleMapping c (letter' :*: s')
476+ | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')
477+ where nonSpace = P.not (isSpace c)
478+ letter' = isLetter c
479+ next (CC s a b) = Yield a (CC s b '\0')
474480{-# INLINE [0] toTitle #-}
475481
476482data Justify i s = Just1 !i !s
@@ -478,7 +484,7 @@ data Justify i s = Just1 !i !s
478484
479485justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char
480486justifyLeftI k c (Stream next0 s0 len) =
481− Stream next (Just1 0 s0) (larger (fromIntegral k) len)
487+ Stream next (Just1 0 s0) (larger (fromIntegral k * charSize c + len) len)
482488 where
483489 next (Just1 n s) =
484490 case next0 s of
@@ -698,7 +704,7 @@ replicateI n (Stream next0 s0 len) =
698704-- (a,b), in which case, a is the next Char in the string, and b is
699705-- the seed value for further production.
700706unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char
701−unfoldr f s0 = Stream next s0 1 -- HINT maybe too low
707+unfoldr f s0 = Stream next s0 unknownSize
702708 where
703709 {-# INLINE next #-}
704710 next !s = case f s of
@@ -712,7 +718,7 @@ unfoldr f s0 = Stream next s0 1 -- HINT maybe too low
712718-- 'unfoldr' when the length of the result is known.
713719unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char
714720unfoldrNI n f s0 | n < 0 = empty
715− | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high
721+ | otherwise = Stream next (0 :*: s0) (maxSize $ fromIntegral (n*2))
716722 where
717723 {-# INLINE next #-}
718724 next (z :*: s) = case f s of
@@ -724,12 +730,12 @@ unfoldrNI n f s0 | n < 0 = empty
724730-------------------------------------------------------------------------------
725731-- * Substreams
726732
727−-- | /O(n)/ take n, applied to a stream, returns the prefix of the
733+-- | /O(n)/ @'take' n@, applied to a stream, returns the prefix of the
728734-- stream of length @n@, or the stream itself if @n@ is greater than the
729735-- length of the stream.
730736take :: Integral a => a -> Stream Char -> Stream Char
731737take n0 (Stream next0 s0 len) =
732− Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))
738+ Stream next (n0 :*: s0) (smaller len (codePointsSize $ fromIntegral n0))
733739 where
734740 {-# INLINE next #-}
735741 next (n :*: s) | n <= 0 = Done
@@ -742,12 +748,12 @@ take n0 (Stream next0 s0 len) =
742748data Drop a s = NS !s
743749 | JS !a !s
744750
745−-- | /O(n)/ drop n, applied to a stream, returns the suffix of the
751+-- | /O(n)/ @'drop' n@, applied to a stream, returns the suffix of the
746752-- stream after the first @n@ characters, or the empty stream if @n@
747753-- is greater than the length of the stream.
748754drop :: Integral a => a -> Stream Char -> Stream Char
749755drop n0 (Stream next0 s0 len) =
750− Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))
756+ Stream next (JS n0 s0) (len - codePointsSize (fromIntegral n0))
751757 where
752758 {-# INLINE next #-}
753759 next (JS n s)
@@ -762,10 +768,10 @@ drop n0 (Stream next0 s0 len) =
762768 Yield x s' -> Yield x (NS s')
763769{-# INLINE [0] drop #-}
764770
765−-- | takeWhile, applied to a predicate @p@ and a stream, returns the
766−-- longest prefix (possibly empty) of elements that satisfy p.
771+-- | 'takeWhile', applied to a predicate @p@ and a stream, returns the
772+-- longest prefix (possibly empty) of elements that satisfy @p@.
767773takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char
768−takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
774+takeWhile p (Stream next0 s0 len) = Stream next s0 (len - unknownSize)
769775 where
770776 {-# INLINE next #-}
771777 next !s = case next0 s of
@@ -775,9 +781,9 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
775781 | otherwise -> Done
776782{-# INLINE [0] takeWhile #-}
777783
778−-- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs.
784+-- | @'dropWhile' p xs@ returns the suffix remaining after @'takeWhile' p xs@.
779785dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char
780−dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high
786+dropWhile p (Stream next0 s0 len) = Stream next (L s0) (len - unknownSize)
781787 where
782788 {-# INLINE next #-}
783789 next (L s) = case next0 s of
@@ -811,7 +817,7 @@ isPrefixOf (Stream next1 s1 _) (Stream next2 s2 _) = loop (next1 s1) (next2 s2)
811817-------------------------------------------------------------------------------
812818-- ** Searching by equality
813819
814−-- | /O(n)/ elem is the stream membership predicate.
820+-- | /O(n)/ 'elem' is the stream membership predicate.
815821elem :: Char -> Stream Char -> Bool
816822elem w (Stream next s0 _len) = loop_elem s0
817823 where
@@ -856,7 +862,8 @@ indexI (Stream next s0 _len) n0
856862-- returns a stream containing those characters that satisfy the
857863-- predicate.
858864filter :: (Char -> Bool) -> Stream Char -> Stream Char
859−filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high
865+filter p (Stream next0 s0 len) =
866+ Stream next s0 (len - unknownSize) -- HINT maybe too high
860867 where
861868 next !s = case next0 s of
862869 Done -> Done
Data/Text/Internal/Fusion/Size.hs+32−6
@@ -19,11 +19,16 @@
1919module Data.Text.Internal.Fusion.Size
2020 (
2121 Size
22− , exactly
22+ -- * Sizes
2323 , exactSize
2424 , maxSize
2525 , betweenSize
2626 , unknownSize
27+ , unionSize
28+ , charSize
29+ , codePointsSize
30+ -- * Querying sizes
31+ , exactly
2732 , smaller
2833 , larger
2934 , upperBound
@@ -32,11 +37,13 @@ module Data.Text.Internal.Fusion.Size
3237 , isEmpty
3338 ) where
3439
40+import Data.Char (ord)
3541import Data.Text.Internal (mul)
3642#if defined(ASSERTS)
3743import Control.Exception (assert)
3844#endif
3945
46+-- | A size in UTF-16 code units.
4047data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.
4148 | Unknown -- ^ Unknown size.
4249 deriving (Eq, Show)
@@ -46,6 +53,17 @@ exactly (Between na nb) | na == nb = Just na
4653exactly _ = Nothing
4754{-# INLINE exactly #-}
4855
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+
4967exactSize :: Int -> Size
5068exactSize n =
5169#if defined(ASSERTS)
@@ -71,6 +89,10 @@ betweenSize m n =
7189 Between m n
7290{-# INLINE betweenSize #-}
7391
92+unionSize :: Size -> Size -> Size
93+unionSize (Between a b) (Between c d) = Between (min a c) (max b d)
94+unionSize _ _ = Unknown
95+
7496unknownSize :: Size
7597unknownSize = Unknown
7698{-# INLINE unknownSize #-}
@@ -140,11 +162,15 @@ lowerBound _ (Between n _) = n
140162lowerBound k _ = k
141163{-# INLINE lowerBound #-}
142164
143−compareSize :: Size -> Int -> Maybe Ordering
144−compareSize (Between ma mb) n
145− | mb < n = Just LT
146− | ma > n = Just GT
147− | ma == n && mb == n = Just EQ
165+-- | Determine the ordering relationship between two 'Size's, or 'Nothing' in
166+-- the indeterminate case.
167+compareSize :: Size -> Size -> Maybe Ordering
168+compareSize (Between ma mb) (Between na nb)
169+ | mb < na = Just LT
170+ | ma > nb = Just GT
171+ | ma == mb
172+ , ma == na
173+ , ma == nb = Just EQ
148174compareSize _ _ = Nothing
149175
150176
Data/Text/Internal/Fusion/Types.hs+4−4
@@ -75,16 +75,16 @@ instance (Ord a) => Ord (Stream a) where
7575-- unstreaming functions must be able to cope with the hint being too
7676-- small or too large.
7777--
78−-- The size hint tries to track the UTF-16 code points in a stream,
79−-- but often counts the number of characters instead. It can easily
78+-- The size hint tries to track the UTF-16 code units in a stream,
79+-- but often counts the number of code points instead. It can easily
8080-- undercount if, for instance, a transformed stream contains astral
81−-- plane characters (those above 0x10000).
81+-- plane code points (those above 0x10000).
8282
8383data Stream a =
8484 forall s. Stream
8585 (s -> Step s a) -- stepper function
8686 !s -- current state
87− !Size -- size hint
87+ !Size -- size hint in code units
8888
8989-- | /O(n)/ Determines if two streams are equal.
9090eq :: (Eq a) => Stream a -> Stream a -> Bool
Data/Text/Lazy.hs+15−6
@@ -68,6 +68,7 @@ module Data.Text.Lazy
6868 , snoc
6969 , append
7070 , uncons
71+ , unsnoc
7172 , head
7273 , last
7374 , tail
@@ -475,9 +476,7 @@ fromStrict t = chunk t Empty
475476-- -----------------------------------------------------------------------------
476477-- * Basic functions
477478
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.
479+-- | /O(1)/ Adds a character to the front of a 'Text'. Subject to fusion.
481480cons :: Char -> Text -> Text
482481cons c t = Chunk (T.singleton c) t
483482{-# INLINE [1] cons #-}
@@ -561,6 +560,15 @@ init Empty = emptyError "init"
561560 unstream (S.init (stream t)) = init t
562561 #-}
563562
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+
564572-- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to
565573-- fusion.
566574null :: Text -> Bool
@@ -1153,9 +1161,10 @@ takeWhile p t0 = takeWhile' t0
11531161takeWhileEnd :: (Char -> Bool) -> Text -> Text
11541162takeWhileEnd p = takeChunk empty . L.reverse . toChunks
11551163 where takeChunk acc [] = acc
1156− takeChunk acc (t:ts) = if T.length t' < T.length t
1157− then (Chunk t' acc)
1158− else takeChunk (Chunk t' acc) ts
1164+ takeChunk acc (t:ts)
1165+ | T.lengthWord16 t' < T.lengthWord16 t
1166+ = chunk t' acc
1167+ | otherwise = takeChunk (Chunk t' acc) ts
11591168 where t' = T.takeWhileEnd p t
11601169{-# INLINE takeWhileEnd #-}
11611170
Data/Text/Lazy/Builder/Int.hs+3
@@ -32,6 +32,9 @@ import GHC.Base (quotInt, remInt)
3232import GHC.Num (quotRemInteger)
3333import GHC.Types (Int(..))
3434import Control.Monad.ST
35+#if MIN_VERSION_base(4,11,0)
36+import Prelude hiding ((<>))
37+#endif
3538
3639#ifdef __GLASGOW_HASKELL__
3740# if defined(INTEGER_GMP)
Data/Text/Lazy/Builder/RealFloat.hs+3
@@ -24,6 +24,9 @@ import Data.Text.Lazy.Builder.Int (decimal)
2424import Data.Text.Internal.Builder.RealFloat.Functions (roundTo)
2525import Data.Text.Lazy.Builder
2626import qualified Data.Text as T
27+#if MIN_VERSION_base(4,11,0)
28+import Prelude hiding ((<>))
29+#endif
2730
2831-- | Control the rendering of floating point numbers.
2932data FPFormat = Exponent
Data/Text/Lazy/Read.hs+3−3
@@ -68,9 +68,9 @@ decimal txt
6868 go n d = (n * 10 + fromIntegral (digitToInt d))
6969
7070-- | Read a hexadecimal integer, consisting of an optional leading
71−-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
72−-- until a non-hex-digit or end of string is reached. This function
73−-- is case insensitive.
71+-- @\"0x\"@ followed by at least one hexadecimal digit. Input is
72+-- consumed until a non-hex-digit or end of string is reached.
73+-- This function is case insensitive.
7474--
7575-- This function does not handle leading sign characters. If you need
7676-- to handle signed input, use @'signed' 'hexadecimal'@.
Data/Text/Read.hs+3−3
@@ -67,9 +67,9 @@ decimal txt
6767 go n d = (n * 10 + fromIntegral (digitToInt d))
6868
6969-- | Read a hexadecimal integer, consisting of an optional leading
70−-- @\"0x\"@ followed by at least one decimal digit. Input is consumed
71−-- until a non-hex-digit or end of string is reached. This function
72−-- is case insensitive.
70+-- @\"0x\"@ followed by at least one hexadecimal digit. Input is
71+-- consumed until a non-hex-digit or end of string is reached.
72+-- This function is case insensitive.
7373--
7474-- This function does not handle leading sign characters. If you need
7575-- to handle signed input, use @'signed' 'hexadecimal'@.
README.markdown+3−3
@@ -19,11 +19,11 @@ library to provide these facilities.
1919# Get involved!
2020
2121Please report bugs via the
22−[github issue tracker](https://github.com/bos/text/issues).
22+[github issue tracker](https://github.com/haskell/text/issues).
2323
24−Master [git repository](https://github.com/bos/text):
24+Master [git repository](https://github.com/haskell/text):
2525
26−* `git clone git://github.com/bos/text.git`
26+* `git clone git://github.com/haskell/text.git`
2727
2828There's also a [Mercurial mirror](https://bitbucket.org/bos/text):
2929
benchmarks/haskell/Benchmarks.hs+2
@@ -10,6 +10,7 @@ import System.FilePath ((</>))
1010import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8)
1111
1212import qualified Benchmarks.Builder as Builder
13+import qualified Benchmarks.Concat as Concat
1314import qualified Benchmarks.DecodeUtf8 as DecodeUtf8
1415import qualified Benchmarks.EncodeUtf8 as EncodeUtf8
1516import qualified Benchmarks.Equality as Equality
@@ -41,6 +42,7 @@ benchmarks = do
4142 -- Traditional benchmarks
4243 bs <- sequence
4344 [ Builder.benchmark
45+ , Concat.benchmark
4446 , DecodeUtf8.benchmark "html" (tf "libya-chinese.html")
4547 , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml")
4648 , DecodeUtf8.benchmark "ascii" (tf "ascii.txt")
benchmarks/haskell/Benchmarks/Concat.hsnew file+25
@@ -0,0 +1,25 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Benchmarks.Concat (benchmark) where
4+
5+import Control.Monad.Trans.Writer
6+import Criterion (Benchmark, bgroup, bench, whnf)
7+import Data.Text as T
8+
9+benchmark :: IO Benchmark
10+benchmark = return $ bgroup "Concat"
11+ [ bench "append" $ whnf (append4 "Text 1" "Text 2" "Text 3") "Text 4"
12+ , bench "concat" $ whnf (concat4 "Text 1" "Text 2" "Text 3") "Text 4"
13+ , bench "write" $ whnf (write4 "Text 1" "Text 2" "Text 3") "Text 4"
14+ ]
15+
16+append4, concat4, write4 :: Text -> Text -> Text -> Text -> Text
17+
18+{-# NOINLINE append4 #-}
19+append4 x1 x2 x3 x4 = x1 `append` x2 `append` x3 `append` x4
20+
21+{-# NOINLINE concat4 #-}
22+concat4 x1 x2 x3 x4 = T.concat [x1, x2, x3, x4]
23+
24+{-# NOINLINE write4 #-}
25+write4 x1 x2 x3 x4 = execWriter $ tell x1 >> tell x2 >> tell x3 >> tell x4
benchmarks/text-benchmarks.cabal+1
@@ -47,6 +47,7 @@ executable text-benchmarks
4747 ghc-prim,
4848 integer-gmp,
4949 stringsearch,
50+ transformers,
5051 utf8-string,
5152 vector
5253
cabal.projectnew file+3
@@ -0,0 +1,3 @@
1+-- See http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html
2+packages: .
3+tests: True
cbits/cbits.c+6−11
@@ -206,11 +206,9 @@ _hs_text_decode_utf8_state(uint16_t *const dest, size_t *destoff,
206206 const uint8_t *srcend,
207207 uint32_t *codepoint0, uint32_t *state0)
208208{
209− uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend,
210− codepoint0, state0);
211− if (*state0 == UTF8_REJECT)
212− ret -=1;
213− return ret;
209+ _hs_text_decode_utf8_int(dest, destoff, src, srcend, codepoint0, state0);
210+
211+ return *src;
214212}
215213
216214/*
@@ -222,12 +220,9 @@ _hs_text_decode_utf8(uint16_t *const dest, size_t *destoff,
222220{
223221 uint32_t codepoint;
224222 uint32_t state = UTF8_ACCEPT;
225− uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, &src, srcend,
226− &codepoint, &state);
227− /* Back up if we have an incomplete or invalid encoding */
228− if (state != UTF8_ACCEPT)
229− ret -= 1;
230− return ret;
223+ _hs_text_decode_utf8_int(dest, destoff, &src, srcend,
224+ &codepoint, &state);
225+ return src;
231226}
232227
233228void
changelog.md+35−1
@@ -1,10 +1,44 @@
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+
1351.2.2.1
236
337* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.
438 The build flag has been renamed accordingly. Your army of diligent
539 maintainers apologizes for the churn.
640
7−* Spec compliance: toCaseFold now follows the Unicode 8.0 spec
41+* Spec compliance: `toCaseFold` now follows the Unicode 8.0 spec
842 (updated from 7.0)
943
1044* An STG lint error has been fixed
tests/Tests/Properties.hs+94−21
@@ -9,9 +9,9 @@ module Tests.Properties
99 ) where
1010
1111import Control.Applicative ((<$>), (<*>))
12−import Control.Arrow ((***), second)
12+import Control.Arrow ((***), first, second)
1313import Data.Bits ((.&.))
14−import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)
14+import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isLetter, isUpper, ord)
1515import Data.Int (Int8, Int16, Int32, Int64)
1616import Data.Monoid (Monoid(..))
1717import Data.String (IsString(fromString))
@@ -23,6 +23,7 @@ import Data.Text.Internal.Search (indices)
2323import Data.Text.Lazy.Read as TL
2424import Data.Text.Read as T
2525import Data.Word (Word, Word8, Word16, Word32, Word64)
26+import Data.Maybe (mapMaybe)
2627import Numeric (showEFloat, showFFloat, showGFloat, showHex)
2728import Prelude hiding (replicate)
2829import Test.Framework (Test, testGroup)
@@ -30,6 +31,7 @@ import Test.Framework.Providers.QuickCheck2 (testProperty)
3031import Test.QuickCheck hiding ((.&.))
3132import Test.QuickCheck.Monadic
3233import Test.QuickCheck.Property (Property(..))
34+import Test.QuickCheck.Unicode (char)
3335import Tests.QuickCheckUtils
3436import Tests.Utils
3537import Text.Show.Functions ()
@@ -37,6 +39,7 @@ import qualified Control.Exception as Exception
3739import qualified Data.Bits as Bits (shiftL, shiftR)
3840import qualified Data.ByteString as B
3941import qualified Data.ByteString.Lazy as BL
42+import qualified Data.Char as C
4043import qualified Data.List as L
4144import qualified Data.Text as T
4245import qualified Data.Text.Encoding as E
@@ -60,10 +63,10 @@ t_pack_unpack = (T.unpack . T.pack) `eq` id
6063tl_pack_unpack = (TL.unpack . TL.pack) `eq` id
6164t_stream_unstream = (S.unstream . S.stream) `eq` id
6265tl_stream_unstream = (SL.unstream . SL.stream) `eq` id
63−t_reverse_stream t = (S.reverse . S.reverseStream) t == t
64−t_singleton c = [c] == (T.unpack . T.singleton) c
65−tl_singleton c = [c] == (TL.unpack . TL.singleton) c
66−tl_unstreamChunks x = f 11 x == f 1000 x
66+t_reverse_stream t = (S.reverse . S.reverseStream) t === t
67+t_singleton c = [c] === (T.unpack . T.singleton) c
68+tl_singleton c = [c] === (TL.unpack . TL.singleton) c
69+tl_unstreamChunks x = f 11 x === f 1000 x
6770 where f n = SL.unstreamChunks n . S.streamList
6871tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id
6972tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id
@@ -74,13 +77,13 @@ encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack
7477encodeLazyL1 :: TL.Text -> BL.ByteString
7578encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks
7679
77−t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a
80+t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a
7881 where a = T.map (\c -> chr (ord c `mod` 128)) t
79−tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a
82+tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) === a
8083 where a = TL.map (\c -> chr (ord c `mod` 128)) t
81−t_latin1 t = E.decodeLatin1 (encodeL1 a) == a
84+t_latin1 t = E.decodeLatin1 (encodeL1 a) === a
8285 where a = T.map (\c -> chr (ord c `mod` 256)) t
83−tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a
86+tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) === a
8487 where a = TL.map (\c -> chr (ord c `mod` 256)) t
8588t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id
8689t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)
@@ -111,7 +114,7 @@ t_utf8_undecoded = forAll genUnicode $ \t ->
111114 let b = E.encodeUtf8 t
112115 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t
113116 leftover = (++ [B.empty]) . init . tail . B.inits
114− in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls
117+ in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b === ls
115118
116119data Badness = Solo | Leading | Trailing
117120 deriving (Eq, Show)
@@ -177,6 +180,33 @@ genInvalidUTF8 = B.pack <$> oneof [
177180 k <- choose (0,n)
178181 vectorOf k gen
179182
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+
180210s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
181211 where _types = s :: String
182212sf_Eq p s =
@@ -201,8 +231,8 @@ t_mconcat = unsquare $
201231 mconcat `eq` (unpackS . mconcat . L.map T.pack)
202232tl_mconcat = unsquare $
203233 mconcat `eq` (unpackS . mconcat . L.map TL.pack)
204−t_mempty = mempty == (unpackS (mempty :: T.Text))
205−tl_mempty = mempty == (unpackS (mempty :: TL.Text))
234+t_mempty = mempty === (unpackS (mempty :: T.Text))
235+tl_mempty = mempty === (unpackS (mempty :: TL.Text))
206236t_IsString = fromString `eqP` (T.unpack . fromString)
207237tl_IsString = fromString `eqP` (TL.unpack . fromString)
208238
@@ -229,6 +259,13 @@ sf_uncons p = (uncons . L.filter p) `eqP`
229259 (fmap (second unpackS) . S.uncons . S.filter p)
230260t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
231261tl_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+
232269s_head = head `eqP` S.head
233270sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
234271t_head = head `eqP` T.head
@@ -326,6 +363,19 @@ t_toUpper_upper t = p (T.toUpper t) >= p t
326363 where p = T.length . T.filter isUpper
327364tl_toUpper_upper t = p (TL.toUpper t) >= p t
328365 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'
329379
330380justifyLeft k c xs = xs ++ L.replicate (k - length xs) c
331381justifyRight m n xs = L.replicate (m - length xs) n ++ xs
@@ -514,12 +564,20 @@ s_takeWhile p = L.takeWhile p `eqP` (unpackS . S.takeWhile p)
514564s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p)
515565sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP`
516566 (unpackS . S.takeWhile p . S.filter q)
567+noMatch = do
568+ c <- char
569+ d <- suchThat char (/= c)
570+ return (c,d)
517571t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p)
518572tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p)
519573t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
520574 (unpackS . T.takeWhileEnd p)
575+t_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> T.null $
576+ T.takeWhileEnd (==d) (T.snoc t c)
521577tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP`
522578 (unpackS . TL.takeWhileEnd p)
579+tl_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> TL.null $
580+ TL.takeWhileEnd (==d) (TL.snoc t c)
523581s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p)
524582s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p)
525583sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP`
@@ -720,7 +778,7 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s
720778 conc = T.concat . TL.toChunks
721779t_indices_occurs = unsquare $ \(NotEmpty t) ts ->
722780 let s = T.intercalate t ts
723− in Slow.indices t s == indices t s
781+ in Slow.indices t s === indices t s
724782
725783-- Bit shifts.
726784shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k
@@ -812,18 +870,18 @@ tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a
812870-- Reading.
813871
814872t_decimal (n::Int) s =
815− T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)
873+ T.signed T.decimal (T.pack (show n) `T.append` t) === Right (n,t)
816874 where t = T.dropWhile isDigit s
817875tl_decimal (n::Int) s =
818− TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)
876+ TL.signed TL.decimal (TL.pack (show n) `TL.append` t) === Right (n,t)
819877 where t = TL.dropWhile isDigit s
820878t_hexadecimal m s ox =
821− T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)
879+ T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) === Right (n,t)
822880 where t = T.dropWhile isHexDigit s
823881 p = if ox then "0x" else ""
824882 n = getPositive m :: Int
825883tl_hexadecimal m s ox =
826− TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)
884+ TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) === Right (n,t)
827885 where t = TL.dropWhile isHexDigit s
828886 p = if ox then "0x" else ""
829887 n = getPositive m :: Int
@@ -867,11 +925,11 @@ tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn
867925
868926t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t
869927t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t
870−t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) == t
928+t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) === t
871929 where n = small m
872930t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)
873931
874−t_copy t = T.copy t == t
932+t_copy t = T.copy t === t
875933
876934-- Regression tests.
877935s_filter_eq s = S.filter p t == S.streamList (filter p s)
@@ -924,6 +982,15 @@ tests =
924982 testGroup "errors" [
925983 testProperty "t_utf8_err" t_utf8_err,
926984 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
927994 ]
928995 ],
929996
@@ -967,6 +1034,8 @@ tests =
9671034 testProperty "sf_uncons" sf_uncons,
9681035 testProperty "t_uncons" t_uncons,
9691036 testProperty "tl_uncons" tl_uncons,
1037+ testProperty "t_unsnoc" t_unsnoc,
1038+ testProperty "tl_unsnoc" tl_unsnoc,
9701039 testProperty "s_head" s_head,
9711040 testProperty "sf_head" sf_head,
9721041 testProperty "t_head" t_head,
@@ -1030,7 +1099,9 @@ tests =
10301099 testProperty "tl_toLower_lower" tl_toLower_lower,
10311100 testProperty "t_toUpper_length" t_toUpper_length,
10321101 testProperty "t_toUpper_upper" t_toUpper_upper,
1033− testProperty "tl_toUpper_upper" tl_toUpper_upper
1102+ testProperty "tl_toUpper_upper" tl_toUpper_upper,
1103+ testProperty "t_toTitle_title" t_toTitle_title,
1104+ testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower
10341105 ],
10351106
10361107 testGroup "justification" [
@@ -1147,7 +1218,9 @@ tests =
11471218 testProperty "t_takeWhile" t_takeWhile,
11481219 testProperty "tl_takeWhile" tl_takeWhile,
11491220 testProperty "t_takeWhileEnd" t_takeWhileEnd,
1221+ testProperty "t_takeWhileEnd_null" t_takeWhileEnd_null,
11501222 testProperty "tl_takeWhileEnd" tl_takeWhileEnd,
1223+ testProperty "tl_takeWhileEnd_null" tl_takeWhileEnd_null,
11511224 testProperty "sf_dropWhile" sf_dropWhile,
11521225 testProperty "s_dropWhile" s_dropWhile,
11531226 testProperty "s_dropWhile_s" s_dropWhile_s,
tests/Tests/QuickCheckUtils.hs+1−1
@@ -106,7 +106,7 @@ smallArbitrary = sized $ \n -> resize (smallish n) arbitrary
106106 where smallish = round . (sqrt :: Double -> Double) . fromIntegral . abs
107107
108108instance Arbitrary T.Text where
109− arbitrary = T.pack `fmap` arbitrary
109+ arbitrary = T.pack `fmap` string
110110 shrink = map T.pack . shrink . T.unpack
111111
112112instance Arbitrary TL.Text where
tests/Tests/Regressions.hs+11
@@ -72,6 +72,16 @@ mapAccumL_resize = do
7272 assertEqual "mapAccumL should correctly size buffers for two-word results"
7373 (count * 2) (T.lengthWord16 (snd val))
7474
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+
7585tests :: F.Test
7686tests = F.testGroup "Regressions"
7787 [ F.testCase "hGetContents_crash" hGetContents_crash
@@ -79,4 +89,5 @@ tests = F.testGroup "Regressions"
7989 , F.testCase "mapAccumL_resize" mapAccumL_resize
8090 , F.testCase "replicate_crash" replicate_crash
8191 , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe
92+ , F.testCase "t197" t197
8293 ]
tests/text-tests.cabal+18−3
@@ -20,6 +20,11 @@ flag hpc
2020 default: False
2121 manual: True
2222
23+flag bytestring-builder
24+ description: Depend on the bytestring-builder package for backwards compatibility.
25+ default: False
26+ manual: False
27+
2328executable text-tests
2429 main-is: Tests.hs
2530
@@ -48,16 +53,21 @@ executable text-tests
4853 HUnit >= 1.2,
4954 QuickCheck >= 2.7,
5055 base == 4.*,
51− bytestring,
5256 deepseq,
5357 directory,
54− quickcheck-unicode,
58+ quickcheck-unicode >= 1.0.1.0,
5559 random,
5660 test-framework >= 0.4,
5761 test-framework-hunit >= 0.2,
5862 test-framework-quickcheck2 >= 0.2,
5963 text-tests
6064
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+
6171executable text-tests-stdio
6272 main-is: Tests/IO.hs
6373
@@ -137,7 +147,12 @@ library
137147 array,
138148 base == 4.*,
139149 binary,
140− bytestring,
141150 deepseq,
142151 ghc-prim,
143152 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+9−7
@@ -1,7 +1,7 @@
11name: text
2−version: 1.2.2.1
3−homepage: https://github.com/bos/text
4−bug-reports: https://github.com/bos/text/issues
2+version: 1.2.3.0
3+homepage: https://github.com/haskell/text
4+bug-reports: https://github.com/haskell/text/issues
55synopsis: An efficient packed Unicode text type.
66description:
77 .
@@ -39,6 +39,8 @@ copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper
3939category: Data, Text
4040build-type: Simple
4141cabal-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
4244extra-source-files:
4345 -- scripts/CaseFolding.txt
4446 -- scripts/SpecialCasing.txt
@@ -166,21 +168,21 @@ test-suite tests
166168 include-dirs: include
167169
168170 ghc-options:
169− -Wall -threaded -O0 -rtsopts
171+ -Wall -threaded -O1 -rtsopts
170172
171173 cpp-options:
172174 -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE
173175
174176 build-depends:
175177 HUnit >= 1.2,
176− QuickCheck >= 2.7,
178+ QuickCheck >= 2.7 && < 2.10,
177179 array,
178180 base,
179181 binary,
180182 deepseq,
181183 directory,
182184 ghc-prim,
183− quickcheck-unicode,
185+ quickcheck-unicode >= 1.0.1.0,
184186 random,
185187 test-framework >= 0.4,
186188 test-framework-hunit >= 0.2,
@@ -201,7 +203,7 @@ test-suite tests
201203
202204source-repository head
203205 type: git
204− location: https://github.com/bos/text
206+ location: https://github.com/haskell/text
205207
206208source-repository head
207209 type: mercurial