548ca22 · text · git.iko.soy

git.iko.soy/text

on master help sign in

Merge pull request #200

548ca22Herbert Valerio Riedel9 years ago

Data/Text.hs+15

compare with master

unifiedsplit

@@ -34,6 +34,7 @@

34-- with Unicode text (including normalization, regular expressions,

35-- non-standard encodings, text breaking, and locales), see

36-- <http://hackage.haskell.org/package/text-icu the text-icu package >.

37+--

38module Data.Text

39module Data.Text

39 (

40 (

@@ -43,6 +44,9 @@ module Data.Text

43 -- * Acceptable data

44 -- * Acceptable data

44 -- $replacement

45 -- $replacement

47+ -- * Definition of character

48+ -- $character_definition

49+

46 -- * Fusion

50 -- * Fusion

47 -- $fusion

51 -- $fusion

@@ -247,6 +251,17 @@ import qualified GHC.Exts as Exts

247import Text.Printf (PrintfArg, formatArg, formatString)

251import Text.Printf (PrintfArg, formatArg, formatString)

248#endif

252#endif

249

253

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+

250-- $strict

265-- $strict

251--

266--

252-- This package provides both strict and lazy 'Text' types. The

267-- This package provides both strict and lazy 'Text' types. The

Data/Text/Internal/Fusion/Common.hs+28−22

@@ -1,4 +1,4 @@

1−{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-}

1+{-# LANGUAGE PatternGuards, BangPatterns, MagicHash, Rank2Types #-}

2-- |

3-- Module : Data.Text.Internal.Fusion.Common

4-- Copyright : (c) Bryan O'Sullivan 2009, 2012

@@ -117,7 +117,7 @@ import GHC.Prim (Addr#, chr#, indexCharOffAddr#, ord#)

117import GHC.Types (Char(..), Int(..))

118

119singleton :: Char -> Stream Char

120−singleton c = Stream next False 1

120+singleton c = Stream next False (codePointsSize 1)

121 where next False = Yield c True

122 next True = Done

123{-# INLINE [0] singleton #-}

@@ -175,7 +175,7 @@ data C s = C0 !s

175

176-- | /O(n)/ Adds a character to the front of a Stream Char.

177cons :: 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)

179 where

180 next (C1 s) = Yield w (C0 s)

181 next (C0 s) = case next0 s of

@@ -189,7 +189,7 @@ data Snoc a = N

189

190-- | /O(n)/ Adds a character to the end of a stream.

191snoc :: 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)

193 where

194 next (J xs) = case next0 xs of

195 Done -> Yield w N

@@ -237,7 +237,7 @@ uncons :: Stream Char -> Maybe (Char, Stream Char)

237uncons (Stream next s0 len) = loop_uncons s0

238 where

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

241 Skip s' -> loop_uncons s'

242 Done -> Nothing

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

261-- be non-empty.

262tail :: 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)

264 where

265 next (C0 s) = case next0 s of

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

279-- must be non-empty.

280init :: 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)

282 where

283 next (Init0 s) = case next0 s of

284 Done -> emptyError "init"

@@ -318,11 +318,14 @@ lengthI (Stream next s0 _len) = loop_length 0 s0

318-- greater than the number or if the stream can't possibly be as long

319-- as the number supplied, and hence be more efficient.

320compareLengthI :: Integral a => Stream Char -> a -> Ordering

321−compareLengthI (Stream next s0 len) n =

321+compareLengthI (Stream next s0 len) n

322− case compareSize len (fromIntegral n) of

322+ -- Note that @len@ tracks code units whereas we want to compare the length

323− Just o -> o

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

324− Nothing -> loop_cmp 0 s0

326+ | otherwise = loop_cmp 0 s0

325 where

327 where

328+ n' = codePointsSize $ fromIntegral n

326 loop_cmp !z s = case next s of

329 loop_cmp !z s = case next s of

327 Done -> compare z n

330 Done -> compare z n

328 Skip s' -> loop_cmp z s'

331 Skip s' -> loop_cmp z s'

@@ -368,7 +371,7 @@ data I s = I1 !s

368-- | /O(n)/ Take a character and place it between each of the

371-- | /O(n)/ Take a character and place it between each of the

369-- characters of a 'Stream Char'.

372-- characters of a 'Stream Char'.

370intersperse :: Char -> Stream Char -> Stream Char

373intersperse :: 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)

