diff --git a/Data/Text.hs b/Data/Text.hs --- a/Data/Text.hs +++ b/Data/Text.hs @@ -261,8 +261,7 @@ {-# INLINE (==) #-} instance Ord Text where - compare t1 t2 = compare (stream t1) (stream t2) - {-# INLINE compare #-} + compare = compareText instance Show Text where showsPrec p ps r = showsPrec p (unpack ps) r @@ -303,6 +302,20 @@ #else dataTypeOf _ = mkNorepType "Data.Text.Text" #endif + +-- | /O(n)/ Compare two 'Text' values lexicographically. +compareText :: Text -> Text -> Ordering +compareText ta@(Text _arrA _offA lenA) tb@(Text _arrB _offB lenB) + | lenA == 0 && lenB == 0 = EQ + | otherwise = go 0 0 + where + go !i !j + | i >= lenA || j >= lenB = compare lenA lenB + | a < b = LT + | a > b = GT + | otherwise = go (i+di) (j+dj) + where Iter a di = iter ta i + Iter b dj = iter tb j -- ----------------------------------------------------------------------------- -- * Conversion to/from 'Text' diff --git a/Data/Text/Lazy.hs b/Data/Text/Lazy.hs --- a/Data/Text/Lazy.hs +++ b/Data/Text/Lazy.hs @@ -223,8 +223,24 @@ {-# INLINE (==) #-} instance Ord Text where - compare t1 t2 = compare (stream t1) (stream t2) - {-# INLINE compare #-} + compare = compareText + +compareText :: Text -> Text -> Ordering +compareText Empty Empty = EQ +compareText Empty _ = LT +compareText _ Empty = GT +compareText (Chunk a0 as) (Chunk b0 bs) = outer a0 b0 + where + outer ta@(T.Text arrA offA lenA) tb@(T.Text arrB offB lenB) = go 0 0 + where + go !i !j + | i >= lenA = compareText as (chunk (T.Text arrB (offB+j) (lenB-j)) bs) + | j >= lenB = compareText (chunk (T.Text arrA (offA+i) (lenA-i)) as) bs + | a < b = LT + | a > b = GT + | otherwise = go (i+di) (j+dj) + where T.Iter a di = T.iter ta i + T.Iter b dj = T.iter tb j instance Show Text where showsPrec p ps r = showsPrec p (unpack ps) r 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 @@ -22,49 +22,96 @@ ) where import Control.Monad (liftM) -import Data.Char (digitToInt, isDigit, isHexDigit, ord) -import Data.Ratio +import Data.Char (isDigit, isHexDigit, ord) +import Data.Ratio ((%)) import Data.Text.Lazy as T --- | Read some text, and if the read succeeds, return its value and --- the remaining text. +-- | Read some text. If the read succeeds, return its value and the +-- remaining text, otherwise an error message. type Reader a = Text -> Either String (a,Text) --- | Read a decimal integer. +-- | Read a decimal integer. The input must begin with at least one +-- decimal digit, and is consumed until a non-digit or end of string +-- is reached. -- -- This function does not handle leading sign characters. If you need -- to handle signed input, use @'signed' 'decimal'@. +-- +-- /Note/: For fixed-width integer types, this function does not +-- attempt to detect overflow, so a sufficiently long input may give +-- incorrect results. decimal :: Integral a => Reader a {-# SPECIALIZE decimal :: Reader Int #-} {-# SPECIALIZE decimal :: Reader Integer #-} decimal txt - | T.null h = Left "no digits in input" + | T.null h = Left "input does not start with a digit" | otherwise = Right (T.foldl' go 0 h, t) where (h,t) = T.spanBy isDigit txt go n d = (n * 10 + fromIntegral (digitToInt d)) --- | Read a hexadecimal number, with optional leading @\"0x\"@. This --- function is case insensitive. +-- | Read a hexadecimal integer, consisting of an optional leading +-- @\"0x\"@ followed by at least one decimal digit. Input is consumed +-- until a non-hex-digit or end of string is reached. This function +-- is case insensitive. -- -- This function does not handle leading sign characters. If you need -- to handle signed input, use @'signed' 'hexadecimal'@. +-- +-- /Note/: For fixed-width integer types, this function does not +-- attempt to detect overflow, so a sufficiently long input may give +-- incorrect results. hexadecimal :: Integral a => Reader a -{-# SPECIALIZE hex :: Reader Int #-} -{-# SPECIALIZE hex :: Reader Integer #-} +{-# SPECIALIZE hexadecimal :: Reader Int #-} +{-# SPECIALIZE hexadecimal :: Reader Integer #-} hexadecimal txt - | T.toLower h == "0x" = hex t - | otherwise = hex txt + | h == "0x" || h == "0X" = hex t + | otherwise = hex txt where (h,t) = T.splitAt 2 txt --- | Read a leading sign character (@\'-\'@ or @\'+\'@) and apply it --- to the result of applying the given reader. +hex :: Integral a => Reader a +{-# SPECIALIZE hex :: Reader Int #-} +{-# SPECIALIZE hex :: Reader Integer #-} +hex txt + | T.null h = Left "input does not start with a hexadecimal digit" + | otherwise = Right (T.foldl' go 0 h, t) + where (h,t) = T.spanBy isHexDigit txt + go n d = (n * 16 + fromIntegral (hexDigitToInt d)) + +hexDigitToInt :: Char -> Int +hexDigitToInt c + | c >= '0' && c <= '9' = ord c - ord '0' + | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10) + | otherwise = ord c - (ord 'A' - 10) + +digitToInt :: Char -> Int +digitToInt c = ord c - ord '0' + +-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and +-- apply it to the result of applying the given reader. signed :: Num a => Reader a -> Reader a {-# INLINE signed #-} signed f = runP (signa (P f)) -- | Read a rational number. -- --- This function accepts an optional leading sign character. +-- This function accepts an optional leading sign character, followed +-- by at least one decimal digit. The syntax similar to that accepted +-- by the 'read' function, with the exception that a trailing @\'.\'@ +-- or @\'e\'@ /not/ followed by a number is not consumed. +-- +-- Examples: +-- +-- >rational "3" == Right (3.0, "") +-- >rational "3.1" == Right (3.1, "") +-- >rational "3e4" == Right (30000.0, "") +-- >rational "3.1e4" == Right (31000.0, "") +-- >rational ".3" == Left "input does not start with a digit" +-- >rational "e3" == Left "input does not start with a digit" +-- +-- Examples of differences from 'read': +-- +-- >rational "3.foo" == Right (3.0, ".foo") +-- >rational "3e" == Right (3.0, "e") rational :: RealFloat a => Reader a {-# SPECIALIZE rational :: Reader Double #-} rational = floaty $ \real frac fracDenom -> fromRational $ @@ -72,7 +119,7 @@ -- | Read a rational number. -- --- This function accepts an optional leading sign character. +-- The syntax accepted by this function is the same as for 'rational'. -- -- /Note/: This function is almost ten times faster than 'rational', -- but is slightly less accurate. @@ -87,22 +134,6 @@ fromIntegral real + fromIntegral frac / fromIntegral fracDenom -hex :: Integral a => Reader a -{-# SPECIALIZE hex :: Reader Int #-} -{-# SPECIALIZE hex :: Reader Integer #-} -hex txt - | T.null h = Left "no digits in input" - | otherwise = Right (T.foldl' go 0 h, t) - where (h,t) = T.spanBy isHexDigit txt - go n d = (n * 16 + fromIntegral (hexDigitToInt d)) - -hexDigitToInt :: Char -> Int -hexDigitToInt c - | c >= '0' && c <= '9' = ord c - ord '0' - | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10) - | c >= 'A' && c <= 'F' = ord c - (ord 'A' - 10) - | otherwise = error "Data.Text.Lex.hexDigitToInt: bad input" - signa :: Num a => Parser a -> Parser a {-# SPECIALIZE signa :: Parser Int -> Parser Int #-} {-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-} @@ -111,7 +142,7 @@ if sign == '+' then p else negate `liftM` p newtype Parser a = P { - runP :: Text -> Either String (a,Text) + runP :: Reader a } instance Monad Parser where @@ -131,7 +162,7 @@ char :: (Char -> Bool) -> Parser Char char p = P $ \t -> case T.uncons t of Just (c,t') | p c -> Right (c,t') - _ -> Left "char" + _ -> Left "character does not match" data T = T !Integer !Int diff --git a/Data/Text/Read.hs b/Data/Text/Read.hs --- a/Data/Text/Read.hs +++ b/Data/Text/Read.hs @@ -22,49 +22,96 @@ ) where import Control.Monad (liftM) -import Data.Char (digitToInt, isDigit, isHexDigit, ord) -import Data.Ratio +import Data.Char (isDigit, isHexDigit, ord) +import Data.Ratio ((%)) import Data.Text as T --- | Read some text, and if the read succeeds, return its value and --- the remaining text. +-- | Read some text. If the read succeeds, return its value and the +-- remaining text, otherwise an error message. type Reader a = Text -> Either String (a,Text) --- | Read a decimal integer. +-- | Read a decimal integer. The input must begin with at least one +-- decimal digit, and is consumed until a non-digit or end of string +-- is reached. -- -- This function does not handle leading sign characters. If you need -- to handle signed input, use @'signed' 'decimal'@. +-- +-- /Note/: For fixed-width integer types, this function does not +-- attempt to detect overflow, so a sufficiently long input may give +-- incorrect results. decimal :: Integral a => Reader a {-# SPECIALIZE decimal :: Reader Int #-} {-# SPECIALIZE decimal :: Reader Integer #-} decimal txt - | T.null h = Left "no digits in input" + | T.null h = Left "input does not start with a digit" | otherwise = Right (T.foldl' go 0 h, t) where (h,t) = T.spanBy isDigit txt go n d = (n * 10 + fromIntegral (digitToInt d)) --- | Read a hexadecimal number, with optional leading @\"0x\"@. This --- function is case insensitive. +-- | Read a hexadecimal integer, consisting of an optional leading +-- @\"0x\"@ followed by at least one decimal digit. Input is consumed +-- until a non-hex-digit or end of string is reached. This function +-- is case insensitive. -- -- This function does not handle leading sign characters. If you need -- to handle signed input, use @'signed' 'hexadecimal'@. +-- +-- /Note/: For fixed-width integer types, this function does not +-- attempt to detect overflow, so a sufficiently long input may give +-- incorrect results. hexadecimal :: Integral a => Reader a -{-# SPECIALIZE hex :: Reader Int #-} -{-# SPECIALIZE hex :: Reader Integer #-} +{-# SPECIALIZE hexadecimal :: Reader Int #-} +{-# SPECIALIZE hexadecimal :: Reader Integer #-} hexadecimal txt - | T.toLower h == "0x" = hex t - | otherwise = hex txt + | h == "0x" || h == "0X" = hex t + | otherwise = hex txt where (h,t) = T.splitAt 2 txt --- | Read a leading sign character (@\'-\'@ or @\'+\'@) and apply it --- to the result of applying the given reader. +hex :: Integral a => Reader a +{-# SPECIALIZE hex :: Reader Int #-} +{-# SPECIALIZE hex :: Reader Integer #-} +hex txt + | T.null h = Left "input does not start with a hexadecimal digit" + | otherwise = Right (T.foldl' go 0 h, t) + where (h,t) = T.spanBy isHexDigit txt + go n d = (n * 16 + fromIntegral (hexDigitToInt d)) + +hexDigitToInt :: Char -> Int +hexDigitToInt c + | c >= '0' && c <= '9' = ord c - ord '0' + | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10) + | otherwise = ord c - (ord 'A' - 10) + +digitToInt :: Char -> Int +digitToInt c = ord c - ord '0' + +-- | Read an optional leading sign character (@\'-\'@ or @\'+\'@) and +-- apply it to the result of applying the given reader. signed :: Num a => Reader a -> Reader a {-# INLINE signed #-} signed f = runP (signa (P f)) -- | Read a rational number. -- --- This function accepts an optional leading sign character. +-- This function accepts an optional leading sign character, followed +-- by at least one decimal digit. The syntax similar to that accepted +-- by the 'read' function, with the exception that a trailing @\'.\'@ +-- or @\'e\'@ /not/ followed by a number is not consumed. +-- +-- Examples: +-- +-- >rational "3" == Right (3.0, "") +-- >rational "3.1" == Right (3.1, "") +-- >rational "3e4" == Right (30000.0, "") +-- >rational "3.1e4" == Right (31000.0, "") +-- >rational ".3" == Left "input does not start with a digit" +-- >rational "e3" == Left "input does not start with a digit" +-- +-- Examples of differences from 'read': +-- +-- >rational "3.foo" == Right (3.0, ".foo") +-- >rational "3e" == Right (3.0, "e") rational :: RealFloat a => Reader a {-# SPECIALIZE rational :: Reader Double #-} rational = floaty $ \real frac fracDenom -> fromRational $ @@ -72,7 +119,7 @@ -- | Read a rational number. -- --- This function accepts an optional leading sign character. +-- The syntax accepted by this function is the same as for 'rational'. -- -- /Note/: This function is almost ten times faster than 'rational', -- but is slightly less accurate. @@ -87,22 +134,6 @@ fromIntegral real + fromIntegral frac / fromIntegral fracDenom -hex :: Integral a => Reader a -{-# SPECIALIZE hex :: Reader Int #-} -{-# SPECIALIZE hex :: Reader Integer #-} -hex txt - | T.null h = Left "no digits in input" - | otherwise = Right (T.foldl' go 0 h, t) - where (h,t) = T.spanBy isHexDigit txt - go n d = (n * 16 + fromIntegral (hexDigitToInt d)) - -hexDigitToInt :: Char -> Int -hexDigitToInt c - | c >= '0' && c <= '9' = ord c - ord '0' - | c >= 'a' && c <= 'f' = ord c - (ord 'a' - 10) - | c >= 'A' && c <= 'F' = ord c - (ord 'A' - 10) - | otherwise = error "Data.Text.Lex.hexDigitToInt: bad input" - signa :: Num a => Parser a -> Parser a {-# SPECIALIZE signa :: Parser Int -> Parser Int #-} {-# SPECIALIZE signa :: Parser Integer -> Parser Integer #-} @@ -111,7 +142,7 @@ if sign == '+' then p else negate `liftM` p newtype Parser a = P { - runP :: Text -> Either String (a,Text) + runP :: Reader a } instance Monad Parser where @@ -131,7 +162,7 @@ char :: (Char -> Bool) -> Parser Char char p = P $ \t -> case T.uncons t of Just (c,t') | p c -> Right (c,t') - _ -> Left "char" + _ -> Left "character does not match" data T = T !Integer !Int diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -19,15 +19,15 @@ # Get involved! Please report bugs via the -[bitbucket issue tracker](http://bitbucket.org/bos/attoparsec/statistics). +[bitbucket issue tracker](http://bitbucket.org/bos/text/issues). -Master [Mercurial repository](http://bitbucket.org/bos/statistics): +Master [Mercurial repository](http://bitbucket.org/bos/text): -* `hg clone http://bitbucket.org/bos/statistics` +* `hg clone http://bitbucket.org/bos/text` -There's also a [git mirror](http://github.com/bos/statistics): +There's also a [git mirror](http://github.com/bos/text): -* `git clone git://github.com/bos/statistics.git` +* `git clone git://github.com/bos/text.git` (You can create and contribute changes using either Mercurial or git.) diff --git a/TODO b/TODO deleted file mode 100644 --- a/TODO +++ /dev/null @@ -1,6 +0,0 @@ -Normalization. - -Collation. - -Case conversion lacks locale sensitivity, so cannot handle a few -Turkic and Azeri code points completely correctly. diff --git a/tests/benchmarks/Equality.hs b/tests/benchmarks/Equality.hs --- a/tests/benchmarks/Equality.hs +++ b/tests/benchmarks/Equality.hs @@ -6,25 +6,20 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL -bytestring haystack = do - ls <- B.lines `fmap` B.readFile haystack +func :: (Eq a) => [a] -> IO () +func ls = print . sum . map (\needle -> length . filter (==needle) $ ls) $ take 100 ls -lazyBytestring haystack = do - ls <- BL.lines `fmap` BL.readFile haystack - print . sum . map (\needle -> length . filter (==needle) $ ls) $ take 100 ls +bytestring haystack = func =<< B.lines `fmap` B.readFile haystack -text haystack = do - ls <- (T.lines . T.decodeUtf8) `fmap` B.readFile haystack - print . sum . map (\needle -> length . filter (==needle) $ ls) $ take 100 ls +lazyBytestring haystack = func =<< BL.lines `fmap` BL.readFile haystack -lazyText haystack = do - ls <- (TL.lines . TL.decodeUtf8) `fmap` BL.readFile haystack - print . sum . map (\needle -> length . filter (==needle) $ ls) $ take 100 ls +text haystack = func =<< (T.lines . T.decodeUtf8) `fmap` B.readFile haystack -string haystack = do - ls <- lines `fmap` readFile haystack - print . sum . map (\needle -> length . filter (==needle) $ ls) $ take 100 ls +lazyText haystack = func =<< + (TL.lines . TL.decodeUtf8) `fmap` BL.readFile haystack + +string haystack = func =<< lines `fmap` readFile haystack main = do args <- getArgs diff --git a/text.cabal b/text.cabal --- a/text.cabal +++ b/text.cabal @@ -1,5 +1,5 @@ name: text -version: 0.9.1.0 +version: 0.10.0.0 homepage: http://bitbucket.org/bos/text bug-reports: http://bitbucket.org/bos/text/issues synopsis: An efficient packed Unicode text type. @@ -30,7 +30,7 @@ license-file: LICENSE author: Bryan O'Sullivan maintainer: Bryan O'Sullivan - Tom Harper + Tom Harper Duncan Coutts copyright: 2008-2009 Tom Harper, 2009-2010 Bryan O'Sullivan category: Data, Text @@ -38,7 +38,6 @@ cabal-version: >= 1.6 extra-source-files: README.markdown - TODO -- scripts/CaseFolding.txt -- scripts/SpecialCasing.txt scripts/ApiCompare.hs