master...c59fff3 · text

git.iko.soy/text

on c59fff3 help sign in

Data/Text.hs+1−1

since splitsnapshots

unifiedsplit

@@ -1099,8 +1099,8 @@ takeEnd n t@(Text arr off len)

1099iterNEnd :: Int -> Text -> Int

1100iterNEnd n t@(Text _arr _off len) = loop (len-1) n

1101 where loop i !m

1102+ | m <= 0 = i+1

1102 | i <= 0 = 0

1103 | i <= 0 = 0

1103− | m <= 1 = i

1104 | otherwise = loop (i+d) (m-1)

1105 where d = reverseIter_ t i

1106

Data/Text/Foreign.hs+1−1

@@ -108,7 +108,7 @@ takeWord16 (I16 n) t@(Text arr off len)

108 | n >= len || m >= len = t

109 | otherwise = Text arr off m

110 where

111− m | w < 0xDB00 || w > 0xD8FF = n

111+ m | w < 0xD800 || w > 0xDBFF = n

112 | otherwise = n+1

113 w = A.unsafeIndex arr (off+n-1)

114

Data/Text/Internal/Fusion/Common.hs+10−9

@@ -107,7 +107,7 @@ import Prelude (Bool(..), Char, Eq(..), Int, Integral, Maybe(..),

107import qualified Data.List as L

108import qualified Prelude as P

109import Data.Bits (shiftL)

110−import Data.Char (isLetter)

110+import Data.Char (isLetter, isSpace)

111import Data.Int (Int64)

112import Data.Text.Internal.Fusion.Types

113import Data.Text.Internal.Fusion.CaseMapping (foldMapping, lowerMapping, titleMapping,

@@ -462,15 +462,16 @@ toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len

462 where

463 next (CC (letter :*: s) '\0' _) =

464 case next0 s of

465− Done -> Done

465+ Done -> Done

466− Skip s' -> Skip (CC (letter :*: s') '\0' '\0')

466+ Skip s' -> Skip (CC (letter :*: s') '\0' '\0')

467 Yield c s'

468− | letter' -> if letter

468+ | nonSpace -> if letter

469− then lowerMapping c (letter' :*: s')

469+ then lowerMapping c (nonSpace :*: s')

470− else titleMapping c (letter' :*: s')

470+ else titleMapping c (letter' :*: s')

471− | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')

471+ | otherwise -> Yield c (CC (letter' :*: s') '\0' '\0')

472+ where nonSpace = P.not (isSpace c)

472− where letter' = isLetter c

473+ letter' = isLetter c

473− next (CC s a b) = Yield a (CC s b '\0')

474+ next (CC s a b) = Yield a (CC s b '\0')

474{-# INLINE [0] toTitle #-}

475{-# INLINE [0] toTitle #-}

475

476

476data Justify i s = Just1 !i !s

477data Justify i s = Just1 !i !s

Data/Text/Lazy/Read.hs+3−3

@@ -68,9 +68,9 @@ decimal txt

68 go n d = (n * 10 + fromIntegral (digitToInt d))

70-- | Read a hexadecimal integer, consisting of an optional leading

71−-- @\"0x\"@ followed by at least one decimal digit. Input is consumed

71+-- @\"0x\"@ followed by at least one hexadecimal digit. Input is

72−-- until a non-hex-digit or end of string is reached. This function

72+-- consumed until a non-hex-digit or end of string is reached.

73−-- is case insensitive.

73+-- This function is case insensitive.

74--

75-- This function does not handle leading sign characters. If you need

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))

69-- | Read a hexadecimal integer, consisting of an optional leading

70−-- @\"0x\"@ followed by at least one decimal digit. Input is consumed

70+-- @\"0x\"@ followed by at least one hexadecimal digit. Input is

71−-- until a non-hex-digit or end of string is reached. This function

71+-- consumed until a non-hex-digit or end of string is reached.

72−-- is case insensitive.

72+-- This function is case insensitive.

73--

74-- This function does not handle leading sign characters. If you need

75-- to handle signed input, use @'signed' 'hexadecimal'@.

changelog.md+11

@@ -1,3 +1,14 @@

1+* The `toTitle` function now correctly handles letters that

2+ immediately follow puncutation. Before, `"there's"` would turn into

3+ `"There'S"`. Now, it becomes `"There's"`.

5+* The implementation of unstreaming is faster, resulting in operations

6+ such as `map` and `intersperse` speeding up by up to 30%, with

7+ smaller code generated.

9+* The optimised length comparison function is now more likely to be

10+ used after some rewrite rule tweaking.

11+

11.2.2.1

121.2.2.1

3* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.

14* The switch to `integer-pure` in 1.2.2.0 was apparently mistaken.

tests/Tests/Properties.hs+37−20

@@ -11,7 +11,7 @@ module Tests.Properties

11import Control.Applicative ((<$>), (<*>))

12import Control.Arrow ((***), second)

13import Data.Bits ((.&.))

14−import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord)