372 where

375 where

373 next (I1 s) = case next0 s of

376 next (I1 s) = case next0 s of

374 Done -> Done

377 Done -> Done

@@ -393,9 +396,11 @@ intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len

393-- functions may map one input character to two or three output

396-- functions may map one input character to two or three output

394-- characters.

397-- characters.

395

398

399+-- | Map a 'Stream' through the given case-mapping function.

396caseConvert :: (forall s. Char -> s -> Step (CC s) Char)

400caseConvert :: (forall s. Char -> s -> Step (CC s) Char)

397 -> Stream Char -> Stream Char

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

399 where

404 where

400 next (CC s '\0' _) =

405 next (CC s '\0' _) =

401 case next0 s of

406 case next0 s of

@@ -458,7 +463,7 @@ toLower = caseConvert lowerMapping

458-- Fox\" is correctly title cased—but this function will

463-- Fox\" is correctly title cased—but this function will

459-- capitalize /every/ word.

464-- capitalize /every/ word.

460toTitle :: Stream Char -> Stream Char

465toTitle :: 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)

462 where

467 where

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

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

464 case next0 s of

469 case next0 s of

@@ -479,7 +484,7 @@ data Justify i s = Just1 !i !s

479

484

480justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

485justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char

481justifyLeftI k c (Stream next0 s0 len) =

486justifyLeftI k c (Stream next0 s0 len) =

482− Stream next (Just1 0 s0) (larger (fromIntegral k) len)

487+ Stream next (Just1 0 s0) (larger (fromIntegral k * charSize c + len) len)

483 where

488 where

484 next (Just1 n s) =

489 next (Just1 n s) =

485 case next0 s of

490 case next0 s of

@@ -699,7 +704,7 @@ replicateI n (Stream next0 s0 len) =

699-- (a,b), in which case, a is the next Char in the string, and b is

704-- (a,b), in which case, a is the next Char in the string, and b is

700-- the seed value for further production.

705-- the seed value for further production.

701unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char

706unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char

702−unfoldr f s0 = Stream next s0 1 -- HINT maybe too low

707+unfoldr f s0 = Stream next s0 unknownSize

703 where

708 where

