text 1.2.0.4 → 1.2.0.5
raw patch · 15 files changed
+272/−116 lines, 15 files
Files
- Data/Text.hs +3/−3
- Data/Text/Encoding/Error.hs +4/−0
- Data/Text/Internal/Fusion.hs +7/−7
- Data/Text/Internal/Fusion/CaseMapping.hs +107/−9
- Data/Text/Internal/Fusion/Common.hs +52/−65
- Data/Text/Internal/Fusion/Types.hs +8/−13
- Data/Text/Lazy.hs +44/−6
- Data/Text/Lazy/Builder/Int.hs +0/−3
- changelog.md +24/−0
- scripts/CaseFolding.hs +1/−1
- scripts/CaseMapping.hs +3/−3
- scripts/SpecialCasing.hs +1/−1
- tests/Tests/Properties.hs +17/−2
- tests/cabal.config +0/−1
- text.cabal +1/−2
Data/Text.hs view
@@ -758,7 +758,7 @@ -- instead of itself. toCaseFold :: Text -> Text toCaseFold t = unstream (S.toCaseFold (stream t))-{-# INLINE [0] toCaseFold #-}+{-# INLINE toCaseFold #-} -- | /O(n)/ Convert a string to lower case, using simple case -- conversion. Subject to fusion.@@ -1535,7 +1535,7 @@ -- equivalent to a pair of 'unpack' operations. zip :: Text -> Text -> [(Char,Char)] zip a b = S.unstreamList $ S.zipWith (,) (stream a) (stream b)-{-# INLINE [0] zip #-}+{-# INLINE zip #-} -- | /O(n)/ 'zipWith' generalises 'zip' by zipping with the function -- given as the first argument, instead of a tupling function.@@ -1543,7 +1543,7 @@ zipWith :: (Char -> Char -> Char) -> Text -> Text -> Text zipWith f t1 t2 = unstream (S.zipWith g (stream t1) (stream t2)) where g a b = safe (f a b)-{-# INLINE [0] zipWith #-}+{-# INLINE zipWith #-} -- | /O(n)/ Breaks a 'Text' up into a list of words, delimited by 'Char's -- representing white space.
Data/Text/Encoding/Error.hs view
@@ -66,6 +66,7 @@ type OnDecodeError = OnError Word8 Char -- | A handler for an encoding error.+{-# DEPRECATED OnEncodeError "This exception is never used in practice, and will be removed." #-} type OnEncodeError = OnError Char Word8 -- | An exception type for representing Unicode encoding errors.@@ -78,6 +79,8 @@ -- under the given encoding, or ran out of input in mid-encode. deriving (Eq, Typeable) +{-# DEPRECATED EncodeError "This constructor is never used, and will be removed." #-}+ showUnicodeException :: UnicodeException -> String showUnicodeException (DecodeError desc (Just w)) = "Cannot decode byte '\\x" ++ showHex w ("': " ++ desc)@@ -107,6 +110,7 @@ lenientDecode _ _ = Just '\xfffd' -- | Throw a 'UnicodeException' if encoding fails.+{-# DEPRECATED strictEncode "This function always throws an exception, and will be removed." #-} strictEncode :: OnEncodeError strictEncode desc c = throw (EncodeError desc c)
Data/Text/Internal/Fusion.hs view
@@ -166,15 +166,15 @@ -- | /O(n)/ Perform the equivalent of 'scanr' over a list, only with -- the input and result reversed. reverseScanr :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char-reverseScanr f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low+reverseScanr f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low where {-# INLINE next #-}- next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)- next (S2 :*: z :*: s) = case next0 s of- Yield x s' -> let !x' = f x z- in Yield x' (S2 :*: x' :*: s')- Skip s' -> Skip (S2 :*: z :*: s')- Done -> Done+ next (Scan1 z s) = Yield z (Scan2 z s)+ next (Scan2 z s) = case next0 s of+ Yield x s' -> let !x' = f x z+ in Yield x' (Scan2 x' s')+ Skip s' -> Skip (Scan2 z s')+ Done -> Done {-# INLINE reverseScanr #-} -- | /O(n)/ Like 'unfoldr', 'unfoldrN' builds a stream from a seed
Data/Text/Internal/Fusion/CaseMapping.hs view
@@ -1,17 +1,17 @@ {-# LANGUAGE Rank2Types #-} -- AUTOMATICALLY GENERATED - DO NOT EDIT--- Generated by scripts/SpecialCasing.hs--- CaseFolding-6.3.0.txt--- Date: 2012-12-20, 22:14:35 GMT [MD]--- SpecialCasing-6.3.0.txt--- Date: 2013-05-08, 13:54:51 GMT [MD]+-- Generated by scripts/CaseMapping.hs+-- CaseFolding-7.0.0.txt+-- Date: 2014-04-09, 20:00:56 GMT [MD]+-- SpecialCasing-7.0.0.txt+-- Date: 2014-03-18, 07:18:02 GMT [MD] module Data.Text.Internal.Fusion.CaseMapping where import Data.Char import Data.Text.Internal.Fusion.Types upperMapping :: forall s. Char -> s -> Step (CC s) Char-{-# INLINE upperMapping #-}+{-# NOINLINE upperMapping #-} -- LATIN SMALL LETTER SHARP S upperMapping '\x00df' s = Yield '\x0053' (CC s '\x0053' '\x0000') -- LATIN SMALL LIGATURE FF@@ -218,12 +218,12 @@ upperMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0399') upperMapping c s = Yield (toUpper c) (CC s '\0' '\0') lowerMapping :: forall s. Char -> s -> Step (CC s) Char-{-# INLINE lowerMapping #-}+{-# NOINLINE lowerMapping #-} -- LATIN CAPITAL LETTER I WITH DOT ABOVE lowerMapping '\x0130' s = Yield '\x0069' (CC s '\x0307' '\x0000') lowerMapping c s = Yield (toLower c) (CC s '\0' '\0') titleMapping :: forall s. Char -> s -> Step (CC s) Char-{-# INLINE titleMapping #-}+{-# NOINLINE titleMapping #-} -- LATIN SMALL LETTER SHARP S titleMapping '\x00df' s = Yield '\x0053' (CC s '\x0073' '\x0000') -- LATIN SMALL LIGATURE FF@@ -322,7 +322,7 @@ titleMapping '\x1ff7' s = Yield '\x03a9' (CC s '\x0342' '\x0345') titleMapping c s = Yield (toTitle c) (CC s '\0' '\0') foldMapping :: forall s. Char -> s -> Step (CC s) Char-{-# INLINE foldMapping #-}+{-# NOINLINE foldMapping #-} -- MICRO SIGN foldMapping '\x00b5' s = Yield '\x03bc' (CC s '\x0000' '\x0000') -- LATIN SMALL LETTER SHARP S@@ -337,6 +337,8 @@ foldMapping '\x01f0' s = Yield '\x006a' (CC s '\x030c' '\x0000') -- COMBINING GREEK YPOGEGRAMMENI foldMapping '\x0345' s = Yield '\x03b9' (CC s '\x0000' '\x0000')+-- GREEK CAPITAL LETTER YOT+foldMapping '\x037f' s = Yield '\x03f3' (CC s '\x0000' '\x0000') -- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS foldMapping '\x0390' s = Yield '\x03b9' (CC s '\x0308' '\x0301') -- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS@@ -357,6 +359,14 @@ foldMapping '\x03f1' s = Yield '\x03c1' (CC s '\x0000' '\x0000') -- GREEK LUNATE EPSILON SYMBOL foldMapping '\x03f5' s = Yield '\x03b5' (CC s '\x0000' '\x0000')+-- CYRILLIC CAPITAL LETTER EN WITH LEFT HOOK+foldMapping '\x0528' s = Yield '\x0529' (CC s '\x0000' '\x0000')+-- CYRILLIC CAPITAL LETTER DZZHE+foldMapping '\x052a' s = Yield '\x052b' (CC s '\x0000' '\x0000')+-- CYRILLIC CAPITAL LETTER DCHE+foldMapping '\x052c' s = Yield '\x052d' (CC s '\x0000' '\x0000')+-- CYRILLIC CAPITAL LETTER EL WITH DESCENDER+foldMapping '\x052e' s = Yield '\x052f' (CC s '\x0000' '\x0000') -- ARMENIAN SMALL LIGATURE ECH YIWN foldMapping '\x0587' s = Yield '\x0565' (CC s '\x0582' '\x0000') -- GEORGIAN CAPITAL LETTER YN@@ -539,10 +549,34 @@ foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000') -- COPTIC CAPITAL LETTER BOHAIRIC KHEI foldMapping '\x2cf2' s = Yield '\x2cf3' (CC s '\x0000' '\x0000')+-- CYRILLIC CAPITAL LETTER DOUBLE O+foldMapping '\xa698' s = Yield '\xa699' (CC s '\x0000' '\x0000')+-- CYRILLIC CAPITAL LETTER CROSSED O+foldMapping '\xa69a' s = Yield '\xa69b' (CC s '\x0000' '\x0000') -- LATIN CAPITAL LETTER C WITH BAR foldMapping '\xa792' s = Yield '\xa793' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER B WITH FLOURISH+foldMapping '\xa796' s = Yield '\xa797' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER F WITH STROKE+foldMapping '\xa798' s = Yield '\xa799' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER VOLAPUK AE+foldMapping '\xa79a' s = Yield '\xa79b' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER VOLAPUK OE+foldMapping '\xa79c' s = Yield '\xa79d' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER VOLAPUK UE+foldMapping '\xa79e' s = Yield '\xa79f' (CC s '\x0000' '\x0000') -- LATIN CAPITAL LETTER H WITH HOOK foldMapping '\xa7aa' s = Yield '\x0266' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER REVERSED OPEN E+foldMapping '\xa7ab' s = Yield '\x025c' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER SCRIPT G+foldMapping '\xa7ac' s = Yield '\x0261' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER L WITH BELT+foldMapping '\xa7ad' s = Yield '\x026c' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER TURNED K+foldMapping '\xa7b0' s = Yield '\x029e' (CC s '\x0000' '\x0000')+-- LATIN CAPITAL LETTER TURNED T+foldMapping '\xa7b1' s = Yield '\x0287' (CC s '\x0000' '\x0000') -- LATIN SMALL LIGATURE FF foldMapping '\xfb00' s = Yield '\x0066' (CC s '\x0066' '\x0000') -- LATIN SMALL LIGATURE FI@@ -567,4 +601,68 @@ foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000') -- ARMENIAN SMALL LIGATURE MEN XEH foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000')+-- WARANG CITI CAPITAL LETTER NGAA+foldMapping '\x118a0' s = Yield '\x118c0' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER A+foldMapping '\x118a1' s = Yield '\x118c1' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER WI+foldMapping '\x118a2' s = Yield '\x118c2' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER YU+foldMapping '\x118a3' s = Yield '\x118c3' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER YA+foldMapping '\x118a4' s = Yield '\x118c4' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER YO+foldMapping '\x118a5' s = Yield '\x118c5' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER II+foldMapping '\x118a6' s = Yield '\x118c6' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER UU+foldMapping '\x118a7' s = Yield '\x118c7' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER E+foldMapping '\x118a8' s = Yield '\x118c8' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER O+foldMapping '\x118a9' s = Yield '\x118c9' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER ANG+foldMapping '\x118aa' s = Yield '\x118ca' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER GA+foldMapping '\x118ab' s = Yield '\x118cb' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER KO+foldMapping '\x118ac' s = Yield '\x118cc' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER ENY+foldMapping '\x118ad' s = Yield '\x118cd' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER YUJ+foldMapping '\x118ae' s = Yield '\x118ce' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER UC+foldMapping '\x118af' s = Yield '\x118cf' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER ENN+foldMapping '\x118b0' s = Yield '\x118d0' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER ODD+foldMapping '\x118b1' s = Yield '\x118d1' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER TTE+foldMapping '\x118b2' s = Yield '\x118d2' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER NUNG+foldMapping '\x118b3' s = Yield '\x118d3' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER DA+foldMapping '\x118b4' s = Yield '\x118d4' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER AT+foldMapping '\x118b5' s = Yield '\x118d5' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER AM+foldMapping '\x118b6' s = Yield '\x118d6' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER BU+foldMapping '\x118b7' s = Yield '\x118d7' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER PU+foldMapping '\x118b8' s = Yield '\x118d8' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER HIYO+foldMapping '\x118b9' s = Yield '\x118d9' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER HOLO+foldMapping '\x118ba' s = Yield '\x118da' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER HORR+foldMapping '\x118bb' s = Yield '\x118db' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER HAR+foldMapping '\x118bc' s = Yield '\x118dc' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER SSUU+foldMapping '\x118bd' s = Yield '\x118dd' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER SII+foldMapping '\x118be' s = Yield '\x118de' (CC s '\x0000' '\x0000')+-- WARANG CITI CAPITAL LETTER VIYO+foldMapping '\x118bf' s = Yield '\x118df' (CC s '\x0000' '\x0000') foldMapping c s = Yield (toLower c) (CC s '\0' '\0')
Data/Text/Internal/Fusion/Common.hs view
@@ -71,9 +71,6 @@ -- ** Scans , scanl - -- ** Accumulating maps- -- , mapAccumL- -- ** Generation and unfolding , replicateCharI , replicateI@@ -187,6 +184,9 @@ Yield x s' -> Yield x (C0 s') {-# INLINE [0] cons #-} +data Snoc a = N+ | J !a+ -- | /O(n)/ Adds a character to the end of a stream. snoc :: Stream Char -> Char -> Stream Char snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len+1)@@ -473,17 +473,20 @@ next (CC s a b) = Yield a (CC s b '\0') {-# INLINE [0] toTitle #-} +data Justify i s = Just1 !i !s+ | Just2 !i !s+ justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char justifyLeftI k c (Stream next0 s0 len) =- Stream next (s0 :*: S1 :*: 0) (larger (fromIntegral k) len)+ Stream next (Just1 0 s0) (larger (fromIntegral k) len) where- next (s :*: S1 :*: n) =+ next (Just1 n s) = case next0 s of- Done -> next (s :*: S2 :*: n)- Skip s' -> Skip (s' :*: S1 :*: n)- Yield x s' -> Yield x (s' :*: S1 :*: n+1)- next (s :*: S2 :*: n)- | n < k = Yield c (s :*: S2 :*: n+1)+ Done -> next (Just2 n s)+ Skip s' -> Skip (Just1 n s')+ Yield x s' -> Yield x (Just1 (n+1) s')+ next (Just2 n s)+ | n < k = Yield c (Just2 (n+1) s) | otherwise = Done {-# INLINE next #-} {-# INLINE [0] justifyLeftI #-}@@ -651,41 +654,18 @@ -- * Building streams scanl :: (Char -> Char -> Char) -> Char -> Stream Char -> Stream Char-scanl f z0 (Stream next0 s0 len) = Stream next (S1 :*: z0 :*: s0) (len+1) -- HINT maybe too low+scanl f z0 (Stream next0 s0 len) = Stream next (Scan1 z0 s0) (len+1) -- HINT maybe too low where {-# INLINE next #-}- next (S1 :*: z :*: s) = Yield z (S2 :*: z :*: s)- next (S2 :*: z :*: s) = case next0 s of- Yield x s' -> let !x' = f z x- in Yield x' (S2 :*: x' :*: s')- Skip s' -> Skip (S2 :*: z :*: s')- Done -> Done+ next (Scan1 z s) = Yield z (Scan2 z s)+ next (Scan2 z s) = case next0 s of+ Yield x s' -> let !x' = f z x+ in Yield x' (Scan2 x' s')+ Skip s' -> Skip (Scan2 z s')+ Done -> Done {-# INLINE [0] scanl #-} -- -------------------------------------------------------------------------------- ** Accumulating maps--{---- | /O(n)/ Like a combination of 'map' and 'foldl'. Applies a--- function to each element of a stream, passing an accumulating--- parameter from left to right, and returns a final stream.------ /Note/: Unlike the version over lists, this function does not--- return a final value for the accumulator, because the nature of--- streams precludes it.-mapAccumL :: (a -> b -> (a,b)) -> a -> Stream b -> Stream b-mapAccumL f z0 (Stream next0 s0 len) = Stream next (s0 :*: z0) len -- HINT depends on f- where- {-# INLINE next #-}- next (s :*: z) = case next0 s of- Yield x s' -> let (z',y) = f z x- in Yield y (s' :*: z')- Skip s' -> Skip (s' :*: z)- Done -> Done-{-# INLINE [0] mapAccumL #-}--}---- ----------------------------------------------------------------------------- -- ** Generating and unfolding streams replicateCharI :: Integral a => a -> Char -> Stream Char@@ -759,24 +739,27 @@ Yield x s' -> Yield x ((n-1) :*: s') {-# INLINE [0] take #-} +data Drop a s = NS !s+ | JS !a !s+ -- | /O(n)/ drop n, applied to a stream, returns the suffix of the -- stream after the first @n@ characters, or the empty stream if @n@ -- is greater than the length of the stream. drop :: Integral a => a -> Stream Char -> Stream Char drop n0 (Stream next0 s0 len) =- Stream next (J n0 :*: s0) (len - fromIntegral (max 0 n0))+ Stream next (JS n0 s0) (len - fromIntegral (max 0 n0)) where {-# INLINE next #-}- next (J n :*: s)- | n <= 0 = Skip (N :*: s)+ next (JS n s)+ | n <= 0 = Skip (NS s) | otherwise = case next0 s of Done -> Done- Skip s' -> Skip (J n :*: s')- Yield _ s' -> Skip (J (n-1) :*: s')- next (N :*: s) = case next0 s of+ Skip s' -> Skip (JS n s')+ Yield _ s' -> Skip (JS (n-1) s')+ next (NS s) = case next0 s of Done -> Done- Skip s' -> Skip (N :*: s')- Yield x s' -> Yield x (N :*: s')+ Skip s' -> Skip (NS s')+ Yield x s' -> Yield x (NS s') {-# INLINE [0] drop #-} -- | takeWhile, applied to a predicate @p@ and a stream, returns the@@ -794,18 +777,18 @@ -- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs. dropWhile :: (Char -> Bool) -> Stream Char -> Stream Char-dropWhile p (Stream next0 s0 len) = Stream next (S1 :*: s0) len -- HINT maybe too high+dropWhile p (Stream next0 s0 len) = Stream next (L s0) len -- HINT maybe too high where {-# INLINE next #-}- next (S1 :*: s) = case next0 s of+ next (L s) = case next0 s of Done -> Done- Skip s' -> Skip (S1 :*: s')- Yield x s' | p x -> Skip (S1 :*: s')- | otherwise -> Yield x (S2 :*: s')- next (S2 :*: s) = case next0 s of+ Skip s' -> Skip (L s')+ Yield x s' | p x -> Skip (L s')+ | otherwise -> Yield x (R s')+ next (R s) = case next0 s of Done -> Done- Skip s' -> Skip (S2 :*: s')- Yield x s' -> Yield x (S2 :*: s')+ Skip s' -> Skip (R s')+ Yield x s' -> Yield x (R s') {-# INLINE [0] dropWhile #-} -- | /O(n)/ The 'isPrefixOf' function takes two 'Stream's and returns@@ -912,21 +895,25 @@ ------------------------------------------------------------------------------- -- * Zipping +-- | Strict triple.+data Zip a b m = Z1 !a !b+ | Z2 !a !b !m+ -- | zipWith generalises 'zip' by zipping with the function given as -- the first argument, instead of a tupling function. zipWith :: (a -> a -> b) -> Stream a -> Stream a -> Stream b zipWith f (Stream next0 sa0 len1) (Stream next1 sb0 len2) =- Stream next (sa0 :*: sb0 :*: N) (smaller len1 len2)+ Stream next (Z1 sa0 sb0) (smaller len1 len2) where- next (sa :*: sb :*: N) = case next0 sa of- Done -> Done- Skip sa' -> Skip (sa' :*: sb :*: N)- Yield a sa' -> Skip (sa' :*: sb :*: J a)+ next (Z1 sa sb) = case next0 sa of+ Done -> Done+ Skip sa' -> Skip (Z1 sa' sb)+ Yield a sa' -> Skip (Z2 sa' sb a) - next (sa' :*: sb :*: J a) = case next1 sb of- Done -> Done- Skip sb' -> Skip (sa' :*: sb' :*: J a)- Yield b sb' -> Yield (f a b) (sa' :*: sb' :*: N)+ next (Z2 sa' sb a) = case next1 sb of+ Done -> Done+ Skip sb' -> Skip (Z2 sa' sb' a)+ Yield b sb' -> Yield (f a b) (Z1 sa' sb') {-# INLINE [0] zipWith #-} -- | /O(n)/ The 'countCharI' function returns the number of times the
Data/Text/Internal/Fusion/Types.hs view
@@ -20,13 +20,11 @@ module Data.Text.Internal.Fusion.Types ( CC(..)- , M(..)- , M8 , PairS(..)+ , Scan(..) , RS(..) , Step(..) , Stream(..)- , Switch(..) , empty ) where @@ -36,26 +34,23 @@ -- | Specialised tuple for case conversion. data CC s = CC !s {-# UNPACK #-} !Char {-# UNPACK #-} !Char --- | Specialised, strict Maybe-like type.-data M a = N- | J !a--type M8 = M Word8---- Restreaming state.+-- | Restreaming state. data RS s = RS0 !s | RS1 !s {-# UNPACK #-} !Word8 | RS2 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 | RS3 !s {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 -infixl 2 :*:+-- | Strict pair. data PairS a b = !a :*: !b -- deriving (Eq, Ord, Show)+infixl 2 :*: --- | Allow a function over a stream to switch between two states.-data Switch = S1 | S2+-- | An intermediate result in a scan.+data Scan s = Scan1 {-# UNPACK #-} !Char !s+ | Scan2 {-# UNPACK #-} !Char !s +-- | Intermediate result in a processing pipeline. data Step s a = Done | Skip !s | Yield !a !s
Data/Text/Lazy.hs view
@@ -125,7 +125,10 @@ , mapAccumR -- ** Generation and unfolding+ , repeat , replicate+ , cycle+ , iterate , unfoldr , unfoldrN @@ -207,8 +210,8 @@ import Data.Int (Int64) import qualified Data.List as L import Data.Char (isSpace)-import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf))-import Data.Data (mkNoRepType)+import Data.Data (Data(gfoldl, toConstr, gunfold, dataTypeOf), constrIndex,+ Constr, mkConstr, DataType, mkDataType, Fixity(Prefix)) import Data.Monoid (Monoid(..)) import Data.String (IsString(..)) import qualified Data.Text as T@@ -218,7 +221,8 @@ import qualified Data.Text.Internal.Lazy.Fusion as S import Data.Text.Internal.Fusion.Types (PairS(..)) import Data.Text.Internal.Lazy.Fusion (stream, unstream)-import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks, foldrChunks)+import Data.Text.Internal.Lazy (Text(..), chunk, empty, foldlChunks,+ foldrChunks, smallChunkSize) import Data.Text.Internal (firstf, safe, text) import qualified Data.Text.Internal.Functions as F import Data.Text.Internal.Lazy.Search (indices)@@ -349,12 +353,25 @@ rnf (Chunk _ ts) = rnf ts #endif +-- | This instance preserves data abstraction at the cost of inefficiency.+-- We omit reflection services for the sake of data abstraction.+--+-- This instance was created by copying the updated behavior of+-- @"Data.Text".@'Data.Text.Text' instance Data Text where gfoldl f z txt = z pack `f` (unpack txt)- toConstr _ = error "Data.Text.Lazy.Text.toConstr"- gunfold _ _ = error "Data.Text.Lazy.Text.gunfold"- dataTypeOf _ = mkNoRepType "Data.Text.Lazy.Text"+ toConstr _ = packConstr+ gunfold k z c = case constrIndex c of+ 1 -> k (z pack)+ _ -> error "Data.Text.Lazy.Text.gunfold"+ dataTypeOf _ = textDataType +packConstr :: Constr+packConstr = mkConstr textDataType "pack" [] Prefix++textDataType :: DataType+textDataType = mkDataType "Data.Text.Lazy.Text" [packConstr]+ -- | /O(n)/ Convert a 'String' into a 'Text'. -- -- Subject to fusion. Performs replacement on invalid scalar values.@@ -918,6 +935,12 @@ go z Empty = (z, Empty) {-# INLINE mapAccumR #-} +-- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every+-- element.+repeat :: Char -> Text+repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t+ in t+ -- | /O(n*m)/ 'replicate' @n@ @t@ is a 'Text' consisting of the input -- @t@ repeated @n@ times. replicate :: Int64 -> Text -> Text@@ -928,6 +951,21 @@ where rep !i | i >= n = [] | otherwise = t : rep (i+1) {-# INLINE [1] replicate #-}++-- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or+-- equivalently, the infinite repetition of the original 'Text'.+cycle :: Text -> Text+cycle Empty = emptyError "cycle"+cycle t = let t' = foldrChunks Chunk t' t+ in t'++-- | @'iterate' f x@ returns an infinite 'Text' of repeated applications+-- of @f@ to @x@:+-- +-- > iterate f x == [x, f x, f (f x), ...]+iterate :: (Char -> Char) -> Char -> Text+iterate f c = let t c' = Chunk (T.singleton c') (t (f c'))+ in t c -- | /O(n)/ 'replicateChar' @n@ @c@ is a 'Text' of length @n@ with @c@ the -- value of every element. Subject to fusion.
Data/Text/Lazy/Builder/Int.hs view
@@ -200,9 +200,6 @@ #ifdef INTEGER_GMP integer 10 (S# i#) = decimal (I# i#) integer 16 (S# i#) = hexadecimal (I# i#)-#else-integer 10 i = decimal i-integer 16 i = hexadecimal i #endif integer base i | i < 0 = singleton '-' <> go (-i)
changelog.md view
@@ -1,3 +1,27 @@+1.2.0.5++* Feature parity: repeat, cycle, iterate are now implemented for lazy+ Text, and the Data instance is more complete++* Build speed: an inliner space explosion has been fixed with toCaseFold++* Bug fix: encoding Int to a Builder would infinite-loop if the+ integer-simple package was used++* Deprecation: OnEncodeError and EncodeError are deprecated, as they+ are never used++* Internals: some types that are used internally in fusion-related+ functions have moved around, been renamed, or been deleted (we don't+ bump the major version if .Internal modules change)++* Spec compliance: toCaseFold now follows the Unicode 7.0 spec+ (updated from 6.3)++1.2.0.4++* Fixed an incompatibility with base < 4.5+ 1.2.0.3 * Update formatRealFloat to correspond to the definition in versions
scripts/CaseFolding.hs view
@@ -37,7 +37,7 @@ mapCF (CF _ ms) = typ ++ (map nice . filter p $ ms) ++ [last] where typ = ["foldMapping :: forall s. Char -> s -> Step (CC s) Char"- ,"{-# INLINE foldMapping #-}"]+ ,"{-# NOINLINE foldMapping #-}"] last = "foldMapping c s = Yield (toLower c) (CC s '\\0' '\\0')" nice c = "-- " ++ name c ++ "\n" ++ "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
scripts/CaseMapping.hs view
@@ -8,7 +8,7 @@ main = do args <- getArgs let oname = case args of- [] -> "../Data/Text/Fusion/CaseMapping.hs"+ [] -> "../Data/Text/Internal/Fusion/CaseMapping.hs" [o] -> o psc <- parseSC "SpecialCasing.txt" pcf <- parseCF "CaseFolding.txt"@@ -24,10 +24,10 @@ mapM_ (hPutStrLn h) $ ["{-# LANGUAGE Rank2Types #-}" ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"- ,"-- Generated by scripts/SpecialCasing.hs"] +++ ,"-- Generated by scripts/CaseMapping.hs"] ++ comments ++ [""- ,"module Data.Text.Fusion.CaseMapping where"+ ,"module Data.Text.Internal.Fusion.CaseMapping where" ,"import Data.Char" ,"import Data.Text.Internal.Fusion.Types" ,""]
scripts/SpecialCasing.hs view
@@ -43,7 +43,7 @@ typ ++ (map nice . filter p $ ms) ++ [last] where typ = [which ++ "Mapping :: forall s. Char -> s -> Step (CC s) Char"- ,"{-# INLINE " ++ which ++ "Mapping #-}"]+ ,"{-# NOINLINE " ++ which ++ "Mapping #-}"] last = which ++ "Mapping c s = Yield (to" ++ ucFirst which ++ " c) (CC s '\\0' '\\0')" nice c = "-- " ++ name c ++ "\n" ++ which ++ "Mapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (CC s " ++ y ++ " " ++ z ++ ")"
tests/Tests/Properties.hs view
@@ -14,7 +14,7 @@ import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isUpper, ord) import Data.Int (Int8, Int16, Int32, Int64) import Data.Monoid (Monoid(..))-import Data.String (fromString)+import Data.String (IsString(fromString)) import Data.Text.Encoding.Error import Data.Text.Foreign import Data.Text.Internal.Encoding.Utf8@@ -440,6 +440,10 @@ tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z) where _types = f :: Int -> Char -> (Int,Char) +tl_repeat n = (L.take m . L.repeat) `eq`+ (unpackS . TL.take (fromIntegral m) . TL.repeat)+ where m = fromIntegral (n :: Word8)+ replicate n l = concat (L.replicate n l) s_replicate n = replicate m `eq`@@ -451,6 +455,14 @@ (unpackS . TL.replicate (fromIntegral m) . packS) where m = fromIntegral (n :: Word8) +tl_cycle n = (L.take m . L.cycle) `eq`+ (unpackS . TL.take (fromIntegral m) . TL.cycle . packS)+ where m = fromIntegral (n :: Word8)++tl_iterate f n = (L.take m . L.iterate f) `eq`+ (unpackS . TL.take (fromIntegral m) . TL.iterate f)+ where m = fromIntegral (n :: Word8)+ unf :: Int -> Char -> Maybe (Char, Char) unf n c | fromEnum c * 100 > n = Nothing | otherwise = Just (c, succ c)@@ -812,7 +824,7 @@ p = if ox then "0x" else "" n = getPositive m :: Int -isFloaty c = c `elem` "+-.0123456789eE"+isFloaty c = c `elem` ("+-.0123456789eE" :: String) t_read_rational p tol (n::Double) s = case p (T.pack (show n) `T.append` t) of@@ -1094,9 +1106,12 @@ ], testGroup "unfolds" [+ testProperty "tl_repeat" tl_repeat, testProperty "s_replicate" s_replicate, testProperty "t_replicate" t_replicate, testProperty "tl_replicate" tl_replicate,+ testProperty "tl_cycle" tl_cycle,+ testProperty "tl_iterate" tl_iterate, testProperty "t_unfoldr" t_unfoldr, testProperty "tl_unfoldr" tl_unfoldr, testProperty "t_unfoldrN" t_unfoldrN,
tests/cabal.config view
@@ -1,7 +1,6 @@ -- These flags help to speed up building the test suite. documentation: False-executable-profiling: False executable-stripping: False flags: developer library-profiling: False
text.cabal view
@@ -1,5 +1,5 @@ name: text-version: 1.2.0.4+version: 1.2.0.5 homepage: https://github.com/bos/text bug-reports: https://github.com/bos/text/issues synopsis: An efficient packed Unicode text type.@@ -136,7 +136,6 @@ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 if flag(developer) ghc-prof-options: -auto-all- ghc-options: -Werror cpp-options: -DASSERTS if flag(integer-simple)