14+import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isLetter, isUpper, ord)

15import Data.Int (Int8, Int16, Int32, Int64)

16import Data.Monoid (Monoid(..))

17import Data.String (IsString(fromString))

@@ -23,6 +23,7 @@ import Data.Text.Internal.Search (indices)

23import Data.Text.Lazy.Read as TL

24import Data.Text.Read as T

25import Data.Word (Word, Word8, Word16, Word32, Word64)

26+import Data.Maybe (mapMaybe)

26import Numeric (showEFloat, showFFloat, showGFloat, showHex)

27import Numeric (showEFloat, showFFloat, showGFloat, showHex)

27import Prelude hiding (replicate)

28import Prelude hiding (replicate)

28import Test.Framework (Test, testGroup)

29import Test.Framework (Test, testGroup)

@@ -37,6 +38,7 @@ import qualified Control.Exception as Exception

37import qualified Data.Bits as Bits (shiftL, shiftR)

38import qualified Data.Bits as Bits (shiftL, shiftR)

38import qualified Data.ByteString as B

39import qualified Data.ByteString as B

39import qualified Data.ByteString.Lazy as BL

40import qualified Data.ByteString.Lazy as BL

41+import qualified Data.Char as C

40import qualified Data.List as L

42import qualified Data.List as L

41import qualified Data.Text as T

43import qualified Data.Text as T

42import qualified Data.Text.Encoding as E

44import qualified Data.Text.Encoding as E

@@ -60,10 +62,10 @@ t_pack_unpack = (T.unpack . T.pack) `eq` id

60tl_pack_unpack = (TL.unpack . TL.pack) `eq` id

62tl_pack_unpack = (TL.unpack . TL.pack) `eq` id

61t_stream_unstream = (S.unstream . S.stream) `eq` id

63t_stream_unstream = (S.unstream . S.stream) `eq` id

62tl_stream_unstream = (SL.unstream . SL.stream) `eq` id

64tl_stream_unstream = (SL.unstream . SL.stream) `eq` id

63−t_reverse_stream t = (S.reverse . S.reverseStream) t == t

65+t_reverse_stream t = (S.reverse . S.reverseStream) t === t

64−t_singleton c = [c] == (T.unpack . T.singleton) c

66+t_singleton c = [c] === (T.unpack . T.singleton) c

65−tl_singleton c = [c] == (TL.unpack . TL.singleton) c

67+tl_singleton c = [c] === (TL.unpack . TL.singleton) c

66−tl_unstreamChunks x = f 11 x == f 1000 x

68+tl_unstreamChunks x = f 11 x === f 1000 x

67 where f n = SL.unstreamChunks n . S.streamList

69 where f n = SL.unstreamChunks n . S.streamList

68tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id

70tl_chunk_unchunk = (TL.fromChunks . TL.toChunks) `eq` id

69tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id

71tl_from_to_strict = (TL.fromStrict . TL.toStrict) `eq` id

@@ -74,13 +76,13 @@ encodeL1 = B.pack . map (fromIntegral . fromEnum) . T.unpack

