diff --git a/Data/Text.hs b/Data/Text.hs --- a/Data/Text.hs +++ b/Data/Text.hs @@ -15,7 +15,6 @@ -- -- License : BSD-style -- Maintainer : bos@serpentine.com --- Stability : experimental -- Portability : GHC -- -- A time and space-efficient implementation of Unicode text. @@ -32,8 +31,9 @@ -- -- To use an extended and very rich family of functions for working -- with Unicode text (including normalization, regular expressions, --- non-standard encodings, text breaking, and locales), see --- . +-- non-standard encodings, text breaking, and locales), see the +-- . +-- module Data.Text ( @@ -43,6 +43,9 @@ -- * Acceptable data -- $replacement + -- * Definition of character + -- $character_definition + -- * Fusion -- $fusion @@ -60,6 +63,7 @@ , snoc , append , uncons + , unsnoc , head , last , tail @@ -246,6 +250,18 @@ import Text.Printf (PrintfArg, formatArg, formatString) #endif +-- $character_definition +-- +-- This package uses the term /character/ to denote Unicode /code points/. +-- +-- Note that this is not the same thing as a grapheme (e.g. a +-- composition of code points that form one visual symbol). For +-- instance, consider the grapheme \"ä\". This symbol has two +-- Unicode representations: a single code-point representation +-- @U+00E4@ (the @LATIN SMALL LETTER A WITH DIAERESIS@ code point), +-- and a two code point representation @U+0061@ (the \"@A@\" code +-- point) and @U+0308@ (the @COMBINING DIAERESIS@ code point). + -- $strict -- -- This package provides both strict and lazy 'Text' types. The @@ -334,9 +350,13 @@ readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str] #if MIN_VERSION_base(4,9,0) --- Semigroup orphan instances for older GHCs are provided by --- 'semigroups` package - +-- | Non-orphan 'Semigroup' instance only defined for +-- @base-4.9.0.0@ and later; orphan instances for older GHCs are +-- provided by +-- the [semigroups](http://hackage.haskell.org/package/semigroups) +-- package +-- +-- @since 1.2.2.0 instance Semigroup Text where (<>) = append #endif @@ -354,6 +374,7 @@ fromString = pack #if __GLASGOW_HASKELL__ >= 708 +-- | @since 1.2.0.0 instance Exts.IsList Text where type Item Text = Char fromList = pack @@ -364,6 +385,7 @@ instance NFData Text where rnf !_ = () #endif +-- | @since 1.2.1.0 instance Binary Text where put t = put (encodeUtf8 t) get = do @@ -397,6 +419,8 @@ #if MIN_VERSION_base(4,7,0) -- | Only defined for @base-4.7.0.0@ and later +-- +-- @since 1.2.2.0 instance PrintfArg Text where formatArg txt = formatString $ unpack txt #endif @@ -545,6 +569,19 @@ unstream (S.init (stream t)) = init t #-} +-- | /O(1)/ Returns all but the last character and the last character of a +-- 'Text', or 'Nothing' if empty. +-- +-- @since 1.2.3.0 +unsnoc :: Text -> Maybe (Text, Char) +unsnoc (Text arr off len) + | len <= 0 = Nothing + | n < 0xDC00 || n > 0xDFFF = Just (text arr off (len-1), unsafeChr n) + | otherwise = Just (text arr off (len-2), U16.chr2 n0 n) + where n = A.unsafeIndex arr (off+len-1) + n0 = A.unsafeIndex arr (off+len-2) +{-# INLINE [1] unsnoc #-} + -- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to -- fusion. null :: Text -> Bool @@ -624,8 +661,15 @@ -- ----------------------------------------------------------------------------- -- * Transformations -- | /O(n)/ 'map' @f@ @t@ is the 'Text' obtained by applying @f@ to --- each element of @t@. Subject to fusion. Performs replacement on --- invalid scalar values. +-- each element of @t@. +-- +-- Example: +-- +-- >>> let message = pack "I am not angry. Not at all." +-- >>> T.map (\c -> if c == '.' then '!' else c) message +-- "I am not angry! Not at all!" +-- +-- Subject to fusion. Performs replacement on invalid scalar values. map :: (Char -> Char) -> Text -> Text map f t = unstream (S.map (safe . f) (stream t)) {-# INLINE [1] map #-} @@ -633,18 +677,36 @@ -- | /O(n)/ The 'intercalate' function takes a 'Text' and a list of -- 'Text's and concatenates the list after interspersing the first -- argument between each element of the list. +-- +-- Example: +-- +-- >>> T.intercalate "NI!" ["We", "seek", "the", "Holy", "Grail"] +-- "WeNI!seekNI!theNI!HolyNI!Grail" intercalate :: Text -> [Text] -> Text intercalate t = concat . (F.intersperse t) {-# INLINE intercalate #-} -- | /O(n)/ The 'intersperse' function takes a character and places it --- between the characters of a 'Text'. Subject to fusion. Performs --- replacement on invalid scalar values. +-- between the characters of a 'Text'. +-- +-- Example: +-- +-- >>> T.intersperse '.' "SHIELD" +-- "S.H.I.E.L.D" +-- +-- Subject to fusion. Performs replacement on invalid scalar values. intersperse :: Char -> Text -> Text intersperse c t = unstream (S.intersperse (safe c) (stream t)) {-# INLINE intersperse #-} --- | /O(n)/ Reverse the characters of a string. Subject to fusion. +-- | /O(n)/ Reverse the characters of a string. +-- +-- Example: +-- +-- >>> T.reverse "desrever" +-- "reversed" +-- +-- Subject to fusion. reverse :: Text -> Text reverse t = S.reverse (stream t) {-# INLINE reverse #-} @@ -663,12 +725,14 @@ -- @needle@ occurs in @replacement@, that occurrence will /not/ itself -- be replaced recursively: -- --- > replace "oo" "foo" "oo" == "foo" +-- >>> replace "oo" "foo" "oo" +-- "foo" -- -- In cases where several instances of @needle@ overlap, only the -- first one will be replaced: -- --- > replace "ofo" "bar" "ofofo" == "barfo" +-- >>> replace "ofo" "bar" "ofofo" +-- "barfo" -- -- In (unlikely) bad cases, this function's time complexity degrades -- towards /O(n*m)/. @@ -782,6 +846,8 @@ -- guides disagree on whether the book name \"The Hill of the Red -- Fox\" is correctly title cased—but this function will -- capitalize /every/ word. +-- +-- @since 1.0.0.0 toTitle :: Text -> Text toTitle t = unstream (S.toTitle (stream t)) {-# INLINE toTitle #-} @@ -792,8 +858,11 @@ -- -- Examples: -- --- > justifyLeft 7 'x' "foo" == "fooxxxx" --- > justifyLeft 3 'x' "foobar" == "foobar" +-- >>> justifyLeft 7 'x' "foo" +-- "fooxxxx" +-- +-- >>> justifyLeft 3 'x' "foobar" +-- "foobar" justifyLeft :: Int -> Char -> Text -> Text justifyLeft k c t | len >= k = t @@ -814,8 +883,11 @@ -- -- Examples: -- --- > justifyRight 7 'x' "bar" == "xxxxbar" --- > justifyRight 3 'x' "foobar" == "foobar" +-- >>> justifyRight 7 'x' "bar" +-- "xxxxbar" +-- +-- >>> justifyRight 3 'x' "foobar" +-- "foobar" justifyRight :: Int -> Char -> Text -> Text justifyRight k c t | len >= k = t @@ -829,7 +901,8 @@ -- -- Examples: -- --- > center 8 'x' "HS" = "xxxHSxxx" +-- >>> center 8 'x' "HS" +-- "xxxHSxxx" center :: Int -> Char -> Text -> Text center k c t | len >= k = t @@ -844,6 +917,14 @@ -- of its 'Text' argument. Note that this function uses 'pack', -- 'unpack', and the list version of transpose, and is thus not very -- efficient. +-- +-- Examples: +-- +-- >>> transpose ["green","orange"] +-- ["go","rr","ea","en","ng","e"] +-- +-- >>> transpose ["blue","red"] +-- ["br","le","ud","e"] transpose :: [Text] -> [Text] transpose ts = P.map pack (L.transpose (P.map unpack ts)) @@ -1088,7 +1169,10 @@ -- -- Examples: -- --- > takeEnd 3 "foobar" == "bar" +-- >>> takeEnd 3 "foobar" +-- "bar" +-- +-- @since 1.1.1.0 takeEnd :: Int -> Text -> Text takeEnd n t@(Text arr off len) | n <= 0 = empty @@ -1127,7 +1211,10 @@ -- -- Examples: -- --- > dropEnd 3 "foobar" == "foo" +-- >>> dropEnd 3 "foobar" +-- "foo" +-- +-- @since 1.1.1.0 dropEnd :: Int -> Text -> Text dropEnd n t@(Text arr off len) | n <= 0 = t @@ -1157,7 +1244,10 @@ -- satisfy @p@. Subject to fusion. -- Examples: -- --- > takeWhileEnd (=='o') "foo" == "oo" +-- >>> takeWhileEnd (=='o') "foo" +-- "oo" +-- +-- @since 1.2.2.0 takeWhileEnd :: (Char -> Bool) -> Text -> Text takeWhileEnd p t@(Text arr off len) = loop (len-1) len where loop !i !l | l <= 0 = t @@ -1196,7 +1286,8 @@ -- -- Examples: -- --- > dropWhileEnd (=='.') "foo..." == "foo" +-- >>> dropWhileEnd (=='.') "foo..." +-- "foo" dropWhileEnd :: (Char -> Bool) -> Text -> Text dropWhileEnd p t@(Text arr off len) = loop (len-1) len where loop !i !l | l <= 0 = empty @@ -1314,10 +1405,15 @@ -- -- Examples: -- --- > splitOn "\r\n" "a\r\nb\r\nd\r\ne" == ["a","b","d","e"] --- > splitOn "aaa" "aaaXaaaXaaaXaaa" == ["","X","X","X",""] --- > splitOn "x" "x" == ["",""] +-- >>> splitOn "\r\n" "a\r\nb\r\nd\r\ne" +-- ["a","b","d","e"] -- +-- >>> splitOn "aaa" "aaaXaaaXaaaXaaa" +-- ["","X","X","X",""] +-- +-- >>> splitOn "x" "x" +-- ["",""] +-- -- and -- -- > intercalate s . splitOn s == id @@ -1352,8 +1448,11 @@ -- resulting components do not contain the separators. Two adjacent -- separators result in an empty component in the output. eg. -- --- > split (=='a') "aabbaca" == ["","","bb","c",""] --- > split (=='a') "" == [""] +-- >>> split (=='a') "aabbaca" +-- ["","","bb","c",""] +-- +-- >>> split (=='a') "" +-- [""] split :: (Char -> Bool) -> Text -> [Text] split _ t@(Text _off _arr 0) = [t] split p t = loop t @@ -1366,8 +1465,11 @@ -- element may be shorter than the other chunks, depending on the -- length of the input. Examples: -- --- > chunksOf 3 "foobarbaz" == ["foo","bar","baz"] --- > chunksOf 4 "haskell.org" == ["hask","ell.","org"] +-- >>> chunksOf 3 "foobarbaz" +-- ["foo","bar","baz"] +-- +-- >>> chunksOf 4 "haskell.org" +-- ["hask","ell.","org"] chunksOf :: Int -> Text -> [Text] chunksOf k = go where @@ -1412,9 +1514,12 @@ -- -- Examples: -- --- > breakOn "::" "a::b::c" ==> ("a", "::b::c") --- > breakOn "/" "foobar" ==> ("foobar", "") +-- >>> breakOn "::" "a::b::c" +-- ("a","::b::c") -- +-- >>> breakOn "/" "foobar" +-- ("foobar","") +-- -- Laws: -- -- > append prefix match == haystack @@ -1441,7 +1546,8 @@ -- up to and including the last match of @needle@. The second is the -- remainder of @haystack@, following the match. -- --- > breakOnEnd "::" "a::b::c" ==> ("a::b::", "c") +-- >>> breakOnEnd "::" "a::b::c" +-- ("a::b::","c") breakOnEnd :: Text -> Text -> (Text, Text) breakOnEnd pat src = (reverse b, reverse a) where (a,b) = breakOn (reverse pat) (reverse src) @@ -1456,11 +1562,12 @@ -- -- Examples: -- --- > breakOnAll "::" "" --- > ==> [] --- > breakOnAll "/" "a/b/c/" --- > ==> [("a", "/b/c/"), ("a/b", "/c/"), ("a/b/c", "/")] +-- >>> breakOnAll "::" "" +-- [] -- +-- >>> breakOnAll "/" "a/b/c/" +-- [("a","/b/c/"),("a/b","/c/"),("a/b/c","/")] +-- -- In (unlikely) bad cases, this function's time complexity degrades -- towards /O(n*m)/. -- @@ -1658,10 +1765,15 @@ -- -- Examples: -- --- > stripPrefix "foo" "foobar" == Just "bar" --- > stripPrefix "" "baz" == Just "baz" --- > stripPrefix "foo" "quux" == Nothing +-- >>> stripPrefix "foo" "foobar" +-- Just "bar" -- +-- >>> stripPrefix "" "baz" +-- Just "baz" +-- +-- >>> stripPrefix "foo" "quux" +-- Nothing +-- -- This is particularly useful with the @ViewPatterns@ extension to -- GHC, as follows: -- @@ -1685,9 +1797,14 @@ -- -- Examples: -- --- > commonPrefixes "foobar" "fooquux" == Just ("foo","bar","quux") --- > commonPrefixes "veeble" "fetzer" == Nothing --- > commonPrefixes "" "baz" == Nothing +-- >>> commonPrefixes "foobar" "fooquux" +-- Just ("foo","bar","quux") +-- +-- >>> commonPrefixes "veeble" "fetzer" +-- Nothing +-- +-- >>> commonPrefixes "" "baz" +-- Nothing commonPrefixes :: Text -> Text -> Maybe (Text,Text,Text) commonPrefixes t0@(Text arr0 off0 len0) t1@(Text arr1 off1 len1) = go 0 0 where @@ -1704,10 +1821,15 @@ -- -- Examples: -- --- > stripSuffix "bar" "foobar" == Just "foo" --- > stripSuffix "" "baz" == Just "baz" --- > stripSuffix "foo" "quux" == Nothing +-- >>> stripSuffix "bar" "foobar" +-- Just "foo" -- +-- >>> stripSuffix "" "baz" +-- Just "baz" +-- +-- >>> stripSuffix "foo" "quux" +-- Nothing +-- -- This is particularly useful with the @ViewPatterns@ extension to -- GHC, as follows: -- @@ -1753,3 +1875,12 @@ marr <- A.new len A.copyI marr 0 arr off len return marr + + +------------------------------------------------- +-- NOTE: the named chunk below used by doctest; +-- verify the doctests via `doctest -fobject-code Data/Text.hs` + +-- $setup +-- >>> :set -XOverloadedStrings +-- >>> import qualified Data.Text as T diff --git a/Data/Text/Array.hs b/Data/Text/Array.hs --- a/Data/Text/Array.hs +++ b/Data/Text/Array.hs @@ -7,7 +7,6 @@ -- -- License : BSD-style -- Maintainer : bos@serpentine.com --- Stability : experimental -- Portability : portable -- -- Packed, unboxed, heap-resident arrays. Suitable for performance @@ -80,6 +79,8 @@ import Prelude hiding (length, read) -- | Immutable array type. +-- +-- The 'Array' constructor is exposed since @text-1.1.1.3@ data Array = Array { aBA :: ByteArray# #if defined(ASSERTS) @@ -88,6 +89,8 @@ } -- | Mutable array type, for use in the ST monad. +-- +-- The 'MArray' constructor is exposed since @text-1.1.1.3@ data MArray s = MArray { maBA :: MutableByteArray# s #if defined(ASSERTS) diff --git a/Data/Text/Encoding.hs b/Data/Text/Encoding.hs --- a/Data/Text/Encoding.hs +++ b/Data/Text/Encoding.hs @@ -11,14 +11,13 @@ -- -- License : BSD-style -- Maintainer : bos@serpentine.com --- Stability : experimental -- Portability : portable -- -- Functions for converting 'Text' values to and from 'ByteString', -- using several standard encodings. -- -- To gain access to a much larger family of encodings, use the --- @text-icu@ package: +-- . module Data.Text.Encoding ( @@ -79,7 +78,11 @@ import Data.Text.Show () import Data.Text.Unsafe (unsafeDupablePerformIO) import Data.Word (Word8, Word32) -import Foreign.C.Types (CSize(..)) +#if __GLASGOW_HASKELL__ >= 703 +import Foreign.C.Types (CSize(CSize)) +#else +import Foreign.C.Types (CSize) +#endif import Foreign.ForeignPtr (withForeignPtr) import Foreign.Marshal.Utils (with) import Foreign.Ptr (Ptr, minusPtr, nullPtr, plusPtr) @@ -209,6 +212,8 @@ -- or continuation where it is encountered. -- | A stream oriented decoding result. +-- +-- @since 1.0.0.0 data Decoding = Some Text ByteString (ByteString -> Decoding) instance Show Decoding where @@ -228,11 +233,15 @@ -- thrown (either by this function or a continuation) that cannot be -- caught in pure code. For more control over the handling of invalid -- data, use 'streamDecodeUtf8With'. +-- +-- @since 1.0.0.0 streamDecodeUtf8 :: ByteString -> Decoding streamDecodeUtf8 = streamDecodeUtf8With strictDecode -- | Decode, in a stream oriented way, a 'ByteString' containing UTF-8 -- encoded text. +-- +-- @since 1.0.0.0 streamDecodeUtf8With :: OnDecodeError -> ByteString -> Decoding streamDecodeUtf8With onErr = decodeChunk B.empty 0 0 where @@ -308,6 +317,8 @@ {-# INLINE decodeUtf8' #-} -- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding. +-- +-- @since 1.1.0.0 encodeUtf8Builder :: Text -> B.Builder encodeUtf8Builder = encodeUtf8BuilderEscaped (BP.liftFixedToBounded BP.word8) @@ -316,6 +327,8 @@ -- -- Use this function is to implement efficient encoders for text-based formats -- like JSON or HTML. +-- +-- @since 1.1.0.0 {-# INLINE encodeUtf8BuilderEscaped #-} -- TODO: Extend documentation with references to source code in @blaze-html@ -- or @aeson@ that uses this function. @@ -373,7 +386,7 @@ encodeUtf8 (Text arr off len) | len == 0 = B.empty | otherwise = unsafeDupablePerformIO $ do - fp <- mallocByteString (len*4) + fp <- mallocByteString (len*3) -- see https://github.com/haskell/text/issues/194 for why len*3 is enough withForeignPtr fp $ \ptr -> with ptr $ \destPtr -> do c_encode_utf8 destPtr (A.aBA arr) (fromIntegral off) (fromIntegral len) diff --git a/Data/Text/Encoding/Error.hs b/Data/Text/Encoding/Error.hs --- a/Data/Text/Encoding/Error.hs +++ b/Data/Text/Encoding/Error.hs @@ -10,7 +10,6 @@ -- -- License : BSD-style -- Maintainer : bos@serpentine.com --- Stability : experimental -- Portability : GHC -- -- Types and functions for dealing with encoding and decoding errors diff --git a/Data/Text/Foreign.hs b/Data/Text/Foreign.hs --- a/Data/Text/Foreign.hs +++ b/Data/Text/Foreign.hs @@ -5,7 +5,6 @@ -- -- License : BSD-style -- Maintainer : bos@serpentine.com --- Stability : experimental -- Portability : GHC -- -- Support for using 'Text' data with native code via the Haskell @@ -157,6 +156,8 @@ -- | /O(n)/ Decode a C string with explicit length, which is assumed -- to have been encoded as UTF-8. If decoding fails, a -- 'UnicodeException' is thrown. +-- +-- @since 1.0.0.0 peekCStringLen :: CStringLen -> IO Text peekCStringLen cs = do bs <- unsafePackCStringLen cs @@ -169,5 +170,7 @@ -- The temporary storage is freed when the subcomputation terminates -- (either normally or via an exception), so the pointer to the -- temporary storage must /not/ be used after this function returns. +-- +-- @since 1.0.0.0 withCStringLen :: Text -> (CStringLen -> IO a) -> IO a withCStringLen t act = unsafeUseAsCStringLen (encodeUtf8 t) act diff --git a/Data/Text/IO.hs b/Data/Text/IO.hs --- a/Data/Text/IO.hs +++ b/Data/Text/IO.hs @@ -8,7 +8,6 @@ -- (c) 2009 Simon Marlow -- License : BSD-style -- Maintainer : bos@serpentine.com --- Stability : experimental -- Portability : GHC -- -- Efficient locale-sensitive support for text I\/O. @@ -336,3 +335,7 @@ -- > -- > putStr_Utf16LE :: Text -> IO () -- > putStr_Utf16LE t = B.putStr (encodeUtf16LE t) +-- +-- On transcoding errors, an 'IOError' exception is thrown. You can +-- use the API in "Data.Text.Encoding" if you need more control over +-- error handling or transcoding. diff --git a/Data/Text/Internal/Fusion/CaseMapping.hs b/Data/Text/Internal/Fusion/CaseMapping.hs --- a/Data/Text/Internal/Fusion/CaseMapping.hs +++ b/Data/Text/Internal/Fusion/CaseMapping.hs @@ -1,10 +1,10 @@ {-# LANGUAGE Rank2Types #-} -- AUTOMATICALLY GENERATED - DO NOT EDIT -- Generated by scripts/CaseMapping.hs --- CaseFolding-8.0.0.txt --- Date: 2015-01-13, 18:16:36 GMT [MD] --- SpecialCasing-8.0.0.txt --- Date: 2014-12-16, 23:08:04 GMT [MD] +-- CaseFolding-9.0.0.txt +-- Date: 2016-03-02, 18:54:54 GMT +-- SpecialCasing-9.0.0.txt +-- Date: 2016-03-02, 18:55:13 GMT module Data.Text.Internal.Fusion.CaseMapping where import Data.Char @@ -371,6 +371,24 @@ foldMapping '\x13fc' s = Yield '\x13f4' (CC s '\x0000' '\x0000') -- CHEROKEE SMALL LETTER MV foldMapping '\x13fd' s = Yield '\x13f5' (CC s '\x0000' '\x0000') +-- CYRILLIC SMALL LETTER ROUNDED VE +foldMapping '\x1c80' s = Yield '\x0432' (CC s '\x0000' '\x0000') +-- CYRILLIC SMALL LETTER LONG-LEGGED DE +foldMapping '\x1c81' s = Yield '\x0434' (CC s '\x0000' '\x0000') +-- CYRILLIC SMALL LETTER NARROW O +foldMapping '\x1c82' s = Yield '\x043e' (CC s '\x0000' '\x0000') +-- CYRILLIC SMALL LETTER WIDE ES +foldMapping '\x1c83' s = Yield '\x0441' (CC s '\x0000' '\x0000') +-- CYRILLIC SMALL LETTER TALL TE +foldMapping '\x1c84' s = Yield '\x0442' (CC s '\x0000' '\x0000') +-- CYRILLIC SMALL LETTER THREE-LEGGED TE +foldMapping '\x1c85' s = Yield '\x0442' (CC s '\x0000' '\x0000') +-- CYRILLIC SMALL LETTER TALL HARD SIGN +foldMapping '\x1c86' s = Yield '\x044a' (CC s '\x0000' '\x0000') +-- CYRILLIC SMALL LETTER TALL YAT +foldMapping '\x1c87' s = Yield '\x0463' (CC s '\x0000' '\x0000') +-- CYRILLIC SMALL LETTER UNBLENDED UK +foldMapping '\x1c88' s = Yield '\xa64b' (CC s '\x0000' '\x0000') -- LATIN SMALL LETTER H WITH LINE BELOW foldMapping '\x1e96' s = Yield '\x0068' (CC s '\x0331' '\x0000') -- LATIN SMALL LETTER T WITH DIAERESIS @@ -545,6 +563,8 @@ foldMapping '\x1ff7' s = Yield '\x03c9' (CC s '\x0342' '\x03b9') -- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI foldMapping '\x1ffc' s = Yield '\x03c9' (CC s '\x03b9' '\x0000') +-- LATIN CAPITAL LETTER SMALL CAPITAL I +foldMapping '\xa7ae' s = Yield '\x026a' (CC s '\x0000' '\x0000') -- LATIN CAPITAL LETTER J WITH CROSSED-TAIL foldMapping '\xa7b2' s = Yield '\x029d' (CC s '\x0000' '\x0000') -- LATIN CAPITAL LETTER CHI @@ -737,6 +757,78 @@ foldMapping '\xfb16' s = Yield '\x057e' (CC s '\x0576' '\x0000') -- ARMENIAN SMALL LIGATURE MEN XEH foldMapping '\xfb17' s = Yield '\x0574' (CC s '\x056d' '\x0000') +-- OSAGE CAPITAL LETTER A +foldMapping '\x104b0' s = Yield '\x104d8' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER AI +foldMapping '\x104b1' s = Yield '\x104d9' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER AIN +foldMapping '\x104b2' s = Yield '\x104da' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER AH +foldMapping '\x104b3' s = Yield '\x104db' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER BRA +foldMapping '\x104b4' s = Yield '\x104dc' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER CHA +foldMapping '\x104b5' s = Yield '\x104dd' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER EHCHA +foldMapping '\x104b6' s = Yield '\x104de' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER E +foldMapping '\x104b7' s = Yield '\x104df' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER EIN +foldMapping '\x104b8' s = Yield '\x104e0' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER HA +foldMapping '\x104b9' s = Yield '\x104e1' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER HYA +foldMapping '\x104ba' s = Yield '\x104e2' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER I +foldMapping '\x104bb' s = Yield '\x104e3' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER KA +foldMapping '\x104bc' s = Yield '\x104e4' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER EHKA +foldMapping '\x104bd' s = Yield '\x104e5' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER KYA +foldMapping '\x104be' s = Yield '\x104e6' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER LA +foldMapping '\x104bf' s = Yield '\x104e7' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER MA +foldMapping '\x104c0' s = Yield '\x104e8' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER NA +foldMapping '\x104c1' s = Yield '\x104e9' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER O +foldMapping '\x104c2' s = Yield '\x104ea' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER OIN +foldMapping '\x104c3' s = Yield '\x104eb' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER PA +foldMapping '\x104c4' s = Yield '\x104ec' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER EHPA +foldMapping '\x104c5' s = Yield '\x104ed' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER SA +foldMapping '\x104c6' s = Yield '\x104ee' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER SHA +foldMapping '\x104c7' s = Yield '\x104ef' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER TA +foldMapping '\x104c8' s = Yield '\x104f0' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER EHTA +foldMapping '\x104c9' s = Yield '\x104f1' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER TSA +foldMapping '\x104ca' s = Yield '\x104f2' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER EHTSA +foldMapping '\x104cb' s = Yield '\x104f3' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER TSHA +foldMapping '\x104cc' s = Yield '\x104f4' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER DHA +foldMapping '\x104cd' s = Yield '\x104f5' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER U +foldMapping '\x104ce' s = Yield '\x104f6' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER WA +foldMapping '\x104cf' s = Yield '\x104f7' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER KHA +foldMapping '\x104d0' s = Yield '\x104f8' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER GHA +foldMapping '\x104d1' s = Yield '\x104f9' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER ZA +foldMapping '\x104d2' s = Yield '\x104fa' (CC s '\x0000' '\x0000') +-- OSAGE CAPITAL LETTER ZHA +foldMapping '\x104d3' s = Yield '\x104fb' (CC s '\x0000' '\x0000') -- OLD HUNGARIAN CAPITAL LETTER A foldMapping '\x10c80' s = Yield '\x10cc0' (CC s '\x0000' '\x0000') -- OLD HUNGARIAN CAPITAL LETTER AA @@ -839,4 +931,72 @@ foldMapping '\x10cb1' s = Yield '\x10cf1' (CC s '\x0000' '\x0000') -- OLD HUNGARIAN CAPITAL LETTER US foldMapping '\x10cb2' s = Yield '\x10cf2' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER ALIF +foldMapping '\x1e900' s = Yield '\x1e922' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER DAALI +foldMapping '\x1e901' s = Yield '\x1e923' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER LAAM +foldMapping '\x1e902' s = Yield '\x1e924' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER MIIM +foldMapping '\x1e903' s = Yield '\x1e925' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER BA +foldMapping '\x1e904' s = Yield '\x1e926' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER SINNYIIYHE +foldMapping '\x1e905' s = Yield '\x1e927' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER PE +foldMapping '\x1e906' s = Yield '\x1e928' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER BHE +foldMapping '\x1e907' s = Yield '\x1e929' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER RA +foldMapping '\x1e908' s = Yield '\x1e92a' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER E +foldMapping '\x1e909' s = Yield '\x1e92b' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER FA +foldMapping '\x1e90a' s = Yield '\x1e92c' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER I +foldMapping '\x1e90b' s = Yield '\x1e92d' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER O +foldMapping '\x1e90c' s = Yield '\x1e92e' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER DHA +foldMapping '\x1e90d' s = Yield '\x1e92f' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER YHE +foldMapping '\x1e90e' s = Yield '\x1e930' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER WAW +foldMapping '\x1e90f' s = Yield '\x1e931' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER NUN +foldMapping '\x1e910' s = Yield '\x1e932' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER KAF +foldMapping '\x1e911' s = Yield '\x1e933' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER YA +foldMapping '\x1e912' s = Yield '\x1e934' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER U +foldMapping '\x1e913' s = Yield '\x1e935' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER JIIM +foldMapping '\x1e914' s = Yield '\x1e936' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER CHI +foldMapping '\x1e915' s = Yield '\x1e937' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER HA +foldMapping '\x1e916' s = Yield '\x1e938' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER QAAF +foldMapping '\x1e917' s = Yield '\x1e939' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER GA +foldMapping '\x1e918' s = Yield '\x1e93a' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER NYA +foldMapping '\x1e919' s = Yield '\x1e93b' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER TU +foldMapping '\x1e91a' s = Yield '\x1e93c' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER NHA +foldMapping '\x1e91b' s = Yield '\x1e93d' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER VA +foldMapping '\x1e91c' s = Yield '\x1e93e' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER KHA +foldMapping '\x1e91d' s = Yield '\x1e93f' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER GBE +foldMapping '\x1e91e' s = Yield '\x1e940' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER ZAL +foldMapping '\x1e91f' s = Yield '\x1e941' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER KPO +foldMapping '\x1e920' s = Yield '\x1e942' (CC s '\x0000' '\x0000') +-- ADLAM CAPITAL LETTER SHA +foldMapping '\x1e921' s = Yield '\x1e943' (CC s '\x0000' '\x0000') foldMapping c s = Yield (toLower c) (CC s '\0' '\0') diff --git a/Data/Text/Internal/Fusion/Common.hs b/Data/Text/Internal/Fusion/Common.hs --- a/Data/Text/Internal/Fusion/Common.hs +++ b/Data/Text/Internal/Fusion/Common.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE BangPatterns, MagicHash, Rank2Types #-} +{-# LANGUAGE PatternGuards, BangPatterns, MagicHash, Rank2Types #-} -- | -- Module : Data.Text.Internal.Fusion.Common -- Copyright : (c) Bryan O'Sullivan 2009, 2012 @@ -117,7 +117,7 @@ import GHC.Types (Char(..), Int(..)) singleton :: Char -> Stream Char -singleton c = Stream next False 1 +singleton c = Stream next False (codePointsSize 1) where next False = Yield c True next True = Done {-# INLINE [0] singleton #-} @@ -175,7 +175,7 @@ -- | /O(n)/ Adds a character to the front of a Stream Char. cons :: Char -> Stream Char -> Stream Char -cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len+1) +cons !w (Stream next0 s0 len) = Stream next (C1 s0) (len + codePointsSize 1) where next (C1 s) = Yield w (C0 s) next (C0 s) = case next0 s of @@ -189,7 +189,7 @@ -- | /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) +snoc (Stream next0 xs0 len) w = Stream next (J xs0) (len + codePointsSize 1) where next (J xs) = case next0 xs of Done -> Yield w N @@ -237,7 +237,7 @@ uncons (Stream next s0 len) = loop_uncons s0 where loop_uncons !s = case next s of - Yield x s1 -> Just (x, Stream next s1 (len-1)) + Yield x s1 -> Just (x, Stream next s1 (len - codePointsSize 1)) Skip s' -> loop_uncons s' Done -> Nothing {-# INLINE [0] uncons #-} @@ -260,7 +260,7 @@ -- | /O(1)/ Returns all characters after the head of a Stream Char, which must -- be non-empty. tail :: Stream Char -> Stream Char -tail (Stream next0 s0 len) = Stream next (C0 s0) (len-1) +tail (Stream next0 s0 len) = Stream next (C0 s0) (len - codePointsSize 1) where next (C0 s) = case next0 s of Done -> emptyError "tail" @@ -278,7 +278,7 @@ -- | /O(1)/ Returns all but the last character of a Stream Char, which -- must be non-empty. init :: Stream Char -> Stream Char -init (Stream next0 s0 len) = Stream next (Init0 s0) (len-1) +init (Stream next0 s0 len) = Stream next (Init0 s0) (len - codePointsSize 1) where next (Init0 s) = case next0 s of Done -> emptyError "init" @@ -318,11 +318,14 @@ -- greater than the number or if the stream can't possibly be as long -- as the number supplied, and hence be more efficient. compareLengthI :: Integral a => Stream Char -> a -> Ordering -compareLengthI (Stream next s0 len) n = - case compareSize len (fromIntegral n) of - Just o -> o - Nothing -> loop_cmp 0 s0 +compareLengthI (Stream next s0 len) n + -- Note that @len@ tracks code units whereas we want to compare the length + -- in code points. Specifically, a stream with hint @len@ may consist of + -- anywhere from @len/2@ to @len@ code points. + | Just r <- compareSize len n' = r + | otherwise = loop_cmp 0 s0 where + n' = codePointsSize $ fromIntegral n loop_cmp !z s = case next s of Done -> compare z n Skip s' -> loop_cmp z s' @@ -368,7 +371,7 @@ -- | /O(n)/ Take a character and place it between each of the -- characters of a 'Stream Char'. intersperse :: Char -> Stream Char -> Stream Char -intersperse c (Stream next0 s0 len) = Stream next (I1 s0) len +intersperse c (Stream next0 s0 len) = Stream next (I1 s0) (len + unknownSize) where next (I1 s) = case next0 s of Done -> Done @@ -393,9 +396,11 @@ -- functions may map one input character to two or three output -- characters. +-- | Map a 'Stream' through the given case-mapping function. caseConvert :: (forall s. Char -> s -> Step (CC s) Char) -> Stream Char -> Stream Char -caseConvert remap (Stream next0 s0 len) = Stream next (CC s0 '\0' '\0') len +caseConvert remap (Stream next0 s0 len) = + Stream next (CC s0 '\0' '\0') (len `unionSize` 3*len) where next (CC s '\0' _) = case next0 s of @@ -458,7 +463,7 @@ -- Fox\" is correctly title cased—but this function will -- capitalize /every/ word. toTitle :: Stream Char -> Stream Char -toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') len +toTitle (Stream next0 s0 len) = Stream next (CC (False :*: s0) '\0' '\0') (len + unknownSize) where next (CC (letter :*: s) '\0' _) = case next0 s of @@ -479,7 +484,7 @@ justifyLeftI :: Integral a => a -> Char -> Stream Char -> Stream Char justifyLeftI k c (Stream next0 s0 len) = - Stream next (Just1 0 s0) (larger (fromIntegral k) len) + Stream next (Just1 0 s0) (larger (fromIntegral k * charSize c + len) len) where next (Just1 n s) = case next0 s of @@ -699,7 +704,7 @@ -- (a,b), in which case, a is the next Char in the string, and b is -- the seed value for further production. unfoldr :: (a -> Maybe (Char,a)) -> a -> Stream Char -unfoldr f s0 = Stream next s0 1 -- HINT maybe too low +unfoldr f s0 = Stream next s0 unknownSize where {-# INLINE next #-} next !s = case f s of @@ -713,7 +718,7 @@ -- 'unfoldr' when the length of the result is known. unfoldrNI :: Integral a => a -> (b -> Maybe (Char,b)) -> b -> Stream Char unfoldrNI n f s0 | n < 0 = empty - | otherwise = Stream next (0 :*: s0) (fromIntegral (n*2)) -- HINT maybe too high + | otherwise = Stream next (0 :*: s0) (maxSize $ fromIntegral (n*2)) where {-# INLINE next #-} next (z :*: s) = case f s of @@ -725,12 +730,12 @@ ------------------------------------------------------------------------------- -- * Substreams --- | /O(n)/ take n, applied to a stream, returns the prefix of the +-- | /O(n)/ @'take' n@, applied to a stream, returns the prefix of the -- stream of length @n@, or the stream itself if @n@ is greater than the -- length of the stream. take :: Integral a => a -> Stream Char -> Stream Char take n0 (Stream next0 s0 len) = - Stream next (n0 :*: s0) (smaller len (fromIntegral (max 0 n0))) + Stream next (n0 :*: s0) (smaller len (codePointsSize $ fromIntegral n0)) where {-# INLINE next #-} next (n :*: s) | n <= 0 = Done @@ -743,12 +748,12 @@ data Drop a s = NS !s | JS !a !s --- | /O(n)/ drop n, applied to a stream, returns the suffix of the +-- | /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 (JS n0 s0) (len - fromIntegral (max 0 n0)) + Stream next (JS n0 s0) (len - codePointsSize (fromIntegral n0)) where {-# INLINE next #-} next (JS n s) @@ -763,10 +768,10 @@ Yield x s' -> Yield x (NS s') {-# INLINE [0] drop #-} --- | takeWhile, applied to a predicate @p@ and a stream, returns the --- longest prefix (possibly empty) of elements that satisfy p. +-- | 'takeWhile', applied to a predicate @p@ and a stream, returns the +-- longest prefix (possibly empty) of elements that satisfy @p@. takeWhile :: (Char -> Bool) -> Stream Char -> Stream Char -takeWhile p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high +takeWhile p (Stream next0 s0 len) = Stream next s0 (len - unknownSize) where {-# INLINE next #-} next !s = case next0 s of @@ -776,9 +781,9 @@ | otherwise -> Done {-# INLINE [0] takeWhile #-} --- | dropWhile @p @xs returns the suffix remaining after takeWhile @p @xs. +-- | @'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 (L s0) len -- HINT maybe too high +dropWhile p (Stream next0 s0 len) = Stream next (L s0) (len - unknownSize) where {-# INLINE next #-} next (L s) = case next0 s of @@ -812,7 +817,7 @@ ------------------------------------------------------------------------------- -- ** Searching by equality --- | /O(n)/ elem is the stream membership predicate. +-- | /O(n)/ 'elem' is the stream membership predicate. elem :: Char -> Stream Char -> Bool elem w (Stream next s0 _len) = loop_elem s0 where @@ -857,7 +862,8 @@ -- returns a stream containing those characters that satisfy the -- predicate. filter :: (Char -> Bool) -> Stream Char -> Stream Char -filter p (Stream next0 s0 len) = Stream next s0 len -- HINT maybe too high +filter p (Stream next0 s0 len) = + Stream next s0 (len - unknownSize) -- HINT maybe too high where next !s = case next0 s of Done -> Done diff --git a/Data/Text/Internal/Fusion/Size.hs b/Data/Text/Internal/Fusion/Size.hs --- a/Data/Text/Internal/Fusion/Size.hs +++ b/Data/Text/Internal/Fusion/Size.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, PatternGuards #-} {-# OPTIONS_GHC -fno-warn-missing-methods #-} -- | -- Module : Data.Text.Internal.Fusion.Internal @@ -19,11 +19,16 @@ module Data.Text.Internal.Fusion.Size ( Size - , exactly + -- * Sizes , exactSize , maxSize , betweenSize , unknownSize + , unionSize + , charSize + , codePointsSize + -- * Querying sizes + , exactly , smaller , larger , upperBound @@ -32,11 +37,13 @@ , isEmpty ) where +import Data.Char (ord) import Data.Text.Internal (mul) #if defined(ASSERTS) import Control.Exception (assert) #endif +-- | A size in UTF-16 code units. data Size = Between {-# UNPACK #-} !Int {-# UNPACK #-} !Int -- ^ Lower and upper bounds on size. | Unknown -- ^ Unknown size. deriving (Eq, Show) @@ -46,6 +53,17 @@ exactly _ = Nothing {-# INLINE exactly #-} +-- | The 'Size' of the given code point. +charSize :: Char -> Size +charSize c + | ord c < 0x10000 = exactSize 1 + | otherwise = exactSize 2 + +-- | The 'Size' of @n@ code points. +codePointsSize :: Int -> Size +codePointsSize n = Between n (2*n) +{-# INLINE codePointsSize #-} + exactSize :: Int -> Size exactSize n = #if defined(ASSERTS) @@ -71,6 +89,10 @@ Between m n {-# INLINE betweenSize #-} +unionSize :: Size -> Size -> Size +unionSize (Between a b) (Between c d) = Between (min a c) (max b d) +unionSize _ _ = Unknown + unknownSize :: Size unknownSize = Unknown {-# INLINE unknownSize #-} @@ -140,11 +162,15 @@ lowerBound k _ = k {-# INLINE lowerBound #-} -compareSize :: Size -> Int -> Maybe Ordering -compareSize (Between ma mb) n - | mb < n = Just LT - | ma > n = Just GT - | ma == n && mb == n = Just EQ +-- | Determine the ordering relationship between two 'Size's, or 'Nothing' in +-- the indeterminate case. +compareSize :: Size -> Size -> Maybe Ordering +compareSize (Between ma mb) (Between na nb) + | mb < na = Just LT + | ma > nb = Just GT + | ma == mb + , ma == na + , ma == nb = Just EQ compareSize _ _ = Nothing diff --git a/Data/Text/Internal/Fusion/Types.hs b/Data/Text/Internal/Fusion/Types.hs --- a/Data/Text/Internal/Fusion/Types.hs +++ b/Data/Text/Internal/Fusion/Types.hs @@ -75,16 +75,16 @@ -- unstreaming functions must be able to cope with the hint being too -- small or too large. -- --- The size hint tries to track the UTF-16 code points in a stream, --- but often counts the number of characters instead. It can easily +-- The size hint tries to track the UTF-16 code units in a stream, +-- but often counts the number of code points instead. It can easily -- undercount if, for instance, a transformed stream contains astral --- plane characters (those above 0x10000). +-- plane code points (those above 0x10000). data Stream a = forall s. Stream (s -> Step s a) -- stepper function !s -- current state - !Size -- size hint + !Size -- size hint in code units -- | /O(n)/ Determines if two streams are equal. eq :: (Eq a) => Stream a -> Stream a -> Bool diff --git a/Data/Text/Lazy.hs b/Data/Text/Lazy.hs --- a/Data/Text/Lazy.hs +++ b/Data/Text/Lazy.hs @@ -13,7 +13,6 @@ -- -- License : BSD-style -- Maintainer : bos@serpentine.com --- Stability : experimental -- Portability : GHC -- -- A time and space-efficient implementation of Unicode text using @@ -68,6 +67,7 @@ , snoc , append , uncons + , unsnoc , head , last , tail @@ -273,14 +273,16 @@ -- $replacement -- -- A 'Text' value is a sequence of Unicode scalar values, as defined --- in §3.9, definition D76 of the Unicode 5.2 standard: --- . As --- such, a 'Text' cannot contain values in the range U+D800 to U+DFFF --- inclusive. Haskell implementations admit all Unicode code points --- (§3.4, definition D10) as 'Char' values, including code points --- from this invalid range. This means that there are some 'Char' --- values that are not valid Unicode scalar values, and the functions --- in this module must handle those cases. +-- in +-- . +-- As such, a 'Text' cannot contain values in the range U+D800 to +-- U+DFFF inclusive. Haskell implementations admit all Unicode code +-- points +-- () +-- as 'Char' values, including code points from this invalid range. +-- This means that there are some 'Char' values that are not valid +-- Unicode scalar values, and the functions in this module must handle +-- those cases. -- -- Within this module, many functions construct a 'Text' from one or -- more 'Char' values. Those functions will substitute 'Char' values @@ -294,8 +296,8 @@ -- range U+D800 through U+DFFF are used by UTF-16 to denote surrogate -- code points, and so cannot be represented. The functions replace -- invalid scalar values, instead of dropping them, as a security --- measure. For details, see Unicode Technical Report 36, §3.5: --- ) +-- measure. For details, see +-- .) equal :: Text -> Text -> Bool equal Empty Empty = True @@ -342,9 +344,13 @@ readsPrec p str = [(pack x,y) | (x,y) <- readsPrec p str] #if MIN_VERSION_base(4,9,0) --- Semigroup orphan instances for older GHCs are provided by --- 'semigroups` package - +-- | Non-orphan 'Semigroup' instance only defined for +-- @base-4.9.0.0@ and later; orphan instances for older GHCs are +-- provided by +-- the [semigroups](http://hackage.haskell.org/package/semigroups) +-- package +-- +-- @since 1.2.2.0 instance Semigroup Text where (<>) = append #endif @@ -362,6 +368,7 @@ fromString = pack #if __GLASGOW_HASKELL__ >= 708 +-- | @since 1.2.0.0 instance Exts.IsList Text where type Item Text = Char fromList = pack @@ -374,6 +381,7 @@ rnf (Chunk _ ts) = rnf ts #endif +-- | @since 1.2.1.0 instance Binary Text where put t = put (encodeUtf8 t) get = do @@ -397,6 +405,8 @@ #if MIN_VERSION_base(4,7,0) -- | Only defined for @base-4.7.0.0@ and later +-- +-- @since 1.2.2.0 instance PrintfArg Text where formatArg txt = formatString $ unpack txt #endif @@ -475,9 +485,7 @@ -- ----------------------------------------------------------------------------- -- * Basic functions --- | /O(n)/ Adds a character to the front of a 'Text'. This function --- is more costly than its 'List' counterpart because it requires --- copying a new array. Subject to fusion. +-- | /O(1)/ Adds a character to the front of a 'Text'. Subject to fusion. cons :: Char -> Text -> Text cons c t = Chunk (T.singleton c) t {-# INLINE [1] cons #-} @@ -561,6 +569,17 @@ unstream (S.init (stream t)) = init t #-} +-- | /O(n\/c)/ Returns the 'init' and 'last' of a 'Text', or 'Nothing' if +-- empty. +-- +-- * It is no faster than using 'init' and 'last'. +-- +-- @since 1.2.3.0 +unsnoc :: Text -> Maybe (Text, Char) +unsnoc Empty = Nothing +unsnoc ts@(Chunk _ _) = Just (init ts, last ts) +{-# INLINE unsnoc #-} + -- | /O(1)/ Tests whether a 'Text' is empty or not. Subject to -- fusion. null :: Text -> Bool @@ -820,6 +839,8 @@ -- guides disagree on whether the book name \"The Hill of the Red -- Fox\" is correctly title cased—but this function will -- capitalize /every/ word. +-- +-- @since 1.0.0.0 toTitle :: Text -> Text toTitle t = unstream (S.toTitle (stream t)) {-# INLINE toTitle #-} @@ -972,6 +993,8 @@ -- | @'repeat' x@ is an infinite 'Text', with @x@ the value of every -- element. +-- +-- @since 1.2.0.5 repeat :: Char -> Text repeat c = let t = Chunk (T.replicate smallChunkSize (T.singleton c)) t in t @@ -989,6 +1012,8 @@ -- | 'cycle' ties a finite, non-empty 'Text' into a circular one, or -- equivalently, the infinite repetition of the original 'Text'. +-- +-- @since 1.2.0.5 cycle :: Text -> Text cycle Empty = emptyError "cycle" cycle t = let t' = foldrChunks Chunk t' t @@ -998,6 +1023,8 @@ -- of @f@ to @x@: -- -- > iterate f x == [x, f x, f (f x), ...] +-- +-- @since 1.2.0.5 iterate :: (Char -> Char) -> Char -> Text iterate f c = let t c' = Chunk (T.singleton c') (t (f c')) in t c @@ -1061,6 +1088,8 @@ -- Examples: -- -- > takeEnd 3 "foobar" == "bar" +-- +-- @since 1.1.1.0 takeEnd :: Int64 -> Text -> Text takeEnd n t0 | n <= 0 = empty @@ -1099,6 +1128,8 @@ -- Examples: -- -- > dropEnd 3 "foobar" == "foo" +-- +-- @since 1.1.1.0 dropEnd :: Int64 -> Text -> Text dropEnd n t0 | n <= 0 = t0 @@ -1150,12 +1181,15 @@ -- Examples: -- -- > takeWhileEnd (=='o') "foo" == "oo" +-- +-- @since 1.2.2.0 takeWhileEnd :: (Char -> Bool) -> Text -> Text takeWhileEnd p = takeChunk empty . L.reverse . toChunks where takeChunk acc [] = acc - takeChunk acc (t:ts) = if T.length t' < T.length t - then (Chunk t' acc) - else takeChunk (Chunk t' acc) ts + takeChunk acc (t:ts) + | T.lengthWord16 t' < T.lengthWord16 t + = chunk t' acc + | otherwise = takeChunk (Chunk t' acc) ts where t' = T.takeWhileEnd p t {-# INLINE takeWhileEnd #-} diff --git a/Data/Text/Lazy/Builder.hs b/Data/Text/Lazy/Builder.hs --- a/Data/Text/Lazy/Builder.hs +++ b/Data/Text/Lazy/Builder.hs @@ -11,7 +11,6 @@ -- License : BSD-style (see LICENSE) -- -- Maintainer : Johan Tibell --- Stability : experimental -- Portability : portable to Hugs and GHC -- -- Efficient construction of lazy @Text@ values. The principal diff --git a/Data/Text/Lazy/Builder/Int.hs b/Data/Text/Lazy/Builder/Int.hs --- a/Data/Text/Lazy/Builder/Int.hs +++ b/Data/Text/Lazy/Builder/Int.hs @@ -9,7 +9,6 @@ -- (c) 2011 MailRank, Inc. -- License: BSD-style -- Maintainer: Bryan O'Sullivan --- Stability: experimental -- Portability: portable -- -- Efficiently write an integral value to a 'Builder'. @@ -32,6 +31,9 @@ import GHC.Num (quotRemInteger) import GHC.Types (Int(..)) import Control.Monad.ST +#if MIN_VERSION_base(4,11,0) +import Prelude hiding ((<>)) +#endif #ifdef __GLASGOW_HASKELL__ # if defined(INTEGER_GMP) diff --git a/Data/Text/Lazy/Builder/RealFloat.hs b/Data/Text/Lazy/Builder/RealFloat.hs --- a/Data/Text/Lazy/Builder/RealFloat.hs +++ b/Data/Text/Lazy/Builder/RealFloat.hs @@ -24,6 +24,9 @@ import Data.Text.Internal.Builder.RealFloat.Functions (roundTo) import Data.Text.Lazy.Builder import qualified Data.Text as T +#if MIN_VERSION_base(4,11,0) +import Prelude hiding ((<>)) +#endif -- | Control the rendering of floating point numbers. data FPFormat = Exponent diff --git a/Data/Text/Lazy/Encoding.hs b/Data/Text/Lazy/Encoding.hs --- a/Data/Text/Lazy/Encoding.hs +++ b/Data/Text/Lazy/Encoding.hs @@ -8,14 +8,13 @@ -- -- License : BSD-style -- Maintainer : bos@serpentine.com --- Stability : experimental -- Portability : portable -- -- Functions for converting lazy 'Text' values to and from lazy -- 'ByteString', using several standard encodings. -- --- To gain access to a much larger variety of encodings, use the --- @text-icu@ package: +-- To gain access to a much larger family of encodings, use the +-- . module Data.Text.Lazy.Encoding ( @@ -141,6 +140,7 @@ rnf (Chunk _ ts) = rnf ts {-# INLINE decodeUtf8' #-} +-- | Encode text using UTF-8 encoding. encodeUtf8 :: Text -> B.ByteString encodeUtf8 Empty = B.empty encodeUtf8 lt@(Chunk t _) = @@ -154,10 +154,20 @@ firstChunkSize = min B.smallChunkSize (4 * (T.length t + 1)) strategy = B.safeStrategy firstChunkSize B.defaultChunkSize +-- | Encode text to a ByteString 'B.Builder' using UTF-8 encoding. +-- +-- @since 1.1.0.0 encodeUtf8Builder :: Text -> B.Builder encodeUtf8Builder = foldrChunks (\c b -> TE.encodeUtf8Builder c `mappend` b) Data.Monoid.mempty +-- | Encode text using UTF-8 encoding and escape the ASCII characters using +-- a 'BP.BoundedPrim'. +-- +-- Use this function is to implement efficient encoders for text-based formats +-- like JSON or HTML. +-- +-- @since 1.1.0.0 {-# INLINE encodeUtf8BuilderEscaped #-} encodeUtf8BuilderEscaped :: BP.BoundedPrim Word8 -> Text -> B.Builder encodeUtf8BuilderEscaped prim = diff --git a/Data/Text/Lazy/IO.hs b/Data/Text/Lazy/IO.hs --- a/Data/Text/Lazy/IO.hs +++ b/Data/Text/Lazy/IO.hs @@ -8,7 +8,6 @@ -- (c) 2009 Simon Marlow -- License : BSD-style -- Maintainer : bos@serpentine.com --- Stability : experimental -- Portability : GHC -- -- Efficient locale-sensitive support for lazy text I\/O. diff --git a/Data/Text/Lazy/Read.hs b/Data/Text/Lazy/Read.hs --- a/Data/Text/Lazy/Read.hs +++ b/Data/Text/Lazy/Read.hs @@ -11,7 +11,6 @@ -- -- License : BSD-style -- Maintainer : bos@serpentine.com --- Stability : experimental -- Portability : GHC -- -- Functions used frequently when reading textual data. diff --git a/Data/Text/Read.hs b/Data/Text/Read.hs --- a/Data/Text/Read.hs +++ b/Data/Text/Read.hs @@ -9,7 +9,6 @@ -- -- License : BSD-style -- Maintainer : bos@serpentine.com --- Stability : experimental -- Portability : GHC -- -- Functions used frequently when reading textual data. diff --git a/Data/Text/Show.hs b/Data/Text/Show.hs --- a/Data/Text/Show.hs +++ b/Data/Text/Show.hs @@ -46,6 +46,8 @@ -- fusion. -- -- This is exposed solely for people writing GHC rewrite rules. +-- +-- @since 1.2.1.1 unpackCString# :: Addr# -> Text unpackCString# addr# = unstream (S.streamCString# addr#) {-# NOINLINE unpackCString# #-} diff --git a/Data/Text/Unsafe.hs b/Data/Text/Unsafe.hs --- a/Data/Text/Unsafe.hs +++ b/Data/Text/Unsafe.hs @@ -4,7 +4,6 @@ -- Copyright : (c) 2009, 2010, 2011 Bryan O'Sullivan -- License : BSD-style -- Maintainer : bos@serpentine.com --- Stability : experimental -- Portability : portable -- -- A module containing unsafe 'Text' operations, for very very careful @@ -98,6 +97,8 @@ -- | /O(1)/ Iterate one step backwards through a UTF-16 array, -- returning the delta to add (i.e. a negative number) to give the -- next offset to iterate at. +-- +-- @since 1.1.1.0 reverseIter_ :: Text -> Int -> Int reverseIter_ (Text arr off _len) i | m < 0xDC00 || m > 0xDFFF = -1 diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -1,29 +1,18 @@ -# Text: Fast, packed Unicode strings, using stream fusion +# `text`: Fast, packed Unicode strings, using stream fusion This package provides the Data.Text library, a library for the space- and time-efficient manipulation of Unicode text in Haskell. - -# Normalization, conversion, and collation, oh my! - -This library intentionally provides a simple API based on the -Haskell prelude's list manipulation functions. For more complicated -real-world tasks, such as Unicode normalization, conversion to and -from a larger variety of encodings, and collation, use the [text-icu -package](http://hackage.haskell.org/cgi-bin/hackage-scripts/package/text-icu). - -That library uses the well-respected and liberally licensed ICU -library to provide these facilities. - +**Please refer to the [package description on Hackage](https://hackage.haskell.org/package/text#description) for more information.** # Get involved! Please report bugs via the -[github issue tracker](https://github.com/bos/text/issues). +[github issue tracker](https://github.com/haskell/text/issues). -Master [git repository](https://github.com/bos/text): +Master [git repository](https://github.com/haskell/text): -* `git clone git://github.com/bos/text.git` +* `git clone git://github.com/haskell/text.git` There's also a [Mercurial mirror](https://bitbucket.org/bos/text): diff --git a/benchmarks/haskell/Benchmarks.hs b/benchmarks/haskell/Benchmarks.hs --- a/benchmarks/haskell/Benchmarks.hs +++ b/benchmarks/haskell/Benchmarks.hs @@ -10,6 +10,7 @@ import System.IO (IOMode (WriteMode), openFile, hSetEncoding, utf8) import qualified Benchmarks.Builder as Builder +import qualified Benchmarks.Concat as Concat import qualified Benchmarks.DecodeUtf8 as DecodeUtf8 import qualified Benchmarks.EncodeUtf8 as EncodeUtf8 import qualified Benchmarks.Equality as Equality @@ -41,6 +42,7 @@ -- Traditional benchmarks bs <- sequence [ Builder.benchmark + , Concat.benchmark , DecodeUtf8.benchmark "html" (tf "libya-chinese.html") , DecodeUtf8.benchmark "xml" (tf "yiwiki.xml") , DecodeUtf8.benchmark "ascii" (tf "ascii.txt") diff --git a/benchmarks/haskell/Benchmarks/Concat.hs b/benchmarks/haskell/Benchmarks/Concat.hs new file mode 100644 --- /dev/null +++ b/benchmarks/haskell/Benchmarks/Concat.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Benchmarks.Concat (benchmark) where + +import Control.Monad.Trans.Writer +import Criterion (Benchmark, bgroup, bench, whnf) +import Data.Text as T + +benchmark :: IO Benchmark +benchmark = return $ bgroup "Concat" + [ bench "append" $ whnf (append4 "Text 1" "Text 2" "Text 3") "Text 4" + , bench "concat" $ whnf (concat4 "Text 1" "Text 2" "Text 3") "Text 4" + , bench "write" $ whnf (write4 "Text 1" "Text 2" "Text 3") "Text 4" + ] + +append4, concat4, write4 :: Text -> Text -> Text -> Text -> Text + +{-# NOINLINE append4 #-} +append4 x1 x2 x3 x4 = x1 `append` x2 `append` x3 `append` x4 + +{-# NOINLINE concat4 #-} +concat4 x1 x2 x3 x4 = T.concat [x1, x2, x3, x4] + +{-# NOINLINE write4 #-} +write4 x1 x2 x3 x4 = execWriter $ tell x1 >> tell x2 >> tell x3 >> tell x4 diff --git a/benchmarks/text-benchmarks.cabal b/benchmarks/text-benchmarks.cabal --- a/benchmarks/text-benchmarks.cabal +++ b/benchmarks/text-benchmarks.cabal @@ -12,8 +12,7 @@ maintainer: jaspervdj@gmail.com category: Text build-type: Simple - -cabal-version: >=1.2 +cabal-version: >=1.8 flag bytestring-builder description: Depend on the bytestring-builder package for backwards compatibility. @@ -26,16 +25,12 @@ manual: True executable text-benchmarks - hs-source-dirs: haskell .. - c-sources: ../cbits/cbits.c - cbits/time_iconv.c - include-dirs: ../include - main-is: Benchmarks.hs ghc-options: -Wall -O2 -rtsopts if flag(llvm) ghc-options: -fllvm cpp-options: -DHAVE_DEEPSEQ -DINTEGER_GMP - build-depends: base == 4.*, + build-depends: array, + base == 4.*, binary, blaze-builder, bytestring-lexing >= 0.5.0, @@ -47,6 +42,7 @@ ghc-prim, integer-gmp, stringsearch, + transformers, utf8-string, vector @@ -56,9 +52,87 @@ else build-depends: bytestring >= 0.10.4 + -- modules for benchmark proper + c-sources: cbits/time_iconv.c + hs-source-dirs: haskell + main-is: Benchmarks.hs + other-modules: + Benchmarks.Builder + Benchmarks.Concat + Benchmarks.DecodeUtf8 + Benchmarks.EncodeUtf8 + Benchmarks.Equality + Benchmarks.FileRead + Benchmarks.FoldLines + Benchmarks.Mul + Benchmarks.Programs.BigTable + Benchmarks.Programs.Cut + Benchmarks.Programs.Fold + Benchmarks.Programs.Sort + Benchmarks.Programs.StripTags + Benchmarks.Programs.Throughput + Benchmarks.Pure + Benchmarks.ReadNumbers + Benchmarks.Replace + Benchmarks.Search + Benchmarks.Stream + Benchmarks.WordFrequencies + + -- Source code for IUT (implementation under test) + -- "borrowed" from parent folder + include-dirs: ../include + c-sources: ../cbits/cbits.c + hs-source-dirs: .. + other-modules: + Data.Text + Data.Text.Array + Data.Text.Encoding + Data.Text.Encoding.Error + Data.Text.Foreign + Data.Text.IO + Data.Text.Internal + Data.Text.Internal.Builder + Data.Text.Internal.Builder.Functions + Data.Text.Internal.Builder.Int.Digits + Data.Text.Internal.Builder.RealFloat.Functions + Data.Text.Internal.Encoding.Fusion + Data.Text.Internal.Encoding.Fusion.Common + Data.Text.Internal.Encoding.Utf16 + Data.Text.Internal.Encoding.Utf32 + Data.Text.Internal.Encoding.Utf8 + Data.Text.Internal.Functions + Data.Text.Internal.Fusion + Data.Text.Internal.Fusion.CaseMapping + Data.Text.Internal.Fusion.Common + Data.Text.Internal.Fusion.Size + Data.Text.Internal.Fusion.Types + Data.Text.Internal.IO + Data.Text.Internal.Lazy + Data.Text.Internal.Lazy.Encoding.Fusion + Data.Text.Internal.Lazy.Fusion + Data.Text.Internal.Lazy.Search + Data.Text.Internal.Private + Data.Text.Internal.Read + Data.Text.Internal.Search + Data.Text.Internal.Unsafe + Data.Text.Internal.Unsafe.Char + Data.Text.Internal.Unsafe.Shift + Data.Text.Lazy + Data.Text.Lazy.Builder + Data.Text.Lazy.Builder.Int + Data.Text.Lazy.Builder.RealFloat + Data.Text.Lazy.Encoding + Data.Text.Lazy.IO + Data.Text.Lazy.Internal + Data.Text.Lazy.Read + Data.Text.Read + Data.Text.Unsafe + Data.Text.Show + executable text-multilang hs-source-dirs: haskell main-is: Multilang.hs + other-modules: Timer ghc-options: -Wall -O2 build-depends: base == 4.*, bytestring, diff --git a/cbits/cbits.c b/cbits/cbits.c --- a/cbits/cbits.c +++ b/cbits/cbits.c @@ -206,11 +206,9 @@ const uint8_t *srcend, uint32_t *codepoint0, uint32_t *state0) { - uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, src, srcend, - codepoint0, state0); - if (*state0 == UTF8_REJECT) - ret -=1; - return ret; + _hs_text_decode_utf8_int(dest, destoff, src, srcend, codepoint0, state0); + + return *src; } /* @@ -222,12 +220,9 @@ { uint32_t codepoint; uint32_t state = UTF8_ACCEPT; - uint8_t const *ret = _hs_text_decode_utf8_int(dest, destoff, &src, srcend, - &codepoint, &state); - /* Back up if we have an incomplete or invalid encoding */ - if (state != UTF8_ACCEPT) - ret -= 1; - return ret; + _hs_text_decode_utf8_int(dest, destoff, &src, srcend, + &codepoint, &state); + return src; } void diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,25 @@ -1.2.2.2 +### 1.2.3.0 +* Spec compliance: `toCaseFold` now follows the Unicode 9.0 spec + (updated from 8.0). + +* Bug fix: the lazy `takeWhileEnd` function violated the + [lazy text invariant](https://github.com/bos/text/blob/1.2.3.0/Data/Text/Internal/Lazy.hs#L51) + (gh-184). + +* Bug fix: Fixed usage of size hints causing incorrect behavior (gh-197). + +* New function: `unsnoc` (gh-173). + +* Reduce memory overhead in `encodeUTF8` (gh-194). + +* Improve UTF-8 decoder error-recovery (gh-182). + +* Minor documentation improvements (`@since` annotations, more + examples, clarifications). + +#### 1.2.2.2 + * The `toTitle` function now correctly handles letters that immediately follow punctuation. Before, `"there's"` would turn into `"There'S"`. Now, it becomes `"There's"`. @@ -15,7 +35,7 @@ * Bug fix: a logic error in `takeWord16` is fixed. -1.2.2.1 +#### 1.2.2.1 * The switch to `integer-pure` in 1.2.2.0 was apparently mistaken. The build flag has been renamed accordingly. Your army of diligent @@ -26,7 +46,7 @@ * An STG lint error has been fixed -1.2.2.0 +### 1.2.2.0 * The `integer-simple` package, upon which this package optionally depended, has been replaced with `integer-pure`. The build flag has @@ -42,7 +62,7 @@ * if `base` >= 4.7: `PrintfArg` * if `base` >= 4.9: `Semigroup` -1.2.1.3 +#### 1.2.1.3 * Bug fix: As it turns out, moving the literal rewrite rules to simplifier phase 2 does not prevent competition with the `unpack` rule, which is @@ -50,7 +70,7 @@ test environment mistake. Moving literal rules back to phase 1 finally fixes GHC Trac #10528 correctly. -1.2.1.2 +#### 1.2.1.2 * Bug fix: Run literal rewrite rules in simplifier phase 2. The behavior of the simplifier changed in GHC 7.10.2, @@ -58,21 +78,21 @@ and long compilation times. See [GHC Trac #10528](https://ghc.haskell.org/trac/ghc/ticket/10528). -1.2.1.1 +#### 1.2.1.1 * Expose unpackCString#, which you should never use. -1.2.1.0 +### 1.2.1.0 * Added Binary instances for both Text types. (If you have previously been using the text-binary package to get a Binary instance, it is now obsolete.) -1.2.0.6 +#### 1.2.0.6 * Fixed a space leak in UTF-8 decoding -1.2.0.5 +#### 1.2.0.5 * Feature parity: repeat, cycle, iterate are now implemented for lazy Text, and the Data instance is more complete @@ -92,26 +112,26 @@ * Spec compliance: toCaseFold now follows the Unicode 7.0 spec (updated from 6.3) -1.2.0.4 +#### 1.2.0.4 * Fixed an incompatibility with base < 4.5 -1.2.0.3 +#### 1.2.0.3 * Update formatRealFloat to correspond to the definition in versions of base newer than 4.5 (https://github.com/bos/text/issues/105) -1.2.0.2 +#### 1.2.0.2 * Bumped lower bound on deepseq to 1.4 for compatibility with the upcoming GHC 7.10 -1.2.0.1 +#### 1.2.0.1 * Fixed a buffer overflow in rendering of large Integers (https://github.com/bos/text/issues/99) -1.2.0.0 +## 1.2.0.0 * Fixed an integer overflow in the replace function (https://github.com/bos/text/issues/81) @@ -124,7 +144,7 @@ * Added an instance of IsList for GHC 7.8 and above -1.1.1.0 +### 1.1.1.0 * The Data.Data instance now allows gunfold to work, via a virtual pack constructor @@ -134,12 +154,12 @@ * Comparing the length of a Text against a number can now short-circuit in more cases -1.1.0.1 +#### 1.1.0.1 * streamDecodeUtf8: fixed gh-70, did not return all unconsumed bytes in single-byte chunks -1.1.0.0 +## 1.1.0.0 * encodeUtf8: Performance is improved by up to 4x. @@ -158,12 +178,12 @@ use at your own risk - there are no API stability guarantees for internal modules! -1.0.0.1 +#### 1.0.0.1 * decodeUtf8: Fixed a regression that caused us to incorrectly identify truncated UTF-8 as valid (gh-61) -1.0.0.0 +# 1.0.0.0 * Added support for Unicode 6.3.0 to case conversion functions diff --git a/tests-and-benchmarks.markdown b/tests-and-benchmarks.markdown --- a/tests-and-benchmarks.markdown +++ b/tests-and-benchmarks.markdown @@ -13,11 +13,14 @@ * Git mirror repository: [github.com/bos/text-test-data](https://github.com/bos/text-test-data) -You should clone that repository into the `tests` subdirectory (your -clone must be named `text-test-data` locally), then run `make -C -tests/text-test-data` to uncompress the test files. Many tests and -benchmarks will fail if the test files are missing. +You can clone either repository into the `tests` subdirectory using + cd tests/ + make text-test-data # to clone from mercurial, OR + make VCS=git text-test-data # to clone from git + +Many tests and benchmarks will fail if the test files are missing. + Functional tests ---------------- @@ -54,10 +57,12 @@ ./dist/build/text-benchmarks/text-benchmarks -However, since there's quite a lot of benchmarks, you usually don't want to -run them all. Instead, use the `-l` flag to get a list of benchmarks: +Or if you have a recent enough `cabal`, you can build and run the +benchmarks via - ./dist/build/text-benchmarks/text-benchmarks + cabal new-run exe:text-benchmarks -- --help -And run the ones you want to inspect. If you want to configure the benchmarks +However, since there's quite a lot of benchmarks, you usually don't want to +run them all. Instead, use the `-l` flag to get a list of benchmarks +and run the ones you want to inspect. If you want to configure the benchmarks further, the exact parameters can be changed in `Benchmarks.hs`. diff --git a/tests/Makefile b/tests/Makefile --- a/tests/Makefile +++ b/tests/Makefile @@ -1,3 +1,4 @@ +VCS = hg count = 1000 all: coverage literal-rule-test @@ -12,7 +13,11 @@ cabal build text-test-data: +ifeq ($(VCS),git) + git clone https://github.com/bos/text-test-data.git +else hg clone https://bitbucket.org/bos/text-test-data +endif $(MAKE) -C text-test-data coverage/text-tests.tix: @@ -37,4 +42,4 @@ clean: rm -rf dist coverage .hpc -.PHONY: build coverage all literal-rule-test +.PHONY: all build clean coverage literal-rule-test diff --git a/tests/Tests/Properties.hs b/tests/Tests/Properties.hs --- a/tests/Tests/Properties.hs +++ b/tests/Tests/Properties.hs @@ -9,7 +9,7 @@ ) where import Control.Applicative ((<$>), (<*>)) -import Control.Arrow ((***), second) +import Control.Arrow ((***), first, second) import Data.Bits ((.&.)) import Data.Char (chr, isDigit, isHexDigit, isLower, isSpace, isLetter, isUpper, ord) import Data.Int (Int8, Int16, Int32, Int64) @@ -31,6 +31,7 @@ import Test.QuickCheck hiding ((.&.)) import Test.QuickCheck.Monadic import Test.QuickCheck.Property (Property(..)) +import Test.QuickCheck.Unicode (char) import Tests.QuickCheckUtils import Tests.Utils import Text.Show.Functions () @@ -179,6 +180,33 @@ k <- choose (0,n) vectorOf k gen +-- See http://unicode.org/faq/utf_bom.html#gen8 +-- A sequence such as <110xxxxx2 0xxxxxxx2> is illegal ... +-- When faced with this illegal byte sequence ... a UTF-8 conformant process +-- must treat the first byte 110xxxxx2 as an illegal termination error +-- (e.g. filter it out or replace by 0xFFFD) ... +-- ... and continue processing at the second byte 0xxxxxxx2 +t_decode_with_error2 = + E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97]) === "xa" +t_decode_with_error3 = + E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xE0, 97, 97]) === "xaa" +t_decode_with_error4 = + E.decodeUtf8With (\_ _ -> Just 'x') (B.pack [0xF0, 97, 97, 97]) === "xaaa" + +t_decode_with_error2' = + case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97]) of + E.Some x _ _ -> x === "xa" +t_decode_with_error3' = + case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97]) of + E.Some x _ _ -> x === "xaa" +t_decode_with_error4' = + case E.streamDecodeUtf8With (\_ _ -> Just 'x') (B.pack [0xC2, 97, 97, 97]) of + E.Some x _ _ -> x === "xaaa" + +t_infix_concat bs1 text bs2 rep = + text `T.isInfixOf` + E.decodeUtf8With (\_ _ -> rep) (B.concat [bs1, E.encodeUtf8 text, bs2]) + s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList) where _types = s :: String sf_Eq p s = @@ -231,6 +259,13 @@ (fmap (second unpackS) . S.uncons . S.filter p) t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons) tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons) + +unsnoc xs@(_:_) = Just (init xs, last xs) +unsnoc [] = Nothing + +t_unsnoc = unsnoc `eqP` (fmap (first unpackS) . T.unsnoc) +tl_unsnoc = unsnoc `eqP` (fmap (first unpackS) . TL.unsnoc) + s_head = head `eqP` S.head sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p) t_head = head `eqP` T.head @@ -529,12 +564,20 @@ s_takeWhile_s p = L.takeWhile p `eqP` (unpackS . S.unstream . S.takeWhile p) sf_takeWhile q p = (L.takeWhile p . L.filter q) `eqP` (unpackS . S.takeWhile p . S.filter q) +noMatch = do + c <- char + d <- suchThat char (/= c) + return (c,d) t_takeWhile p = L.takeWhile p `eqP` (unpackS . T.takeWhile p) tl_takeWhile p = L.takeWhile p `eqP` (unpackS . TL.takeWhile p) t_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP` (unpackS . T.takeWhileEnd p) +t_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> T.null $ + T.takeWhileEnd (==d) (T.snoc t c) tl_takeWhileEnd p = (L.reverse . L.takeWhile p . L.reverse) `eqP` (unpackS . TL.takeWhileEnd p) +tl_takeWhileEnd_null t = forAll noMatch $ \(c,d) -> TL.null $ + TL.takeWhileEnd (==d) (TL.snoc t c) s_dropWhile p = L.dropWhile p `eqP` (unpackS . S.dropWhile p) s_dropWhile_s p = L.dropWhile p `eqP` (unpackS . S.unstream . S.dropWhile p) sf_dropWhile q p = (L.dropWhile p . L.filter q) `eqP` @@ -939,6 +982,15 @@ testGroup "errors" [ testProperty "t_utf8_err" t_utf8_err, testProperty "t_utf8_err'" t_utf8_err' + ], + testGroup "error recovery" [ + testProperty "t_decode_with_error2" t_decode_with_error2, + testProperty "t_decode_with_error3" t_decode_with_error3, + testProperty "t_decode_with_error4" t_decode_with_error4, + testProperty "t_decode_with_error2'" t_decode_with_error2', + testProperty "t_decode_with_error3'" t_decode_with_error3', + testProperty "t_decode_with_error4'" t_decode_with_error4', + testProperty "t_infix_concat" t_infix_concat ] ], @@ -982,6 +1034,8 @@ testProperty "sf_uncons" sf_uncons, testProperty "t_uncons" t_uncons, testProperty "tl_uncons" tl_uncons, + testProperty "t_unsnoc" t_unsnoc, + testProperty "tl_unsnoc" tl_unsnoc, testProperty "s_head" s_head, testProperty "sf_head" sf_head, testProperty "t_head" t_head, @@ -1164,7 +1218,9 @@ testProperty "t_takeWhile" t_takeWhile, testProperty "tl_takeWhile" tl_takeWhile, testProperty "t_takeWhileEnd" t_takeWhileEnd, + testProperty "t_takeWhileEnd_null" t_takeWhileEnd_null, testProperty "tl_takeWhileEnd" tl_takeWhileEnd, + testProperty "tl_takeWhileEnd_null" tl_takeWhileEnd_null, testProperty "sf_dropWhile" sf_dropWhile, testProperty "s_dropWhile" s_dropWhile, testProperty "s_dropWhile_s" s_dropWhile_s, diff --git a/tests/Tests/Regressions.hs b/tests/Tests/Regressions.hs --- a/tests/Tests/Regressions.hs +++ b/tests/Tests/Regressions.hs @@ -72,6 +72,16 @@ assertEqual "mapAccumL should correctly size buffers for two-word results" (count * 2) (T.lengthWord16 (snd val)) +-- See GitHub #197 +t197 :: IO () +t197 = + assertBool "length (filter (==',') \"0,00\") should be 1" (currencyParser "0,00") + where + currencyParser x = cond == 1 + where + cond = length fltr + fltr = filter (== ',') x + tests :: F.Test tests = F.testGroup "Regressions" [ F.testCase "hGetContents_crash" hGetContents_crash @@ -79,4 +89,5 @@ , F.testCase "mapAccumL_resize" mapAccumL_resize , F.testCase "replicate_crash" replicate_crash , F.testCase "utf8_decode_unsafe" utf8_decode_unsafe + , F.testCase "t197" t197 ] diff --git a/text.cabal b/text.cabal --- a/text.cabal +++ b/text.cabal @@ -1,7 +1,7 @@ name: text -version: 1.2.2.2 -homepage: https://github.com/bos/text -bug-reports: https://github.com/bos/text/issues +version: 1.2.3.0 +homepage: https://github.com/haskell/text +bug-reports: https://github.com/haskell/text/issues synopsis: An efficient packed Unicode text type. description: . @@ -14,11 +14,13 @@ in terms of large data quantities and high speed. . The 'Text' type provides character-encoding, type-safe case - conversion via whole-string case conversion functions. It also - provides a range of functions for converting 'Text' values to and from - 'ByteStrings', using several standard encodings. + conversion via whole-string case conversion functions (see "Data.Text"). + It also provides a range of functions for converting 'Text' values to + and from 'ByteStrings', using several standard encodings + (see "Data.Text.Encoding"). . - Efficient locale-sensitive support for text IO is also supported. + Efficient locale-sensitive support for text IO is also supported + (see "Data.Text.IO"). . These modules are intended to be imported qualified, to avoid name clashes with Prelude functions, e.g. @@ -28,17 +30,21 @@ To use an extended and very rich family of functions for working with Unicode text (including normalization, regular expressions, non-standard encodings, text breaking, and locales), see - the @text-icu@ package: - + the [text-icu package](https://hackage.haskell.org/package/text-icu) + based on the well-respected and liberally + licensed [ICU library](http://site.icu-project.org/). license: BSD2 license-file: LICENSE author: Bryan O'Sullivan maintainer: Bryan O'Sullivan copyright: 2009-2011 Bryan O'Sullivan, 2008-2009 Tom Harper +bug-reports: https://github.com/haskell/text/issues category: Data, Text build-type: Simple cabal-version: >= 1.8 +tested-with: GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, + GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4 extra-source-files: -- scripts/CaseFolding.txt -- scripts/SpecialCasing.txt @@ -65,7 +71,9 @@ tests/text-tests.cabal flag bytestring-builder - description: Depend on the bytestring-builder package for backwards compatibility. + description: + Depend on the [bytestring-builder](https://hackage.haskell.org/package/bytestring-builder) + package for backwards compatibility. default: False manual: False @@ -75,7 +83,9 @@ manual: True flag integer-simple - description: Use the simple integer library instead of GMP + description: + Use the [simple integer library](http://hackage.haskell.org/package/integer-simple) + instead of [integer-gmp](http://hackage.haskell.org/package/integer-gmp) default: False manual: False @@ -160,20 +170,83 @@ test-suite tests type: exitcode-stdio-1.0 - hs-source-dirs: tests . - main-is: Tests.hs c-sources: cbits/cbits.c include-dirs: include ghc-options: - -Wall -threaded -O0 -rtsopts + -Wall -threaded -rtsopts cpp-options: -DASSERTS -DHAVE_DEEPSEQ -DTEST_SUITE + -- modules specific to test-suite + hs-source-dirs: tests + main-is: Tests.hs + other-modules: + Tests.Properties + Tests.Properties.Mul + Tests.QuickCheckUtils + Tests.Regressions + Tests.SlowFunctions + Tests.Utils + + -- Same as in `library` stanza; this is needed by cabal for accurate + -- file-monitoring as well as to avoid `-Wmissing-home-modules` + -- warnings We can't use an inter-package library dependency because + -- of different `ghc-options`/`cpp-options` (as a side-benefitt, + -- this enables per-component build parallelism in `cabal + -- new-build`!); We could, however, use cabal-version:2.2's `common` + -- blocks at some point in the future to reduce the duplication. + hs-source-dirs: . + other-modules: + Data.Text + Data.Text.Array + Data.Text.Encoding + Data.Text.Encoding.Error + Data.Text.Foreign + Data.Text.IO + Data.Text.Internal + Data.Text.Internal.Builder + Data.Text.Internal.Builder.Functions + Data.Text.Internal.Builder.Int.Digits + Data.Text.Internal.Builder.RealFloat.Functions + Data.Text.Internal.Encoding.Fusion + Data.Text.Internal.Encoding.Fusion.Common + Data.Text.Internal.Encoding.Utf16 + Data.Text.Internal.Encoding.Utf32 + Data.Text.Internal.Encoding.Utf8 + Data.Text.Internal.Functions + Data.Text.Internal.Fusion + Data.Text.Internal.Fusion.CaseMapping + Data.Text.Internal.Fusion.Common + Data.Text.Internal.Fusion.Size + Data.Text.Internal.Fusion.Types + Data.Text.Internal.IO + Data.Text.Internal.Lazy + Data.Text.Internal.Lazy.Encoding.Fusion + Data.Text.Internal.Lazy.Fusion + Data.Text.Internal.Lazy.Search + Data.Text.Internal.Private + Data.Text.Internal.Read + Data.Text.Internal.Search + Data.Text.Internal.Unsafe + Data.Text.Internal.Unsafe.Char + Data.Text.Internal.Unsafe.Shift + Data.Text.Lazy + Data.Text.Lazy.Builder + Data.Text.Lazy.Builder.Int + Data.Text.Lazy.Builder.RealFloat + Data.Text.Lazy.Encoding + Data.Text.Lazy.IO + Data.Text.Lazy.Internal + Data.Text.Lazy.Read + Data.Text.Read + Data.Text.Unsafe + Data.Text.Show + build-depends: HUnit >= 1.2, - QuickCheck >= 2.7, + QuickCheck >= 2.7 && < 2.10, array, base, binary, @@ -201,7 +274,7 @@ source-repository head type: git - location: https://github.com/bos/text + location: https://github.com/haskell/text source-repository head type: mercurial