704 {-# INLINE next #-}

709 {-# INLINE next #-}

705 next !s = case f s of

710 next !s = case f s of

@@ -713,7 +718,7 @@ unfoldr f s0 = Stream next s0 1 -- HINT maybe too low

713-- 'unfoldr' when the length of the result is known.

718-- 'unfoldr' when the length of the result is known.

714unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char

719unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char

715unfoldrNI n f s0 | n < 0 = empty

720unfoldrNI n f s0 | n < 0 = empty

716− | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high

721+ | otherwise = Stream next (0 :*: s0) (maxSize $ fromIntegral (n*2))

717 where

722 where

718 {-# INLINE next #-}

723 {-# INLINE next #-}

719 next (z :*: s) = case f s of

724 next (z :*: s) = case f s of

@@ -730,7 +735,7 @@ unfoldrNI n f s0 | n < 0 = empty

730-- length of the stream.

735-- length of the stream.

731take :: Integral a => a -> Stream Char -> Stream Char

736take :: Integral a => a -> Stream Char -> Stream Char

732take n0 (Stream next0 s0 len) =

737take n0 (Stream next0 s0 len) =

733− Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0)))

738+ Stream next (n0 :*: s0) (smaller len (codePointsSize $ fromIntegral n0))

734 where

739 where

735 {-# INLINE next #-}

740 {-# INLINE next #-}

736 next (n :*: s) | n <= 0 = Done

741 next (n :*: s) | n <= 0 = Done

@@ -748,7 +753,7 @@ data Drop a s = NS !s

748-- is greater than the length of the stream.

753-- is greater than the length of the stream.

749drop :: Integral a => a -> Stream Char -> Stream Char

754drop :: Integral a => a -> Stream Char -> Stream Char

750drop n0 (Stream next0 s0 len) =

755drop n0 (Stream next0 s0 len) =

751− Stream next (JS n0 s0) (len - fromIntegral (max 0 n0))

756+ Stream next (JS n0 s0) (len - codePointsSize (fromIntegral n0))

752 where

757 where

753 {-# INLINE next #-}

758 {-# INLINE next #-}

754 next (JS n s)

759 next (JS n s)

@@ -766,7 +771,7 @@ drop n0 (Stream next0 s0 len) =

766-- | 'takeWhile', applied to a predicate @p@ and a stream, returns the

771-- | 'takeWhile', applied to a predicate @p@ and a stream, returns the

767-- longest prefix (possibly empty) of elements that satisfy @p@.

772-- longest prefix (possibly empty) of elements that satisfy @p@.

768takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char

773takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char

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

770 where

775 where

771 {-# INLINE next #-}

776 {-# INLINE next #-}

772 next !s = case next0 s of

777 next !s = case next0 s of

@@ -778,7 +783,7 @@ takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

778

783

779-- | @'dropWhile' p xs@ returns the suffix remaining after @'takeWhile' p xs@.

784-- | @'dropWhile' p xs@ returns the suffix remaining after @'takeWhile' p xs@.

780dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

785dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char

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

782 where

787 where

783 {-# INLINE next #-}

788 {-# INLINE next #-}

784 next (L s) = case next0 s of

789 next (L s) = case next0 s of

@@ -857,7 +862,8 @@ indexI (Stream next s0 _len) n0

857-- returns a stream containing those characters that satisfy the

862-- returns a stream containing those characters that satisfy the

858-- predicate.

863-- predicate.

859filter :: (Char -> Bool) -> Stream Char -> Stream Char

864filter :: (Char -> Bool) -> Stream Char -> Stream Char

865+filter p (Stream next0 s0 len) =

860−filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high

866+ Stream next s0 (len - unknownSize) -- HINT maybe too high

861 where

867 where

862 next !s = case next0 s of

868 next !s = case next0 s of

863 Done -> Done

869 Done -> Done

Data/Text/Internal/Fusion/Size.hs+32−6

@@ -19,11 +19,16 @@

19module Data.Text.Internal.Fusion.Size

20 (

21 Size

22− , exactly

22+ -- * Sizes

23 , exactSize

24 , maxSize

25 , betweenSize

26 , unknownSize

27+ , unionSize

28+ , charSize

29+ , codePointsSize

30+ -- * Querying sizes

31+ , exactly

27 , smaller

32 , smaller

28 , larger

33 , larger

29 , upperBound

34 , upperBound

@@ -32,11 +37,13 @@ module Data.Text.Internal.Fusion.Size

32 , isEmpty

37 , isEmpty

33 ) where

38 ) where

40+import Data.Char (ord)

35import Data.Text.Internal (mul)

41import Data.Text.Internal (mul)

36#if defined(ASSERTS)

42#if defined(ASSERTS)

37import Control.Exception (assert)

43import Control.Exception (assert)

38#endif

44#endif

46+-- | A size in UTF-16 code units.

40data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.

47data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size.

41 | Unknown -- ^ Unknown size.

48 | Unknown -- ^ Unknown size.

42 deriving (Eq, Show)

49 deriving (Eq, Show)

@@ -46,6 +53,17 @@ exactly (Between na nb) | na == nb = Just na

46exactly _ = Nothing

53exactly _ = Nothing

47{-# INLINE exactly #-}

54{-# INLINE exactly #-}

56+-- | The 'Size' of the given code point.

57+charSize :: Char -> Size

58+charSize c

59+ | ord c < 0x10000 = exactSize 1

60+ | otherwise = exactSize 2

61+

62+-- | The 'Size' of @n@ code points.

63+codePointsSize :: Int -> Size

64+codePointsSize n = Between n (2*n)

65+{-# INLINE codePointsSize #-}

66+

49exactSize :: Int -> Size

67exactSize :: Int -> Size

50exactSize n =

68exactSize n =

51#if defined(ASSERTS)

69#if defined(ASSERTS)

@@ -71,6 +89,10 @@ betweenSize m n =

71 Between m n

89 Between m n

72{-# INLINE betweenSize #-}

90{-# INLINE betweenSize #-}

92+unionSize :: Size -> Size -> Size

93+unionSize (Between a b) (Between c d) = Between (min a c) (max b d)

94+unionSize _ _ = Unknown

95+

74unknownSize :: Size

96unknownSize :: Size

75unknownSize = Unknown

97unknownSize = Unknown

76{-# INLINE unknownSize #-}

98{-# INLINE unknownSize #-}

@@ -140,11 +162,15 @@ lowerBound _ (Between n _) = n

140lowerBound k _ = k

162lowerBound k _ = k

141{-# INLINE lowerBound #-}

163{-# INLINE lowerBound #-}

142

164

165+-- | Determine the ordering relationship between two 'Size's, or 'Nothing' in

166+-- the indeterminate case.

143−compareSize :: Size -> Int -> Maybe Ordering

167+compareSize :: Size -> Size -> Maybe Ordering

144−compareSize (Between ma mb) n

168+compareSize (Between ma mb) (Between na nb)

145− | mb < n = Just LT

169+ | mb < na = Just LT

146− | ma > n = Just GT

170+ | ma > nb = Just GT

171+ | ma == mb

172+ , ma == na

147− | ma == n && mb == n = Just EQ

173+ , ma == nb = Just EQ

148compareSize _ _ = Nothing

174compareSize _ _ = Nothing

149

175

150

176

Data/Text/Internal/Fusion/Types.hs+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

76-- small or too large.

77--

78−-- The size hint tries to track the UTF-16 code points in a stream,

78+-- The size hint tries to track the UTF-16 code units in a stream,

79−-- but often counts the number of characters instead. It can easily

79+-- but often counts the number of code points instead. It can easily

80-- undercount if, for instance, a transformed stream contains astral

81−-- plane characters (those above 0x10000).

81+-- plane code points (those above 0x10000).

83data Stream a =

84 forall s. Stream

85 (s -> Step s a) -- stepper function

86 !s -- current state

87− !Size -- size hint

87+ !Size -- size hint in code units

89-- | /O(n)/ Determines if two streams are equal.

90eq :: (Eq a) => Stream a -> Stream a -> Bool

tests/Tests/Regressions.hs+11

@@ -72,6 +72,16 @@ mapAccumL_resize = do

72 assertEqual "mapAccumL should correctly size buffers for two-word results"

73 (count * 2) (T.lengthWord16 (snd val))

75+-- See GitHub #197

76+t197 :: IO ()

77+t197 =

78+ assertBool "length (filter (==',') \"0,00\") should be 1" (currencyParser "0,00")

79+ where

80+ currencyParser x = cond == 1

81+ where

82+ cond = length fltr

83+ fltr = filter (== ',') x

84+

75tests :: F.Test

85tests :: F.Test

76tests = F.testGroup "Regressions"

86tests = F.testGroup "Regressions"

77 [ F.testCase "hGetContents_crash" hGetContents_crash

87 [ F.testCase "hGetContents_crash" hGetContents_crash

@@ -79,4 +89,5 @@ tests = F.testGroup "Regressions"

79 , F.testCase "mapAccumL_resize" mapAccumL_resize

89 , F.testCase "mapAccumL_resize" mapAccumL_resize

80 , F.testCase "replicate_crash" replicate_crash

90 , F.testCase "replicate_crash" replicate_crash

81 , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe

91 , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe

92+ , F.testCase "t197" t197

82 ]

93 ]

text.cabal+1−1

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

168 include-dirs: include

169

170 ghc-options:

171− -Wall -threaded -O0 -rtsopts

171+ -Wall -threaded -O1 -rtsopts

172

173 cpp-options:

174 -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE