diff --git a/Data/Attoparsec/Text.hs b/Data/Attoparsec/Text.hs --- a/Data/Attoparsec/Text.hs +++ b/Data/Attoparsec/Text.hs @@ -1,6 +1,6 @@ -- | -- Module : Data.Attoparsec.Text --- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2010 +-- Copyright : Felipe Lessa 2010-2011, Bryan O'Sullivan 2007-2010 -- License : BSD3 -- -- Maintainer : felipe.lessa@gmail.com @@ -27,9 +27,9 @@ -- * Running parsers , parse - , feed - , parseWith , parseTest + , parseWith + , feed -- ** Result conversion , maybeResult @@ -48,59 +48,84 @@ , I.satisfyWith , I.skip + -- ** Special character parsers + -- $specialcharparsers + , I.digit + , I.letter + , I.space + -- ** Character classes , I.inClass , I.notInClass -- * Efficient string handling , I.string + , I.skipSpace , I.skipWhile , I.take , I.takeWhile , I.takeWhile1 , I.takeTill + -- * Text parsing + , I.endOfLine + + -- * Numeric parsers + , I.decimal + , I.hexadecimal + , I.signed + , I.double + , I.rational + -- * State observation and manipulation functions , I.endOfInput , I.ensure + + -- * Applicative specializations + -- $applicative + , (<*.) + , (.*>) ) where +import Control.Applicative (Applicative, (<*), (*>)) import Data.Attoparsec.Combinator import qualified Data.Attoparsec.Text.Internal as I import qualified Data.Text as T -- $parsec -- --- Compared to Parsec 3, Attoparsec makes several tradeoffs. It is --- not intended for, or ideal for, all possible uses. +-- Compared to Parsec 3, @attoparsec-text@ makes several +-- tradeoffs. It is not intended for, or ideal for, all possible +-- uses. -- --- * While Attoparsec can consume input incrementally, Parsec cannot. --- Incremental input is a huge deal for efficient and secure network --- and system programming, since it gives much more control to users --- of the library over matters such as resource usage and the I/O --- model to use. +-- * While @attoparsec-text@ can consume input incrementally, +-- Parsec cannot. Incremental input is a huge deal for +-- efficient and secure network and system programming, since +-- it gives much more control to users of the library over +-- matters such as resource usage and the I/O model to use. -- --- * Much of the performance advantage of Attoparsec is gained via --- high-performance parsers such as 'I.takeWhile' and 'I.string'. --- If you use complicated combinators that return lists of --- characters, there really isn't much performance difference the --- two libraries. +-- * Much of the performance advantage of @attoparsec-text@ is +-- gained via high-performance parsers such as 'I.takeWhile' +-- and 'I.string'. If you use complicated combinators that +-- return lists of characters, there really isn't much +-- performance difference the two libraries. -- --- * Unlike Parsec 3, Attoparsec does not support being used as a --- monad transformer. This is mostly a matter of the implementor --- not having needed that functionality. +-- * Unlike Parsec 3, @attoparsec-text@ does not support being +-- used as a monad transformer. This is mostly a matter of the +-- implementor not having needed that functionality. -- --- * Attoparsec is specialised to deal only with strict 'T.Text' --- input. Efficiency concernts rule out both lists and lazy --- texts. The usual use for lazy texts would be to allow --- consumption of very large input without a large footprint. --- For this need, Attoparsec's incremental input provides an --- excellent substitute, with much more control over when input --- takes place. +-- * @attoparsec-text@ is specialised to deal only with strict +-- 'T.Text' input. Efficiency concernts rule out both lists +-- and lazy texts. The usual use for lazy texts would be to +-- allow consumption of very large input without a large +-- footprint. For this need, @attoparsec-text@'s incremental +-- input provides an excellent substitute, with much more +-- control over when input takes place. -- -- * Parsec parsers can produce more helpful error messages than --- Attoparsec parsers. This is a matter of focus: Attoparsec avoids --- the extra book-keeping in favour of higher performance. +-- @attoparsec-text@ parsers. This is a matter of focus: +-- @attoparsec-text@ avoids the extra book-keeping in favour of +-- higher performance. -- $performance -- @@ -220,3 +245,34 @@ eitherResult (Done _ r) = Right r eitherResult (Fail _ _ msg) = Left msg eitherResult _ = Left "Result: incomplete input" + +-- $specialcharparsers +-- +-- Special parser for characters. Unlike the original +-- @attoparsec@ package, these parsers do work correctly for all +-- encodings. Internally "Data.Char" module is used. + + +-- $applicative +-- +-- We provide specializations of @\<*@ and @*\>@ as @\<*.@ and +-- @.*\>@, respectively. Together with @IsString@ instance of +-- 'I.Parser', you may write parsers applicatively more easily. +-- For example: +-- +-- > paren p = "(" .*> p <*. ")" +-- +-- instead of the more verbose +-- +-- > paren p = string "(" *> p <* string ")" + +-- | Same as @Applicative@'s @\<*@ but specialized to 'T.Text' +-- on the second argument. +(<*.) :: Applicative f => f a -> f T.Text -> f a +(<*.) = (<*) + +-- | Same as @Applicative@'s @*\>@ but specialized to 'T.Text' +-- on the first argument. +(.*>) :: Applicative f => f T.Text -> f a -> f a +(.*>) = (*>) + diff --git a/Data/Attoparsec/Text/Internal.hs b/Data/Attoparsec/Text/Internal.hs --- a/Data/Attoparsec/Text/Internal.hs +++ b/Data/Attoparsec/Text/Internal.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE Rank2Types, RecordWildCards #-} +{-# LANGUAGE Rank2Types, RecordWildCards, FlexibleInstances #-} -- | -- Module : Data.Attoparsec.Text.Internal --- Copyright : Felipe Lessa 2010, Bryan O'Sullivan 2007-2010 +-- Copyright : Felipe Lessa 2010-2011, Bryan O'Sullivan 2007-2010 -- License : BSD3 -- -- Maintainer : felipe.lessa@gmail.com @@ -38,8 +38,14 @@ , inClass , notInClass + -- ** Special character parsers + , digit + , letter + , space + -- * Efficient string handling , skipWhile + , skipSpace , string , stringTransform , take @@ -47,6 +53,13 @@ , takeWhile1 , takeTill + -- * Numeric parsers + , decimal + , hexadecimal + , signed + , double + , rational + -- * State observation and manipulation functions , endOfInput , ensure @@ -59,7 +72,10 @@ import Control.Monad (MonadPlus(..), when) import Data.Attoparsec.Combinator import Data.Attoparsec.Text.FastSet (charClass, member) +import Data.Char import Data.Monoid (Monoid(..)) +import Data.Ratio ((%)) +import Data.String (IsString(..)) import Prelude hiding (getChar, take, takeWhile) import qualified Data.Text as T @@ -78,6 +94,9 @@ type Failure r = S -> [String] -> String -> Result r type Success a r = S -> a -> Result r +instance IsString (Parser T.Text) where + fromString = string . T.pack + -- | Have we read all available input? data More = Complete | Incomplete deriving (Eq, Show) @@ -240,6 +259,7 @@ case T.uncons s of Just (h,t) | p h -> put t >> return h | otherwise -> fail "satisfy" + Nothing -> error "Data.Attoparsec.Text.Internal.satisfy: never here" -- | The parser @skip p@ succeeds for any character for which the -- predicate @p@ returns 'True'. @@ -253,6 +273,7 @@ case T.uncons s of Just (h,t) | p h -> put t | otherwise -> fail "skip" + Nothing -> error "Data.Attoparsec.Text.Internal.skip: never here" -- | The parser @satisfyWith f p@ transforms a character, and @@ -269,6 +290,21 @@ then put t >> return c else fail "satisfyWith" +-- | Parse a single digit. +digit :: Parser Char +digit = satisfy isDigit "digit" +{-# INLINE digit #-} + +-- | Parse a single letter. +letter :: Parser Char +letter = satisfy isLetter "letter" +{-# INLINE letter #-} + +-- | Parse a space character. +space :: Parser Char +space = satisfy isSpace "space" +{-# INLINE space #-} + -- | Consume @n@ characters of input, but succeed only if the -- predicate returns 'True'. takeWith :: Int -> (T.Text -> Bool) -> Parser T.Text @@ -322,6 +358,11 @@ put t when (T.null t) go +-- | Skip over white space. +skipSpace :: Parser () +skipSpace = skipWhile isSpace >> return () +{-# INLINE skipSpace #-} + -- | Consume input as long as the predicate returns 'False' -- (i.e. until it returns 'True'), and return the consumed input. -- @@ -419,6 +460,119 @@ notChar :: Char -> Parser Char notChar c = satisfy (/= c) "not " ++ show c {-# INLINE notChar #-} + + +-- | Parse and decode an unsigned decimal number. +decimal :: Integral a => Parser a +{-# SPECIALISE decimal :: Parser Int #-} +{-# SPECIALISE decimal :: Parser Integer #-} +decimal = T.foldl' step 0 `fmap` takeWhile1 asciiIsDigit + where step a w = a * 10 + fromIntegral (fromEnum w - 48) + +asciiIsDigit :: Char -> Bool +asciiIsDigit c = c >= '0' && c <= '9' +{-# INLINE asciiIsDigit #-} + +-- | Parse and decode an unsigned hexadecimal number. The hex digits +-- @\'a\'@ through @\'f\'@ may be upper or lower case. +-- +-- This parser does not accept a leading @\"0x\"@ string. +hexadecimal :: Integral a => Parser a +{-# SPECIALISE hexadecimal :: Parser Int #-} +hexadecimal = T.foldl' step 0 `fmap` takeWhile1 asciiIsHexDigit + where step a c | c >= '0' && c <= '9' = a * 16 + fromIntegral (fromEnum c - 48) + | otherwise = a * 16 + fromIntegral (asciiToLower c - 87) + +asciiIsHexDigit :: Char -> Bool +asciiIsHexDigit c = asciiIsDigit c || (c >= 'a' && c <= 'f') || (c >= 'A' && c <= 'F') +{-# INLINE asciiIsHexDigit #-} + +asciiToLower :: Char -> Int +asciiToLower c | c >= 'A' && c <= 'Z' = fromEnum c + 32 + | otherwise = fromEnum c + +-- | Parse a number with an optional leading @\'+\'@ or @\'-\'@ sign +-- character. +signed :: Num a => Parser a -> Parser a +{-# SPECIALISE signed :: Parser Int -> Parser Int #-} +signed p = (negate <$> (char '-' *> p)) + <|> (char '+' *> p) + <|> p + +-- | Parse a rational number. +-- +-- This parser 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 with behaviour identical to 'read', if you feed an empty +-- continuation to the first result: +-- +-- >rational "3" == Done 3.0 "" +-- >rational "3.1" == Done 3.1 "" +-- >rational "3e4" == Done 30000.0 "" +-- >rational "3.1e4" == Done 31000.0 "" +-- +-- Examples with behaviour identical to 'read': +-- +-- >rational ".3" == Fail "input does not start with a digit" +-- >rational "e3" == Fail "input does not start with a digit" +-- +-- Examples of differences from 'read': +-- +-- >rational "3.foo" == Done 3.0 ".foo" +-- >rational "3e" == Done 3.0 "e" +rational :: RealFloat a => Parser a +{-# SPECIALIZE rational :: Parser Double #-} +rational = floaty $ \real frac fracDenom -> fromRational $ + real % 1 + frac % fracDenom + +-- | Parse a rational number. +-- +-- The syntax accepted by this parser is the same as for 'rational'. +-- +-- /Note/: This function is almost ten times faster than 'rational', +-- but is slightly less accurate. +-- +-- The 'Double' type supports about 16 decimal places of accuracy. +-- For 94.2% of numbers, this function and 'rational' give identical +-- results, but for the remaining 5.8%, this function loses precision +-- around the 15th decimal place. For 0.001% of numbers, this +-- function will lose precision at the 13th or 14th decimal place. +double :: Parser Double +double = floaty $ \real frac fracDenom -> + fromIntegral real + + fromIntegral frac / fromIntegral fracDenom + +data T = T !Integer !Int + +floaty :: RealFloat a => (Integer -> Integer -> Integer -> a) -> Parser a +{-# INLINE floaty #-} +floaty f = do + sign <- satisfy (\c -> c == '-' || c == '+') <|> return '+' + real <- decimal + let tryFraction = do + _ <- satisfy (== '.') + ds <- takeWhile asciiIsDigit + case (case parse decimal ds of + Partial k -> k T.empty + r -> r) of + Done _ n -> return $ T n (T.length ds) + _ -> fail "no digits after decimal" + T fraction fracDigits <- tryFraction <|> return (T 0 0) + let e c = c == 'e' || c == 'E' + power <- (satisfy e *> signed decimal) <|> return (0 :: Int) + let n = if fracDigits == 0 + then if power == 0 + then fromIntegral real + else fromIntegral real * (10 ^^ power) + else if power == 0 + then f real fraction (10 ^ fracDigits) + else f real fraction (10 ^ fracDigits) * (10 ^^ power) + return $! if sign == '+' then n else -n + + -- | Match only if all input has been consumed. endOfInput :: Parser () diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -9,21 +9,12 @@ I'm happy to receive bug reports, fixes, documentation enhancements, and other improvements. -Please report bugs via the -[bitbucket issue tracker](http://bitbucket.org/bos/attoparsec/issues). - -Master [Mercurial repository](http://bitbucket.org/bos/attoparsec): - -* `hg clone http://bitbucket.org/bos/attoparsec` - -There's also a [git mirror](http://github.com/bos/attoparsec): - -* `git clone git://github.com/bos/attoparsec.git` +Master [darcs repository](http://patch-tag.com/r/felipe/attoparsec-text/home): -(You can create and contribute changes using either Mercurial or git.) +* `darcs get http://patch-tag.com/r/felipe/attoparsec-text` Authors ------- -This library is written and maintained by Bryan O'Sullivan, -. +This library is written by Felipe Lessa as a port of Bryan +O'Sullivan's attoparsec. diff --git a/attoparsec-text.cabal b/attoparsec-text.cabal --- a/attoparsec-text.cabal +++ b/attoparsec-text.cabal @@ -1,5 +1,5 @@ name: attoparsec-text -version: 0.8.0.0 +version: 0.8.2.0 license: BSD3 license-file: LICENSE category: Text, Parsing @@ -9,7 +9,7 @@ tested-with: GHC == 6.12.1 synopsis: Fast combinator parsing for texts cabal-version: >= 1.6 --- homepage: http://bitbucket.org/bos/attoparsec +homepage: http://patch-tag.com/r/felipe/attoparsec-text/home -- bug-reports: http://bitbucket.org/bos/attoparsec/issues build-type: Simple description: @@ -19,11 +19,23 @@ . This library is basically a translation of the original attoparsec library to use text instead of bytestrings. + . + Changes in version 0.8.2.0: + . + * Add @IsString@ instance to @Parser@. + . + * Add specializations of @\<*@ and @*\>@, see the docs for + more information. + . + * Add @digit@, @letter@, @space@, @decimal@, @hexadecimal@, + @signed@, @double@ and @rational@. extra-source-files: README.markdown benchmarks/Makefile + benchmarks/Double.hs benchmarks/Tiny.hs benchmarks/med.txt.bz2 + benchmarks/double_test.txt.bz2 tests/Makefile tests/QC.hs tests/QCSupport.hs @@ -46,4 +58,4 @@ Data.Attoparsec.Text.Lazy other-modules: Data.Attoparsec.Text.Internal ghc-options: -Wall - ghc-prof-options: -auto-all +-- ghc-prof-options: -auto-all diff --git a/benchmarks/Double.hs b/benchmarks/Double.hs new file mode 100644 --- /dev/null +++ b/benchmarks/Double.hs @@ -0,0 +1,95 @@ +import Control.Applicative ((<|>)) +import Control.Monad (forM_, MonadPlus(mzero)) +import Data.Char (isDigit, isLetter) +import Data.List (foldl') +import System.Environment (getArgs) +import qualified Data.Attoparsec.Text as A +import qualified Data.Text as T +import qualified Data.Text.IO as T +import qualified Data.Text.Read as TR +import qualified Text.ParserCombinators.Parsec as P + +attoparsec_text_builtin args = do + forM_ args $ \arg -> do + input <- T.readFile arg + case A.parse (A.many1 (A.char '#' >> p)) input `A.feed` T.empty of + A.Done _ xs -> print (sum xs :: Double) + what -> print what + where + p = A.double + +---------------------------------------------------------------------- + +attoparsec_text_laforge args = do + forM_ args $ \arg -> do + input <- T.readFile arg + case A.parse (A.many1 (A.char '#' >> p)) input `A.feed` T.empty of + A.Done _ xs -> print (sum xs :: Double) + what -> print what + where + p = do + i <- A.takeWhile isDigit + f <- A.option T.empty (A.char '.' >> A.takeWhile1 isDigit) + if (T.null i && T.null f) + then mzero + else return $ fromIntegral (dec i) + + fromIntegral (dec f) / fromIntegral (10 ^ (T.length f)) + where + dec = T.foldl' (\acc c -> acc * 10 + fromEnum c - 48) 0 + +attoparsec_text_laforge_discarding args = do + forM_ args $ \arg -> do + input <- T.readFile arg + case A.parse (A.many1 (A.char '#' >> p)) input `A.feed` T.empty of + A.Done _ xs -> print (length xs) + what -> print what + where + p = do + i <- A.takeWhile isDigit + f <- A.option T.empty (A.char '.' >> A.takeWhile1 isDigit) + return () + +---------------------------------------------------------------------- + +parsec_laforge args = + forM_ args $ \arg -> do + input <- readFile arg + case P.parse (P.many1 (P.char '#' >> p)) "" input of + Left err -> print err + Right xs -> print (sum xs :: Double) + where + p = do + i <- P.many P.digit + f <- P.option "" (P.char '.' >> P.many1 P.digit) + if (null i && null f) + then mzero + else return $ fromIntegral (dec i) + + fromIntegral (dec f) / fromIntegral (10 ^ (length f)) + where + dec = foldl' (\acc c -> acc * 10 + fromEnum c - 48) 0 + +parsec_laforge_discarding args = + forM_ args $ \arg -> do + input <- readFile arg + case P.parse (P.many1 (P.char '#' >> p)) "" input of + Left err -> print err + Right xs -> print (length xs :: Int) + where + p = do + i <- P.many P.digit + f <- P.option "" (P.char '.' >> P.many1 P.digit) + return () + +---------------------------------------------------------------------- + +main = do + args <- getArgs + case args of + ("attoparsec_text_builtin":xs) -> attoparsec_text_builtin xs + ("attoparsec_text_laforge":xs) -> attoparsec_text_laforge xs + ("attoparsec_text_laforge_discarding":xs) -> attoparsec_text_laforge_discarding xs + ("parsec_laforge":xs) -> parsec_laforge xs + ("parsec_laforge_discarding":xs) -> parsec_laforge_discarding xs + [] -> do + putStrLn "Usage: ... [attoparsec_text_builtin|attoparsec_text_laforge|parsec_laforge] inputs" + putStrLn "Usage: ... [attoparsec_text_laforge_discarding|parsec_laforge_discarding] inputs" diff --git a/benchmarks/Makefile b/benchmarks/Makefile --- a/benchmarks/Makefile +++ b/benchmarks/Makefile @@ -1,6 +1,9 @@ -all: med.txt tiny +all: med.txt double_test.txt tiny double tiny: Tiny.hs + ghc -O --make -o $@ $< + +double: Double.hs ghc -O --make -o $@ $< %: %.bz2 diff --git a/benchmarks/double_test.txt.bz2 b/benchmarks/double_test.txt.bz2 new file mode 100644 Binary files /dev/null and b/benchmarks/double_test.txt.bz2 differ