74encodeLazyL1 :: TL.Text -> BL.ByteString

76encodeLazyL1 :: TL.Text -> BL.ByteString

75encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks

77encodeLazyL1 = BL.fromChunks . map encodeL1 . TL.toChunks

77−t_ascii t = E.decodeASCII (E.encodeUtf8 a) == a

79+t_ascii t = E.decodeASCII (E.encodeUtf8 a) === a

78 where a = T.map (\c -> chr (ord c `mod` 128)) t

80 where a = T.map (\c -> chr (ord c `mod` 128)) t

79−tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) == a

81+tl_ascii t = EL.decodeASCII (EL.encodeUtf8 a) === a

80 where a = TL.map (\c -> chr (ord c `mod` 128)) t

82 where a = TL.map (\c -> chr (ord c `mod` 128)) t

81−t_latin1 t = E.decodeLatin1 (encodeL1 a) == a

83+t_latin1 t = E.decodeLatin1 (encodeL1 a) === a

82 where a = T.map (\c -> chr (ord c `mod` 256)) t

84 where a = T.map (\c -> chr (ord c `mod` 256)) t

83−tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) == a

85+tl_latin1 t = EL.decodeLatin1 (encodeLazyL1 a) === a

84 where a = TL.map (\c -> chr (ord c `mod` 256)) t

86 where a = TL.map (\c -> chr (ord c `mod` 256)) t

85t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id

87t_utf8 = forAll genUnicode $ (E.decodeUtf8 . E.encodeUtf8) `eq` id

86t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)

88t_utf8' = forAll genUnicode $ (E.decodeUtf8' . E.encodeUtf8) `eq` (id . Right)

@@ -111,7 +113,7 @@ t_utf8_undecoded = forAll genUnicode $ \t ->

111 let b = E.encodeUtf8 t

113 let b = E.encodeUtf8 t

112 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t

114 ls = concatMap (leftover . E.encodeUtf8 . T.singleton) . T.unpack $ t

113 leftover = (++ [B.empty]) . init . tail . B.inits

115 leftover = (++ [B.empty]) . init . tail . B.inits

114− in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b == ls

116+ in (map snd . feedChunksOf 1 E.streamDecodeUtf8) b === ls

115

117

116data Badness = Solo | Leading | Trailing

118data Badness = Solo | Leading | Trailing

117 deriving (Eq, Show)

119 deriving (Eq, Show)

@@ -201,8 +203,8 @@ t_mconcat = unsquare $

201 mconcat `eq` (unpackS . mconcat . L.map T.pack)

203 mconcat `eq` (unpackS . mconcat . L.map T.pack)

202tl_mconcat = unsquare $

204tl_mconcat = unsquare $

203 mconcat `eq` (unpackS . mconcat . L.map TL.pack)

205 mconcat `eq` (unpackS . mconcat . L.map TL.pack)

204−t_mempty = mempty == (unpackS (mempty :: T.Text))

206+t_mempty = mempty === (unpackS (mempty :: T.Text))

205−tl_mempty = mempty == (unpackS (mempty :: TL.Text))

207+tl_mempty = mempty === (unpackS (mempty :: TL.Text))

206t_IsString = fromString `eqP` (T.unpack . fromString)

208t_IsString = fromString `eqP` (T.unpack . fromString)

207tl_IsString = fromString `eqP` (TL.unpack . fromString)

209tl_IsString = fromString `eqP` (TL.unpack . fromString)

208

210

@@ -326,6 +328,19 @@ t_toUpper_upper t = p (T.toUpper t) >= p t

326 where p = T.length . T.filter isUpper

328 where p = T.length . T.filter isUpper

327tl_toUpper_upper t = p (TL.toUpper t) >= p t

329tl_toUpper_upper t = p (TL.toUpper t) >= p t

328 where p = TL.length . TL.filter isUpper

330 where p = TL.length . TL.filter isUpper

331+t_toTitle_title t = all (<= 1) (caps w)

332+ where caps = fmap (T.length . T.filter isUpper) . T.words . T.toTitle

333+ -- TIL: there exist uppercase-only letters

334+ w = T.filter (\c -> if C.isUpper c then C.toLower c /= c else True) t

335+t_toTitle_1stNotLower = and . notLow . T.toTitle . T.filter stable

336+ where notLow = mapMaybe (fmap (not . isLower) . (T.find isLetter)) . T.words

337+ -- Surprise! The Spanish/Portuguese ordinal indicators changed

338+ -- from category Ll (letter, lowercase) to Lo (letter, other)

339+ -- in Unicode 7.0

340+ -- Oh, and there exist lowercase-only letters (see previous test)

341+ stable c = if isLower c

342+ then C.toUpper c /= c

343+ else c /= '\170' && c /= '\186'

329

344

330justifyLeft k c xs = xs ++ L.replicate (k - length xs) c

345justifyLeft k c xs = xs ++ L.replicate (k - length xs) c

331justifyRight m n xs = L.replicate (m - length xs) n ++ xs

346justifyRight m n xs = L.replicate (m - length xs) n ++ xs

@@ -720,7 +735,7 @@ tl_indices (NotEmpty s) = lazyIndices s `eq` S.indices s

720 conc = T.concat . TL.toChunks

735 conc = T.concat . TL.toChunks

721t_indices_occurs = unsquare $ \(NotEmpty t) ts ->

736t_indices_occurs = unsquare $ \(NotEmpty t) ts ->

722 let s = T.intercalate t ts

737 let s = T.intercalate t ts

723− in Slow.indices t s == indices t s

738+ in Slow.indices t s === indices t s

724

739

725-- Bit shifts.

740-- Bit shifts.

726shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k

741shiftL w = forAll (choose (0,width-1)) $ \k -> Bits.shiftL w k == U.shiftL w k

@@ -812,18 +827,18 @@ tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a

812-- Reading.

827-- Reading.

813

828

814t_decimal (n::Int) s =

829t_decimal (n::Int) s =

815− T.signed T.decimal (T.pack (show n) `T.append` t) == Right (n,t)

830+ T.signed T.decimal (T.pack (show n) `T.append` t) === Right (n,t)

816 where t = T.dropWhile isDigit s

831 where t = T.dropWhile isDigit s

817tl_decimal (n::Int) s =

832tl_decimal (n::Int) s =

818− TL.signed TL.decimal (TL.pack (show n) `TL.append` t) == Right (n,t)

833+ TL.signed TL.decimal (TL.pack (show n) `TL.append` t) === Right (n,t)

819 where t = TL.dropWhile isDigit s

834 where t = TL.dropWhile isDigit s

820t_hexadecimal m s ox =

835t_hexadecimal m s ox =

821− T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) == Right (n,t)

836+ T.hexadecimal (T.concat [p, T.pack (showHex n ""), t]) === Right (n,t)

822 where t = T.dropWhile isHexDigit s

837 where t = T.dropWhile isHexDigit s

823 p = if ox then "0x" else ""

838 p = if ox then "0x" else ""

824 n = getPositive m :: Int

839 n = getPositive m :: Int

825tl_hexadecimal m s ox =

840tl_hexadecimal m s ox =

826− TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) == Right (n,t)

841+ TL.hexadecimal (TL.concat [p, TL.pack (showHex n ""), t]) === Right (n,t)

827 where t = TL.dropWhile isHexDigit s

842 where t = TL.dropWhile isHexDigit s

828 p = if ox then "0x" else ""

843 p = if ox then "0x" else ""

829 n = getPositive m :: Int

844 n = getPositive m :: Int

@@ -867,11 +882,11 @@ tl_write_read_line e m b t = write_read head TL.filter TL.hPutStrLn

867

882

868t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t

883t_dropWord16 m t = dropWord16 m t `T.isSuffixOf` t

869t_takeWord16 m t = takeWord16 m t `T.isPrefixOf` t

884t_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

885+t_take_drop_16 m t = T.append (takeWord16 n t) (dropWord16 n t) === t

871 where n = small m

886 where n = small m

872t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)

887t_use_from t = monadicIO $ assert . (==t) =<< run (useAsPtr t fromPtr)

873

888

874−t_copy t = T.copy t == t

889+t_copy t = T.copy t === t

875

890

876-- Regression tests.

891-- Regression tests.

877s_filter_eq s = S.filter p t == S.streamList (filter p s)

892s_filter_eq s = S.filter p t == S.streamList (filter p s)

@@ -1030,7 +1045,9 @@ tests =

1030 testProperty "tl_toLower_lower" tl_toLower_lower,

1045 testProperty "tl_toLower_lower" tl_toLower_lower,

1031 testProperty "t_toUpper_length" t_toUpper_length,

1046 testProperty "t_toUpper_length" t_toUpper_length,

1032 testProperty "t_toUpper_upper" t_toUpper_upper,

1047 testProperty "t_toUpper_upper" t_toUpper_upper,

1033− testProperty "tl_toUpper_upper" tl_toUpper_upper

1048+ testProperty "tl_toUpper_upper" tl_toUpper_upper,

1049+ testProperty "t_toTitle_title" t_toTitle_title,

1050+ testProperty "t_toTitle_1stNotLower" t_toTitle_1stNotLower

1034 ],

1051 ],

1035

1052

1036 testGroup "justification" [

1053 testGroup "justification" [

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

107

108instance Arbitrary T.Text where

109− arbitrary = T.pack `fmap` arbitrary

109+ arbitrary = T.pack `fmap` string

110 shrink = map T.pack . shrink . T.unpack

111

112instance Arbitrary TL.Text where

tests/text-tests.cabal+18−3

@@ -20,6 +20,11 @@ flag hpc

20 default: False

21 manual: True

23+flag bytestring-builder

24+ description: Depend on the bytestring-builder package for backwards compatibility.

25+ default: False

26+ manual: False

27+

23executable text-tests

28executable text-tests

24 main-is: Tests.hs

29 main-is: Tests.hs

@@ -48,16 +53,21 @@ executable text-tests

48 HUnit >= 1.2,

53 HUnit >= 1.2,

49 QuickCheck >= 2.7,

54 QuickCheck >= 2.7,

50 base == 4.*,

55 base == 4.*,

51− bytestring,

52 deepseq,

56 deepseq,

53 directory,

57 directory,

54− quickcheck-unicode,

58+ quickcheck-unicode >= 1.0.1.0,

55 random,

59 random,

56 test-framework >= 0.4,

60 test-framework >= 0.4,

57 test-framework-hunit >= 0.2,

61 test-framework-hunit >= 0.2,

58 test-framework-quickcheck2 >= 0.2,

62 test-framework-quickcheck2 >= 0.2,

59 text-tests

63 text-tests

65+ if flag(bytestring-builder)

66+ build-depends: bytestring >= 0.9 && < 0.10.4,

67+ bytestring-builder >= 0.10.4

68+ else

69+ build-depends: bytestring >= 0.10.4

70+

61executable text-tests-stdio

71executable text-tests-stdio

62 main-is: Tests/IO.hs

72 main-is: Tests/IO.hs

@@ -137,7 +147,12 @@ library

137 array,

147 array,

138 base == 4.*,

148 base == 4.*,

139 binary,

149 binary,

140− bytestring,

141 deepseq,

150 deepseq,

142 ghc-prim,

151 ghc-prim,

143 integer-gmp

152 integer-gmp

153+

154+ if flag(bytestring-builder)

155+ build-depends: bytestring >= 0.9 && < 0.10.4,

156+ bytestring-builder >= 0.10.4

157+ else

158+ build-depends: bytestring >= 0.10.4

text.cabal+1−1

@@ -180,7 +180,7 @@ test-suite tests

180 deepseq,

181 directory,

182 ghc-prim,

183− quickcheck-unicode,

183+ quickcheck-unicode >= 1.0.1.0,

184 random,

185 test-framework >= 0.4,

186 test-framework-hunit >= 0.2,