attoparsec 0.7.2 → 0.8.0.0

raw patch · 23 files changed

+1661/−947 lines, 23 filesdep −bytestring-lexingdep ~basedep ~bytestringbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies removed: bytestring-lexing

Dependency ranges changed: base, bytestring

API changes (from Hackage documentation)

Files

• Data/Attoparsec.hs +199/−32
• Data/Attoparsec/Char8.hs +267/−72
• Data/Attoparsec/Char8Boilerplate.h +0/−72
• Data/Attoparsec/Combinator.hs +19/−6
• Data/Attoparsec/FastSet.hs +23/−12
• Data/Attoparsec/Incremental.hs +0/−328
• Data/Attoparsec/Incremental/Char8.hs +0/−118
• Data/Attoparsec/Internal.hs +363/−259
• Data/Attoparsec/Lazy.hs +91/−0
• Data/Attoparsec/Word8Boilerplate.h +0/−34
• attoparsec.cabal +23/−14
• benchmarks/Makefile +10/−0
• benchmarks/Tiny.hs +31/−0
• benchmarks/med.txt.bz2 binary
• examples/Makefile +15/−0
• examples/Parsec_RFC2616.hs +85/−0
• examples/RFC2616.hs +53/−0
• examples/TestRFC2616.hs +37/−0
• examples/rfc2616.c +238/−0
• tests/Makefile +14/−0
• tests/QC.hs +116/−0
• tests/QCSupport.hs +52/−0
• tests/TestFastSet.hs +25/−0

@@ -1,59 +1,226 @@------------------------------------------------------------------------------ -- | -- Module      :  Data.Attoparsec--- Copyright   :  Daan Leijen 1999-2001, Jeremy Shaw 2006, Bryan O'Sullivan 2007-2008+-- Copyright   :  Bryan O'Sullivan 2007-2010 -- License     :  BSD3 --  -- Maintainer  :  bos@serpentine.com -- Stability   :  experimental -- Portability :  unknown ----- Simple, efficient parser combinators for lazy 'ByteString'--- strings, loosely based on 'Text.ParserCombinators.Parsec'.--- ------------------------------------------------------------------------------+-- Simple, efficient combinator parsing for 'B.ByteString' strings,+-- loosely based on the Parsec library.+ module Data.Attoparsec     (+    -- * Differences from Parsec+    -- $parsec++    -- * Performance considerations+    -- $performance+     -- * Parser types-      ParseError-    , Parser+      I.Parser+    , Result(..) +    -- ** Typeclass instances+    -- $instances+     -- * Running parsers     , parse-    , parseAt+    , feed+    , parseWith     , parseTest +    -- ** Result conversion+    , maybeResult+    , eitherResult+     -- * Combinators-    , (<?>)-    , try+    , (I.<?>)+    , I.try     , module Data.Attoparsec.Combinator      -- * Parsing individual bytes-    , anyWord8-    , notWord8-    , word8-    , satisfy+    , I.word8+    , I.anyWord8+    , I.notWord8+    , I.satisfy+    , I.satisfyWith -    -- * Efficient string handling-    , string-    , skipWhile-    , stringTransform-    , takeAll-    , takeTill-    , takeWhile-    , takeWhile1+    -- ** Byte classes+    , I.inClass+    , I.notInClass -    -- ** Combinators-    , match-    , notEmpty+    -- * Efficient string handling+    , I.string+    , I.skipWhile+    , I.take+    , I.takeWhile+    , I.takeWhile1+    , I.takeTill -    -- * State observation functions-    , endOfInput-    , getConsumed-    , getInput-    , lookAhead+    -- * State observation and manipulation functions+    , I.endOfInput+    , I.ensure     ) where  import Data.Attoparsec.Combinator-import Data.Attoparsec.Internal import Prelude hiding (takeWhile)+import qualified Data.Attoparsec.Internal as I+import qualified Data.ByteString as B++-- $parsec+--+-- Compared to Parsec 3, Attoparsec 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.+--+-- * 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 bytes or+--   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.+--+-- * Attoparsec is specialised to deal only with strict 'B.ByteString'+--   input.  Efficiency concernts rule out both lists and lazy+--   bytestrings.  The usual use for lazy bytestrings 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.+--+-- * 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.++-- $performance+--+-- If you write an Attoparsec-based parser carefully, it can be+-- realistic to expect it to perform within a factor of 2 of a+-- hand-rolled C parser (measuring megabytes parsed per second).+--+-- To actually achieve high performance, there are a few guidelines+-- that it is useful to follow.+--+-- Use the 'B.ByteString'-oriented parsers whenever possible,+-- e.g. 'I.takeWhile1' instead of 'many1' 'I.anyWord8'.  There is+-- about a factor of 100 difference in performance between the two+-- kinds of parser.+--+-- For very simple byte-testing predicates, write them by hand instead+-- of using 'I.inClass' or 'I.notInClass'.  For instance, both of+-- these predicates test for an end-of-line byte, but the first is+-- much faster than the second:+--+-- >endOfLine_fast w = w == 13 || w == 10+-- >endOfLine_slow   = inClass "\r\n"+--+-- Make active use of benchmarking and profiling tools to measure,+-- find the problems with, and improve the performance of your parser.++-- $instances+--+-- The 'I.Parser' type is an instance of the following classes:+--+-- * 'Monad', where 'fail' throws an exception (i.e. fails) with an+--   error message.+--+-- * 'Functor' and 'Applicative', which follow the usual definitions.+--+-- * 'MonadPlus', where 'mzero' fails (with no error message) and+--   'mplus' executes the right-hand parser if the left-hand one+--   fails.+--+-- * 'Alternative', which follows 'MonadPlus'.+--+-- The 'Result' type is an instance of 'Functor', where 'fmap'+-- transforms the value in a 'Done' result.++-- | The result of a parse.+data Result r = Fail !B.ByteString [String] String+              -- ^ The parse failed.  The 'B.ByteString' is the input+              -- that had not yet been consumed when the failure+              -- occurred.  The @[@'String'@]@ is a list of contexts+              -- in which the error occurred.  The 'String' is the+              -- message describing the error, if any.+              | Partial (B.ByteString -> Result r)+              -- ^ Supply this continuation with more input so that+              -- the parser can resume.  To indicate that no more+              -- input is available, use an 'B.empty' string.+              | Done !B.ByteString r+              -- ^ The parse succeeded.  The 'B.ByteString' is the+              -- input that had not yet been consumed (if any) when+              -- the parse succeeded.++instance Show r => Show (Result r) where+    show (Fail bs stk msg) =+        "Fail " ++ show bs ++ " " ++ show stk ++ " " ++ show msg+    show (Partial _)       = "Partial _"+    show (Done bs r)       = "Done " ++ show bs ++ " " ++ show r++-- | If a parser has returned a 'Partial' result, supply it with more+-- input.+feed :: Result r -> B.ByteString -> Result r+feed f@(Fail _ _ _) _ = f+feed (Partial k) d    = k d+feed (Done bs r) d    = Done (B.append bs d) r++fmapR :: (a -> b) -> Result a -> Result b+fmapR _ (Fail st stk msg) = Fail st stk msg+fmapR f (Partial k)       = Partial (fmapR f . k)+fmapR f (Done bs r)       = Done bs (f r)++instance Functor Result where+    fmap = fmapR++-- | Run a parser and print its result to standard output.+parseTest :: (Show a) => I.Parser a -> B.ByteString -> IO ()+parseTest p s = print (parse p s)++translate :: I.Result a -> Result a+translate (I.Fail st stk msg) = Fail (I.input st) stk msg+translate (I.Partial k)       = Partial (translate . k)+translate (I.Done st r)       = Done (I.input st) r++-- | Run a parser and return its result.+parse :: I.Parser a -> B.ByteString -> Result a+parse m s = translate (I.parse m s)+{-# INLINE parse #-}++-- | Run a parser with an initial input string, and a monadic action+-- that can supply more input if needed.+parseWith :: Monad m =>+             (m B.ByteString)+          -- ^ An action that will be executed to provide the parser+          -- with more input, if necessary.  The action must return an+          -- 'B.empty' string when there is no more input available.+          -> I.Parser a+          -> B.ByteString+          -- ^ Initial input for the parser.+          -> m (Result a)+parseWith refill p s = step $ I.parse p s+  where step (I.Fail st stk msg) = return $! Fail (I.input st) stk msg+        step (I.Partial k)       = (step . k) =<< refill+        step (I.Done st r)       = return $! Done (I.input st) r++-- | Convert a 'Result' value to a 'Maybe' value. A 'Partial' result+-- is treated as failure.+maybeResult :: Result r -> Maybe r+maybeResult (Done _ r) = Just r+maybeResult _          = Nothing++-- | Convert a 'Result' value to an 'Either' value. A 'Partial' result+-- is treated as failure.+eitherResult :: Result r -> Either String r+eitherResult (Done _ r)     = Right r+eitherResult (Fail _ _ msg) = Left msg+eitherResult _              = Left "Result: incomplete input"

@@ -1,125 +1,320 @@-{-# LANGUAGE CPP #-}------------------------------------------------------------------------------ -- | -- Module      :  Data.Attoparsec.Char8--- Copyright   :  Daan Leijen 1999-2001, Jeremy Shaw 2006, Bryan O'Sullivan 2007-2009+-- Copyright   :  Bryan O'Sullivan 2007-2010 -- License     :  BSD3 --  -- Maintainer  :  bos@serpentine.com -- Stability   :  experimental -- Portability :  unknown ----- Simple, efficient, character-oriented parser combinators for lazy--- 'LB.ByteString' strings, loosely based on the Parsec library.--- --- /Note/: This module is intended for parsing text that is--- represented using an 8-bit character set, e.g. ASCII or--- ISO-8859-15.  It /does not/ deal with character encodings,--- multibyte characters, or wide characters.  Any attempts to use--- characters above code point 255 will give wrong answers.------------------------------------------------------------------------------+-- Simple, efficient, character-oriented combinator parsing for+-- 'B.ByteString' strings, loosely based on the Parsec library.+ module Data.Attoparsec.Char8     (+    -- * Character encodings+    -- $encodings+     -- * Parser types-      ParseError-    , Parser+      Parser+    , A.Result(..)      -- * Running parsers-    , parse-    , parseAt-    , parseTest+    , A.parse+    , A.parseTest+    , A.feed      -- * Combinators-    , (<?>)-    , try+    , (I.<?>)+    , I.try+    , module Data.Attoparsec.Combinator      -- * Parsing individual characters-    , anyChar+    , satisfy     , char-    , digit-    , letter+    , anyChar+    , char8     , notChar++    -- ** Special character parsers+    , digit+    , letter_iso8859_15+    , letter_ascii     , space-    , satisfy -    -- ** Character classes+    -- ** Fast predicates+    , isDigit+    , isAlpha_iso8859_15+    , isAlpha_ascii++    -- *** Character classes     , inClass     , notInClass      -- * Efficient string handling-    , string+    , I.string     , stringCI     , skipSpace     , skipWhile-    , takeAll-    , takeCount+    , I.take     , takeTill     , takeWhile     , takeWhile1 -    -- ** Combinators-    , match-    , notEmpty-     -- * Text parsing-    , endOfLine+    , I.endOfLine+    , isEndOfLine+    , isHorizontalSpace      -- * Numeric parsers-    , int-    , integer-    , double--    -- * State observation functions-    , endOfInput-    , getConsumed-    , getInput-    , lookAhead+    , decimal+    , hexadecimal+    , signed+    --, double -    -- * Combinators-    , module Data.Attoparsec.Combinator+    -- * State observation and manipulation functions+    , I.endOfInput+    , I.ensure     ) where -import qualified Data.ByteString.Lazy.Char8 as LB-import Data.ByteString.Internal (w2c)-import Data.Char (isDigit, isLetter, isSpace, toLower)-import Data.Attoparsec.FastSet (charClass, memberChar)-import qualified Data.Attoparsec.Internal as I+import Control.Applicative ((*>), (<$>), (<|>)) import Data.Attoparsec.Combinator-import Data.Attoparsec.Internal-    (Parser, ParseError, (<?>), parse, parseAt, parseTest, try, endOfInput,-     lookAhead, string,-     getInput, getConsumed, takeAll, takeCount, notEmpty, match,-     endOfLine, setInput)-import Data.ByteString.Lex.Lazy.Double (readDouble)+import Data.Attoparsec.FastSet (charClass, memberChar)+import Data.Attoparsec.Internal (Parser, (<?>))+import Data.ByteString.Internal (c2w, w2c)+import Data.Word (Word8) import Prelude hiding (takeWhile)+import qualified Data.Attoparsec as A+import qualified Data.Attoparsec.Internal as I+import qualified Data.ByteString as B8+import qualified Data.ByteString.Char8 as B +-- $encodings+--+-- This module is intended for parsing text that is+-- represented using an 8-bit character set, e.g. ASCII or+-- ISO-8859-15.  It /does not/ make any attempt to deal with character+-- encodings, multibyte characters, or wide characters.  In+-- particular, all attempts to use characters above code point U+00FF+-- will give wrong answers.+--+-- Code points below U+0100 are simply translated to and from their+-- numeric values, so e.g. the code point U+00A4 becomes the byte+-- @0xA4@ (which is the Euro symbol in ISO-8859-15, but the generic+-- currency sign in ISO-8859-1).  Haskell 'Char' values above U+00FF+-- are truncated, so e.g. U+1D6B7 is truncated to the byte @0xB7@.++-- ASCII-specific but fast, oh yes.+toLower :: Word8 -> Word8+toLower w | w >= 65 && w <= 90 = w + 32+          | otherwise          = w+ -- | Satisfy a literal string, ignoring case.-stringCI :: LB.ByteString -> Parser LB.ByteString-stringCI = I.stringTransform (LB.map toLower)+stringCI :: B.ByteString -> Parser B.ByteString+stringCI = I.stringTransform (B8.map toLower) {-# INLINE stringCI #-} -takeWhile1 :: (Char -> Bool) -> Parser LB.ByteString+-- | Consume input as long as the predicate returns 'True', and return+-- the consumed input.+--+-- This parser requires the predicate to succeed on at least one byte+-- of input: it will fail if the predicate never returns 'True' or if+-- there is no input left.+takeWhile1 :: (Char -> Bool) -> Parser B.ByteString takeWhile1 p = I.takeWhile1 (p . w2c) {-# INLINE takeWhile1 #-} -numeric :: String -> (LB.ByteString -> Maybe (a,LB.ByteString)) -> Parser a-numeric desc f = do-  s <- getInput-  case f s of-    Nothing -> fail desc-    Just (i,s') -> setInput s' >> return i-                   --- | Parse an integer.  The position counter is not updated.-int :: Parser Int-int = numeric "Int" LB.readInt+-- | The parser @satisfy p@ succeeds for any byte for which the+-- predicate @p@ returns 'True'. Returns the byte that is actually+-- parsed.+--+-- >digit = satisfy isDigit+-- >    where isDigit c = c >= '0' && c <= '9'+satisfy :: (Char -> Bool) -> Parser Char+satisfy = I.satisfyWith w2c+{-# INLINE satisfy #-} --- | Parse an integer.  The position counter is not updated.-integer :: Parser Integer-integer = numeric "Integer" LB.readInteger+-- | Match a letter, in the ISO-8859-15 encoding.+letter_iso8859_15 :: Parser Char+letter_iso8859_15 = satisfy isAlpha_iso8859_15 <?> "letter_iso8859_15"+{-# INLINE letter_iso8859_15 #-} +-- | Match a letter, in the ASCII encoding.+letter_ascii :: Parser Char+letter_ascii = satisfy isAlpha_ascii <?> "letter_ascii"+{-# INLINE letter_ascii #-}++-- | A fast alphabetic predicate for the ISO-8859-15 encoding+--+-- /Note/: For all character encodings other than ISO-8859-15, and+-- almost all Unicode code points above U+00A3, this predicate gives+-- /wrong answers/.+isAlpha_iso8859_15 :: Char -> Bool+isAlpha_iso8859_15 c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') ||+                       (c >= '\166' && moby c)+  where moby = notInClass "\167\169\171-\179\182\183\185\187\191\215\247"+        {-# NOINLINE moby #-}+{-# INLINE isAlpha_iso8859_15 #-}++-- | A fast alphabetic predicate for the ASCII encoding+--+-- /Note/: For all character encodings other than ASCII, and+-- almost all Unicode code points above U+007F, this predicate gives+-- /wrong answers/.+isAlpha_ascii :: Char -> Bool+isAlpha_ascii c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')+{-# INLINE isAlpha_ascii #-}++-- | Parse a single digit.+digit :: Parser Char+digit = satisfy isDigit <?> "digit"+{-# INLINE digit #-}++-- | A fast digit predicate.+isDigit :: Char -> Bool+isDigit c = c >= '0' && c <= '9'+{-# INLINE isDigit #-}++-- | Match any character.+anyChar :: Parser Char+anyChar = satisfy $ const True+{-# INLINE anyChar #-}++-- | Fast predicate for matching a space character.+--+-- /Note/: This predicate only gives correct answers for the ASCII+-- encoding.  For instance, it does not recognise U+00A0 (non-breaking+-- space) as a space character, even though it is a valid ISO-8859-15+-- byte.+isSpace :: Char -> Bool+isSpace c = c `B.elem` spaces+    where spaces = B.pack " \n\r\t\v\f"+          {-# NOINLINE spaces #-}+{-# INLINE isSpace #-}++-- | Parse a space character.+--+-- /Note/: This parser only gives correct answers for the ASCII+-- encoding.  For instance, it does not recognise U+00A0 (non-breaking+-- space) as a space character, even though it is a valid ISO-8859-15+-- byte.+space :: Parser Char+space = satisfy isSpace <?> "space"+{-# INLINE space #-}++-- | Match a specific character.+char :: Char -> Parser Char+char c = satisfy (== c) <?> [c]+{-# INLINE char #-}++-- | Match a specific character, but return its 'Word8' value.+char8 :: Char -> Parser Word8+char8 c = I.satisfy (== c2w c) <?> [c]+{-# INLINE char8 #-}++-- | Match any character except the given one.+notChar :: Char -> Parser Char+notChar c = satisfy (/= c) <?> "not " ++ [c]+{-# INLINE notChar #-}++-- | Match any character in a set.+--+-- >vowel = inClass "aeiou"+--+-- Range notation is supported.+--+-- >halfAlphabet = inClass "a-nA-N"+--+-- To add a literal \'-\' to a set, place it at the beginning or end+-- of the string.+inClass :: String -> Char -> Bool+inClass s = (`memberChar` mySet)+    where mySet = charClass s+{-# INLINE inClass #-}++-- | Match any character not in a set.+notInClass :: String -> Char -> Bool+notInClass s = not . inClass s+{-# INLINE notInClass #-}++-- | Consume input as long as the predicate returns 'True', and return+-- the consumed input.+--+-- This parser does not fail.  It will return an empty string if the+-- predicate returns 'False' on the first byte of input.+--+-- /Note/: Because this parser does not fail, do not use it with+-- combinators such as 'many', because such parsers loop until a+-- failure occurs.  Careless use will thus result in an infinite loop.+takeWhile :: (Char -> Bool) -> Parser B.ByteString+takeWhile p = I.takeWhile (p . w2c)+{-# INLINE takeWhile #-}++-- | Consume input as long as the predicate returns 'False'+-- (i.e. until it returns 'True'), and return the consumed input.+--+-- This parser does not fail.  It will return an empty string if the+-- predicate returns 'True' on the first byte of input.+--+-- /Note/: Because this parser does not fail, do not use it with+-- combinators such as 'many', because such parsers loop until a+-- failure occurs.  Careless use will thus result in an infinite loop.+takeTill :: (Char -> Bool) -> Parser B.ByteString+takeTill p = I.takeTill (p . w2c)+{-# INLINE takeTill #-}++-- | Skip past input for as long as the predicate returns 'True'.+skipWhile :: (Char -> Bool) -> Parser ()+skipWhile p = I.skipWhile (p . w2c)+{-# INLINE skipWhile #-}++-- | Skip over white space.+skipSpace :: Parser ()+skipSpace = skipWhile isSpace >> return ()+{-# INLINE skipSpace #-}++-- | A predicate that matches either a carriage return @\'\\r\'@ or+-- newline @\'\\n\'@ character.+isEndOfLine :: Word8 -> Bool+isEndOfLine w = w == 13 || w == 10+{-# INLINE isEndOfLine #-}++-- | A predicate that matches either a space @\' \'@ or horizontal tab+-- @\'\\t\'@ character.+isHorizontalSpace :: Word8 -> Bool+isHorizontalSpace w = w == 32 || w == 9+{-# INLINE isHorizontalSpace #-}++{- -- | Parse a Double.  The position counter is not updated. double :: Parser Double double = numeric "Double" readDouble+-} -#define PARSER Parser-#include "Char8Boilerplate.h"+-- | 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 = B8.foldl' step 0 `fmap` I.takeWhile1 isHexDigit+  where isHexDigit w = (w >= 48 && w <= 57) || (x >= 97 && x <= 102)+            where x = toLower w+        step a w | w >= 48 && w <= 57  = a * 16 + fromIntegral (w - 48)+                 | otherwise           = a * 16 + fromIntegral (x - 87)+            where x = toLower w++-- | Parse and decode an unsigned decimal number.+decimal :: Integral a => Parser a+{-# SPECIALISE decimal :: Parser Int #-}+decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDig+  where isDig w  = w >= 48 && w <= 57+        step a w = a * 10 + fromIntegral (w - 48)++-- | 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 <$> char8 '-' *> p)+       <|> (char8 '+' *> p)+       <|> p

@@ -1,72 +0,0 @@--- -*- haskell -*----- | Character parser.-satisfy :: (Char -> Bool) -> PARSER Char-satisfy p = w2c <$> I.satisfy (p . w2c)-{-# INLINE satisfy #-}--letter :: PARSER Char-letter = satisfy isLetter <?> "letter"-{-# INLINE letter #-}--digit :: PARSER Char-digit = satisfy isDigit <?> "digit"-{-# INLINE digit #-}--anyChar :: PARSER Char-anyChar = satisfy $ const True-{-# INLINE anyChar #-}--space :: PARSER Char-space = satisfy isSpace <?> "space"-{-# INLINE space #-}---- | Match a specific character.-char :: Char -> PARSER Char-char c = satisfy (== c) <?> [c]-{-# INLINE char #-}---- | Match any character except the given one.-notChar :: Char -> PARSER Char-notChar c = satisfy (/= c) <?> "not " ++ [c]-{-# INLINE notChar #-}---- | Match any character in a set.------ > vowel = inClass "aeiou"------ Range notation is supported.------ > halfAlphabet = inClass "a-nA-N"------ To add a literal \'-\' to a set, place it at the beginning or end--- of the string.-inClass :: String -> Char -> Bool-inClass s = (`memberChar` mySet)-    where mySet = charClass s-{-# INLINE inClass #-}---- | Match any character not in a set.-notInClass :: String -> Char -> Bool-notInClass s = not . inClass s-{-# INLINE notInClass #-}---- | Consume characters while the predicate succeeds.-takeWhile :: (Char -> Bool) -> PARSER LB.ByteString-takeWhile p = I.takeWhile (p . w2c)-{-# INLINE takeWhile #-}---- | Consume characters while the predicate fails.-takeTill :: (Char -> Bool) -> PARSER LB.ByteString-takeTill p = I.takeTill (p . w2c)-{-# INLINE takeTill #-}---- | Skip over characters while the predicate succeeds.-skipWhile :: (Char -> Bool) -> PARSER ()-skipWhile p = I.skipWhile (p . w2c)-{-# INLINE skipWhile #-}---- | Skip over white space.-skipSpace :: PARSER ()-skipSpace = takeWhile isSpace >> return ()-{-# INLINE skipSpace #-}

@@ -1,8 +1,7 @@ {-# LANGUAGE BangPatterns, CPP #-}------------------------------------------------------------------------------ -- | -- Module      :  Data.Attoparsec.Combinator--- Copyright   :  Daan Leijen 1999-2001, Bryan O'Sullivan 2009+-- Copyright   :  Daan Leijen 1999-2001, Bryan O'Sullivan 2009-2010 -- License     :  BSD3 --  -- Maintainer  :  bos@serpentine.com@@ -10,8 +9,6 @@ -- Portability :  portable -- -- Useful parser combinators, similar to those provided by Parsec.--- ------------------------------------------------------------------------------ module Data.Attoparsec.Combinator     (       choice@@ -24,10 +21,18 @@     , skipMany     , skipMany1     , eitherP-    , module Control.Applicative++    -- * Inlined implementations of existing functions+    --+    -- These are exact duplicates of functions already exported by the+    -- 'Control.Applicative' module, but whose definitions are+    -- inlined.  In many cases, this leads to 2x performance+    -- improvements.+    , many     ) where -import Control.Applicative+import Control.Applicative (Alternative, Applicative(..), empty, liftA2,+                            (<|>), (*>), (<$>))  -- | @choice ps@ tries to apply the actions in the list @ps@ in order, -- until one of them succeeds. Returns the value of the succeeding@@ -49,6 +54,7 @@ -- >  word  = many1 letter many1 :: Alternative f => f a -> f [a] many1 p = liftA2 (:) p (many p)+{-# INLINE many1 #-}  -- | @sepBy p sep@ applies /zero/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@.@@ -95,3 +101,10 @@ eitherP :: (Alternative f) => f a -> f b -> f (Either a b) eitherP a b = (Left <$> a) <|> (Right <$> b) {-# INLINE eitherP #-}++-- | Zero or more.+many :: (Alternative f) => f a -> f [a]+many v = many_v+    where many_v = some_v <|> pure []+	  some_v = (:) <$> v <*> many_v+{-# INLINE many #-}

@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns, MagicHash #-}  ----------------------------------------------------------------------------- -- |@@ -32,16 +32,17 @@     , charClass     ) where -import Data.Bits ((.&.), (.|.), shiftL, shiftR)-import qualified Data.ByteString.Char8 as B8+import Data.Bits ((.&.), (.|.))+import Foreign.Storable (peekByteOff, pokeByteOff)+import GHC.Base (Int(I#), iShiftRA#, narrow8Word#, shiftL#)+import GHC.Word (Word8(W8#)) import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Internal as I import qualified Data.ByteString.Unsafe as U-import Data.Word (Word8)-import Foreign.Storable (peekByteOff, pokeByteOff) -data FastSet = Sorted { fromSet :: {-# UNPACK #-} !B.ByteString }-             | Table  { fromSet :: {-# UNPACK #-} !B.ByteString }+data FastSet = Sorted { fromSet :: !B.ByteString }+             | Table  { fromSet :: !B.ByteString }     deriving (Eq, Ord)  instance Show FastSet where@@ -61,14 +62,23 @@ fromList :: [Word8] -> FastSet fromList = set . B.pack -index :: Int -> (Int, Word8)-index i = (i `shiftR` 3, 1 `shiftL` (i .&. 7))+data I = I {-# UNPACK #-} !Int {-# UNPACK #-} !Word8 +shiftR :: Int -> Int -> Int+shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#)++shiftL :: Word8 -> Int -> Word8+shiftL (W8# x#) (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#))++index :: Int -> I+index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7))+{-# INLINE index #-}+ -- | Check the set for membership. memberWord8 :: Word8 -> FastSet -> Bool memberWord8 w (Table t)  =-    let (byte,bit) = index (fromIntegral w)-    in U.unsafeIndex t byte .&. bit /= 0+    let I byte bit = index (fromIntegral w)+    in  U.unsafeIndex t byte .&. bit /= 0 memberWord8 w (Sorted s) = search 0 (B.length s - 1)     where search lo hi               | hi < lo = False@@ -83,6 +93,7 @@ -- characters above code point 255 will give wrong answers. memberChar :: Char -> FastSet -> Bool memberChar c = memberWord8 (I.c2w c)+{-# INLINE memberChar #-}  mkTable :: B.ByteString -> B.ByteString mkTable s = I.unsafeCreate 32 $ \t -> do@@ -91,7 +102,7 @@               let loop n | n == l = return ()                          | otherwise = do                     c <- peekByteOff p n :: IO Word8-                    let (byte,bit) = index (fromIntegral c)+                    let I byte bit = index (fromIntegral c)                     prev <- peekByteOff t byte :: IO Word8                     pokeByteOff t byte (prev .|. bit)                     loop (n + 1)

@@ -1,328 +0,0 @@-{-# LANGUAGE BangPatterns, CPP #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Attoparsec.Incremental--- Copyright   :  Bryan O'Sullivan 2009--- License     :  BSD3--- --- Maintainer  :  bos@serpentine.com--- Stability   :  experimental--- Portability :  unknown------ Simple, efficient, and incremental parser combinators for lazy--- 'L.ByteString' strings, loosely based on the Parsec library.------ This module is heavily influenced by Adam Langley's incremental--- parser in his @binary-strict@ package.--- -------------------------------------------------------------------------------module Data.Attoparsec.Incremental-    (-    -- * Incremental parsing-    -- $incremental--    -- * Parser types-      Parser-    , Result(..)--    -- * Running parsers-    , parse-    , parseWith-    , parseTest--    -- * Combinators-    , (<?>)-    , try--    -- * Parsing individual bytes-    , word8-    , notWord8-    , anyWord8-    , satisfy--    -- * Efficient string handling-    , string-    , skipWhile-    , takeCount-    , takeTill-    , takeWhile--    -- * State observation and manipulation functions-    , endOfInput-    , pushBack-    , yield--    -- * Combinators-    , module Data.Attoparsec.Combinator-    ) where--import Data.Attoparsec.Combinator-import Control.Monad (MonadPlus(..), ap)-import Data.Attoparsec.Internal ((+:))-import Data.Word (Word8)-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Lazy.Internal as L-import Prelude hiding (takeWhile)---- $incremental--- Incremental parsing makes it possible to supply a parser with only--- a limited amount of input.  If the parser cannot complete due to--- lack of data, it will return a 'Partial' result with a continuation--- to which more input can be supplied, as follows:------ >   case parse myParser someInput of--- >     Partial k -> k moreInput------ To signal that no more input is available, pass an empty--- string to this continuation.--data S = S {-# UNPACK #-} !S.ByteString -- first chunk of input-           L.ByteString                 -- rest of input-           [L.ByteString]               -- input acquired during backtracks-           !Bool                        -- have we hit EOF yet?-           {-# UNPACK #-} !Int          -- failure depth---- | The result of a partial parse.-data Result a = Failed String-                -- ^ The parse failed, with the given error message.-              | Done L.ByteString a-                -- ^ The parse succeeded, producing the given-                -- result. The 'L.ByteString' contains any unconsumed-                -- input.-              | Partial (L.ByteString -> Result a)-                -- ^ The parse ran out of data before finishing. To-                -- resume the parse, pass more data to the given-                -- continuation.--instance (Show a) => Show (Result a) where-  show (Failed err)      = "Failed " ++ show err-  show (Done L.Empty rs) = "Done Empty " ++ show rs-  show (Done rest rs)    = "Done (" ++ show rest ++ ") " ++ show rs-  show (Partial _)       = "Partial"---- | This is the internal version of the above. This is the type which--- is actually used by the code, as it has the extra information--- needed for backtracking. This is converted to a friendly 'Result'--- type just before giving it to the outside world.-data IResult a = IFailed S String-               | IDone S a-               | IPartial (L.ByteString -> IResult a)--instance Show (IResult a) where-  show (IFailed _ err) = "IFailed " ++ show err-  show (IDone _ _)     = "IDone"-  show (IPartial _)    = "IPartial"---- | The parser type.-newtype Parser r a = Parser {-      unParser :: S -> (a -> S -> IResult r) -> IResult r-    }--instance Monad (Parser r) where-  return a = Parser $ \s k -> k a s-  m >>= k = Parser $ \s cont -> unParser m s $ \a s' -> unParser (k a) s' cont-  fail err = Parser $ \s -> const $ IFailed s err--zero :: Parser r a-zero = fail ""---- | I'm not sure if this is a huge bodge or not. It probably is.------ When performing a choice (in @plus@), the failure depth in the--- current state is incremented. If a failure is generated inside the--- attempted path, the state carried in the IFailure will have this--- incremented failure depth. However, we don't want to backtrack--- after the attempted path has completed. Thus we insert this cut--- continuation, which decrements the failure count of any failure--- passing though, thus it would be caught in @plus@ and doesn't--- trigger a backtrack.-cutContinuation :: (a -> S -> IResult r) -> a -> S -> IResult r-cutContinuation k v s =-  case k v s of-       IFailed (S lb i adds eof failDepth) err -> IFailed (S lb i adds eof (failDepth - 1)) err-       x -> x--appL :: L.ByteString -> L.ByteString -> L.ByteString-appL xs L.Empty = xs-appL L.Empty ys = ys-appL xs ys      = xs `L.append` ys--plus :: Parser r a -> Parser r a -> Parser r a-plus p1 p2 =-  Parser $ \(S sb lb adds eof failDepth) k ->-    let-      filt f@(IFailed (S _ _ adds' eof' failDepth') _)-        | failDepth' == failDepth + 1 =-            let lb' = lb `appL` L.concat (reverse adds')-            in  unParser p2 (S sb lb' (adds' ++ adds) eof' failDepth) k-        | otherwise = f-      filt (IPartial cont) = IPartial (filt . cont)-      filt v@(IDone _ _) = v-    in-      filt $ unParser p1 (S sb lb [] eof (failDepth + 1)) (cutContinuation k)---- | This is a no-op combinator for compatibility.-try :: Parser r a -> Parser r a-try p = p--instance Functor (Parser r) where-    fmap f m = Parser $ \s cont -> unParser m s (cont . f)--infix 0 <?>---- | Name the parser, in case failure occurs.-(<?>) :: Parser r a-      -> String                 -- ^ the name to use if parsing fails-      -> Parser r a-{-# INLINE (<?>) #-}-p <?> msg =-  Parser $ \st k ->-    case unParser p st k of-      IFailed st' _ -> IFailed st' msg-      ok -> ok--initState :: L.ByteString -> S-initState (L.Chunk sb lb) = S sb lb [] False 0-initState _               = S S.empty L.empty [] False 0--mkState :: L.ByteString -> [L.ByteString] -> Bool -> Int -> S-mkState bs adds eof failDepth =-    case bs of-      L.Empty -> S S.empty L.empty adds eof failDepth-      L.Chunk sb lb -> S sb lb adds eof failDepth--addX :: L.ByteString -> [L.ByteString] -> [L.ByteString]-addX s adds | L.null s = adds-            | otherwise = s : adds---- | Resume our caller, handing back a 'Partial' result. This function--- is probably not useful, but provided for completeness.-yield :: Parser r ()-yield = Parser $ \(S sb lb adds eof failDepth) k ->-  IPartial $ \s -> k () (S sb (lb `appL` s) (addX s adds) eof failDepth)--continue :: (S -> IResult r) -> Parser r a-         -> (a -> S -> IResult r) -> S -> IResult r-continue onEOF p k (S _sb _lb adds eof failDepth) =-    if eof-    then onEOF (S S.empty L.empty adds True failDepth)-    else IPartial $ \s -> let st = contState s adds failDepth-                          in unParser p st k--takeWith :: (L.ByteString -> (L.ByteString, L.ByteString))-         -> Parser r L.ByteString-takeWith splitf =-  Parser $ \st@(S sb lb adds eof failDepth) k ->-  let (left,rest) = splitf (sb +: lb)-  in if L.null rest-     then continue (k left) (takeWith splitf) (k . appL left) st-     else k left (mkState rest adds eof failDepth)-    --- | Consume bytes while the predicate succeeds.-takeWhile :: (Word8 -> Bool) -> Parser r L.ByteString-takeWhile = takeWith . L.span---- | Consume bytes while the predicate fails.  If the predicate never--- succeeds, the entire input string is returned.-takeTill :: (Word8 -> Bool) -> Parser r L.ByteString-takeTill = takeWith . L.break---- | Return exactly the given number of bytes.  If not enough are--- available, fail.-takeCount :: Int -> Parser r L.ByteString-takeCount = tc . fromIntegral where- tc n = Parser $ \st@(S sb lb adds eof failDepth) k ->-        let (h,t) = L.splitAt n (sb +: lb)-            l = L.length h-        in if L.length h == n-           then k h (mkState t adds eof failDepth)-           else continue (`IFailed` "takeCount: EOF")-                         (tc (n - l)) (k . appL h) st---- | Match a literal string exactly.-string :: L.ByteString -> Parser r L.ByteString-string s =-  Parser $ \st@(S sb lb adds eof failDepth) k ->-    case L.splitAt (L.length s) (sb +: lb) of-      (h,t)-        | h == s -> k s (mkState t adds eof failDepth)-      (h,L.Empty)-        | h `L.isPrefixOf` s ->-            continue (`IFailed` "string: EOF")-                     (string (L.drop (L.length h) s))-                     (k . appL h)-                     st-      _ -> IFailed st "string failed to match"--contState :: L.ByteString -> [L.ByteString] -> Int -> S-contState s adds failDepth-    | L.null s  = S S.empty L.empty [] True failDepth-    | otherwise = mkState s (addX s adds) False failDepth---- | Match a single byte based on the given predicate.-satisfy :: (Word8 -> Bool) -> Parser r Word8-satisfy p =-  Parser $ \st@(S sb lb adds eof failDepth) k ->-    case S.uncons sb of-      Just (w, sb') | p w -> k w (S sb' lb adds eof failDepth)-                    | otherwise -> IFailed st "failed to match"-      Nothing -> case L.uncons lb of-                   Just (w, lb') | p w -> k w (mkState lb' adds eof failDepth)-                                 | otherwise -> IFailed st "failed to match"-                   Nothing -> continue (`IFailed` "satisfy: EOF")-                                       (satisfy p) k st---- | Force the given string to appear next in the input stream.-pushBack :: L.ByteString -> Parser r ()-pushBack bs =-    Parser $ \(S sb lb adds eof failDepth) k ->-        k () (mkState (bs `appL` (sb +: lb)) adds eof failDepth)---- | Succeed if we have reached the end of the input string.-endOfInput :: Parser r ()-endOfInput = Parser $ \st@(S sb lb _adds _eof _failDepth) k ->-             if not (S.null sb) || not (L.null lb)-             then IFailed st "endOfInput: not EOF"-             else continue (k ()) endOfInput k st--toplevelTranslate :: IResult a -> Result a-toplevelTranslate (IFailed _ err) = Failed err-toplevelTranslate (IDone (S sb lb _ _ _) value) = Done (sb +: lb) value-toplevelTranslate (IPartial k) = Partial $ toplevelTranslate . k--terminalContinuation :: a -> S -> IResult a-terminalContinuation v s = IDone s v---- | Run a parser.-parse :: Parser r r -> L.ByteString -> Result r-parse m input =-  toplevelTranslate $ unParser m (initState input) terminalContinuation---- | Run a parser, using the given function to resupply it with input.------ Here's an example that shows how to parse data from a socket, using--- Johan Tibbell's @network-bytestring@ package.------ >  import qualified Data.ByteString.Lazy as L--- >  import Data.Attoparsec.Incremental (Parser, Result, parseWith)--- >  import Network.Socket.ByteString.Lazy (recv_)--- >  import Network.Socket (Socket)--- >--- >  netParse :: Parser r r -> Socket -> IO (Result r)--- >  netParse p sock = parseWith (recv_ sock 65536) p L.empty-parseWith :: Applicative f => f L.ByteString -- ^ resupply parser with input-          -> Parser r r                      -- ^ parser to run-          -> L.ByteString                    -- ^ initial input-          -> f (Result r)-parseWith refill p s =-  case parse p s of-    Partial k -> k <$> refill-    ok        -> pure ok---- | Try out a parser, and print its result.-parseTest :: (Show r) => Parser r r -> L.ByteString -> IO ()-parseTest p s = print (parse p s)--#define PARSER Parser r-#include "Word8Boilerplate.h"

@@ -1,118 +0,0 @@-{-# LANGUAGE CPP #-}--------------------------------------------------------------------------------- |--- Module      :  Data.Attoparsec.Incremental.Char8--- Copyright   :  Bryan O'Sullivan 2009--- License     :  BSD3--- --- Maintainer  :  bos@serpentine.com--- Stability   :  experimental--- Portability :  unknown------ Simple, efficient, character-oriented, and incremental parser--- combinators for lazy 'L.ByteString' strings, loosely based on the--- Parsec library.--- --- /Note/: This module is intended for parsing text that is--- represented using an 8-bit character set, e.g. ASCII or--- ISO-8859-15.  It /does not/ deal with character encodings,--- multibyte characters, or wide characters.  Any attempts to use--- characters above code point 255 will give wrong answers.-------------------------------------------------------------------------------module Data.Attoparsec.Incremental.Char8-    (-    -- * Parser types-      Parser-    , Result(..)--    -- * Running parsers-    , parse-    , parseWith-    , parseTest--    -- * Combinators-    , (<?>)-    , try--    -- * Parsing individual characters-    , satisfy-    , letter-    , digit-    , anyChar-    , space-    , char-    , notChar--    -- ** Character classes-    , inClass-    , notInClass--    -- * Efficient string handling-    , string-    , skipSpace-    , skipWhile-    , takeCount-    , takeTill-    , takeWhile--    -- * Text parsing-    , endOfLine--    -- * Numeric parsers-    , int-    , integer-    , double--    -- * State observation and manipulation functions-    , endOfInput-    , pushBack-    , yield--    -- * Combinators-    , module Data.Attoparsec.Combinator-    ) where--import qualified Data.ByteString.Lazy.Char8 as LB-import Data.ByteString.Internal (w2c)-import Data.Char (isDigit, isLetter, isSpace)-import Data.Attoparsec.FastSet (charClass, memberChar)-import qualified Data.Attoparsec.Incremental as I-import Data.Attoparsec.Incremental-    (Parser, Result(..), (<?>), endOfInput, parse, parseWith, parseTest,-     pushBack, string, takeCount, try, yield)-import Data.ByteString.Lex.Lazy.Double (readDouble)-import Prelude hiding (takeWhile)-import Data.Attoparsec.Combinator--numeric :: String -> (Char -> Bool)-         -> (LB.ByteString -> Maybe (a,LB.ByteString)) -> Parser r a-numeric desc p f = do-  s <- takeWhile p-  case f s of-    Nothing -> pushBack s >> fail desc-    Just (i,s') -> pushBack s' >> return i-                   -isIntegral :: Char -> Bool-isIntegral c = isDigit c || c == '-'---- | Parse an 'Int'.-int :: Parser r Int-int = numeric "Int" isIntegral LB.readInt---- | Parse an 'Integer'.-integer :: Parser r Integer-integer = numeric "Integer" isIntegral LB.readInteger---- | Parse a 'Double'.-double :: Parser r Double-double = numeric "Double" isDouble readDouble-    where isDouble c = isIntegral c || c == 'e' || c == '+'---- | Match the end of a line.  This may be any of a newline character,--- a carriage return character, or a carriage return followed by a newline.-endOfLine :: Parser r ()-endOfLine = (char '\n' *> pure ()) <|> (string crlf *> pure ())-    where crlf = LB.pack "\r\n"--#define PARSER Parser r-#include "../Char8Boilerplate.h"

@@ -1,337 +1,441 @@-{-# LANGUAGE CPP #-}------------------------------------------------------------------------------+{-# LANGUAGE Rank2Types, RecordWildCards #-} -- | -- Module      :  Data.Attoparsec.Internal--- Copyright   :  Daan Leijen 1999-2001, Jeremy Shaw 2006, Bryan O'Sullivan 2007-2008+-- Copyright   :  Bryan O'Sullivan 2007-2010 -- License     :  BSD3 --  -- Maintainer  :  bos@serpentine.com -- Stability   :  experimental -- Portability :  unknown ----- Simple, efficient parser combinators for lazy 'LB.ByteString'--- strings, loosely based on 'Text.ParserCombinators.Parsec'.--- ------------------------------------------------------------------------------+-- Simple, efficient parser combinators for 'B.ByteString' strings,+-- loosely based on the Parsec library.+ module Data.Attoparsec.Internal     (     -- * Parser types-      ParseError-    , Parser+      Parser+    , Result(..)+    , S(input)      -- * Running parsers     , parse-    , parseAt-    , parseTest      -- * Combinators     , (<?>)     , try+    , module Data.Attoparsec.Combinator      -- * Parsing individual bytes     , satisfy+    , satisfyWith     , anyWord8     , word8     , notWord8 +    -- ** Byte classes+    , inClass+    , notInClass++    -- * Parsing more complicated structures+    , storable+     -- * Efficient string handling-    , match-    , notEmpty     , skipWhile     , string     , stringTransform-    , takeAll-    , takeCount-    , takeTill+    , take     , takeWhile     , takeWhile1+    , takeTill -    -- * State observation functions+    -- * State observation and manipulation functions     , endOfInput-    , getConsumed-    , getInput-    , lookAhead-    , setInput+    , ensure      -- * Utilities     , endOfLine-    , (+:)     ) where -import Control.Applicative-    (Alternative(..), Applicative(..), (*>))-import Control.Monad (MonadPlus(..), ap)-import Control.Monad.Fix (MonadFix(..))-import qualified Data.ByteString as SB-import qualified Data.ByteString.Lazy as LB-import qualified Data.ByteString.Lazy.Char8 as L8-import qualified Data.ByteString.Unsafe as U-import qualified Data.ByteString.Internal as I-import qualified Data.ByteString.Lazy.Internal as LB-import Data.Int (Int64)+import Control.Applicative (Alternative(..), Applicative(..), (<$>))+import Control.Monad (MonadPlus(..), when)+import Data.Attoparsec.Combinator+import Data.Attoparsec.FastSet (charClass, memberWord8)+import Data.Monoid (Monoid(..)) import Data.Word (Word8)-import Prelude hiding (takeWhile)---- ^ A description of a parsing error.-type ParseError = String+import Foreign.ForeignPtr (withForeignPtr)+import Foreign.Ptr (castPtr, plusPtr)+import Foreign.Storable (Storable(peek, sizeOf))+import Prelude hiding (getChar, take, takeWhile)+import qualified Data.ByteString as B8+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Internal as B+import qualified Data.ByteString.Unsafe as B --- State invariants:--- * If both strict and lazy bytestrings are empty, the entire input---   is considered to be empty.-data S = S {-# UNPACK #-} !SB.ByteString-           LB.ByteString-           {-# UNPACK #-} !Int64+data Result r = Fail S [String] String+              | Partial (B.ByteString -> Result r)+              | Done S r --- ^ A parser that produces a result of type @a@.+-- | The 'Parser' type is a monad. newtype Parser a = Parser {-      unParser :: S -> Either (LB.ByteString, [String]) (a, S)+      runParser :: forall r. S+                -> Failure   r+                -> Success a r+                -> Result r     } -instance Functor Parser where-    fmap f p =-        Parser $ \s ->-            case unParser p s of-              Right (a, s') -> Right (f a, s')-              Left err -> Left err+type Failure   r = S -> [String] -> String -> Result r+type Success a r = S -> a -> Result r -instance Monad Parser where-    return a = Parser $ \s -> Right (a, s)-    m >>= f = Parser $ \s ->-              case unParser m s of-                Right (a, s') -> unParser (f a) s'-                Left (s', msgs) -> Left (s', msgs)-    fail err = Parser $ \(S sb lb _) -> Left (sb +: lb, [err])+-- | Have we read all available input?+data More = Complete | Incomplete+            deriving (Eq, Show) -instance MonadFix Parser where-    mfix f = Parser $ \s ->-             let r = case r of-                       Right (a, _) -> unParser (f a) s-                       err -> err-             in r+plusMore :: More -> More -> More+plusMore Complete _ = Complete+plusMore _ Complete = Complete+plusMore _ _        = Incomplete+{-# INLINE plusMore #-} -zero :: Parser a-zero = Parser $ \(S sb lb _) -> Left (sb +: lb, [])-{-# INLINE zero #-}+instance Monoid More where+    mempty  = Incomplete+    mappend = plusMore +data S = S {+      input  :: !B.ByteString+    , _added :: !B.ByteString+    , more  :: !More+    } deriving (Show)++instance Show r => Show (Result r) where+    show (Fail _ stack msg) = "Fail " ++ show stack ++ " " ++ show msg+    show (Partial _) = "Partial _"+    show (Done bs r) = "Done " ++ show bs ++ " " ++ show r++addS :: S -> S -> S+addS (S s0 a0 c0) (S _s1 a1 c1) = S (s0 +++ a1) (a0 +++ a1) (mappend c0 c1)+{-# INLINE addS #-}++instance Monoid S where+    mempty  = S B.empty B.empty Incomplete+    mappend = addS++bindP :: Parser a -> (a -> Parser b) -> Parser b+bindP m g =+    Parser (\st0 kf ks -> runParser m st0 kf (\s a -> runParser (g a) s kf ks))+{-# INLINE bindP #-}++returnP :: a -> Parser a+returnP a = Parser (\st0 _kf ks -> ks st0 a)+{-# INLINE returnP #-}++instance Monad Parser where+    return = returnP+    (>>=)  = bindP+    fail   = failDesc++noAdds :: S -> S+noAdds (S s0 _a0 c0) = S s0 B.empty c0+{-# INLINE noAdds #-}+ plus :: Parser a -> Parser a -> Parser a-plus p1 p2 =-    Parser $ \s@(S sb lb _) ->-        case unParser p1 s of-          Left (_, msgs1) -> -              case unParser p2 s of-                Left (_, msgs2) -> Left (sb +: lb, (msgs1 ++ msgs2))-                ok -> ok-          ok -> ok+plus a b = Parser $ \st0 kf ks ->+           let kf' st1 _ _ = runParser b (mappend st0 st1) kf ks+               !st2 = noAdds st0+           in  runParser a st2 kf' ks {-# INLINE plus #-} -mkState :: LB.ByteString -> Int64 -> S-mkState s = case s of-              LB.Empty -> S SB.empty s-              LB.Chunk x xs -> S x xs+instance MonadPlus Parser where+    mzero = failDesc "mzero"+    mplus = plus --- | Turn our split representation back into a normal lazy ByteString.-(+:) :: SB.ByteString -> LB.ByteString -> LB.ByteString-sb +: lb | SB.null sb = lb-         | otherwise = LB.Chunk sb lb-{-# INLINE (+:) #-}+fmapP :: (a -> b) -> Parser a -> Parser b+fmapP p m = Parser (\st0 f k -> runParser m st0 f (\s a -> k s (p a)))+{-# INLINE fmapP #-} -infix 0 <?>+instance Functor Parser where+    fmap = fmapP --- | Name the parser, in case failure occurs.-(<?>) :: Parser a-      -> String                 -- ^ the name to use if parsing fails-      -> Parser a-p <?> msg =-    Parser $ \s@(S sb lb _) ->-        case unParser p s of-          (Left _) -> Left (sb +: lb, [msg])-          ok -> ok-{-# INLINE (<?>) #-}+apP :: Parser (a -> b) -> Parser a -> Parser b+apP d e = do+  b <- d+  a <- e+  return (b a)+{-# INLINE apP #-} -nextChunk :: Parser ()-nextChunk = Parser $ \(S _ lb n) ->-            case lb of-              LB.Chunk sb' lb' -> Right ((), S sb' lb' n)-              LB.Empty -> Left (lb, [])+instance Applicative Parser where+    pure  = returnP+    (<*>) = apP --- | Get remaining input.-getInput :: Parser LB.ByteString-getInput = Parser $ \s@(S sb lb _) -> Right (sb +: lb, s)+instance Alternative Parser where+    empty = failDesc "empty"+    (<|>) = plus --- | Set the remaining input.-setInput :: LB.ByteString -> Parser ()-setInput bs = Parser $ \(S _ _ n) -> Right ((), mkState bs n)+failDesc :: String -> Parser a+failDesc err = Parser (\st0 kf _ks -> kf st0 [] msg)+    where msg = "Failed reading: " ++ err+{-# INLINE failDesc #-} --- | Get number of bytes consumed so far.-getConsumed :: Parser Int64-getConsumed = Parser $ \s@(S _ _ n) -> Right (n, s)+-- | Succeed only if at least @n@ bytes of input are available.+ensure :: Int -> Parser ()+ensure n = Parser $ \st0@(S s0 _a0 _c0) kf ks ->+    if B.length s0 >= n+    then ks st0 ()+    else runParser (demandInput >> ensure n) st0 kf ks --- | Match a single byte based on the given predicate.-satisfy :: (Word8 -> Bool) -> Parser Word8-satisfy p =-    Parser $ \s@(S sb lb n) ->-           case SB.uncons sb of-             Just (c, sb') | p c -> Right (c, mkState (sb' +: lb) (n + 1))-                           | otherwise -> Left (sb +: lb, [])-             Nothing -> unParser (nextChunk >> satisfy p) s-{-# INLINE satisfy #-}+-- | Immediately demand more input via a 'Partial' continuation+-- result.+demandInput :: Parser ()+demandInput = Parser $ \st0@(S s0 a0 c0) kf ks ->+    if c0 == Complete+    then kf st0 ["demandInput"] "not enough bytes"+    else Partial $ \s ->+         if B.null s+         then kf (S s0 a0 Complete) ["demandInput"] "not enough bytes"+         else let st1 = S (s0 +++ s) (a0 +++ s) Incomplete+              in  ks st1 () --- | Match a literal string exactly.-string :: LB.ByteString -> Parser LB.ByteString-string s = Parser $ \(S sb lb n) ->-           let bs = sb +: lb-               l = LB.length s-               (h,t) = LB.splitAt l bs-           in if s == h-              then Right (s, mkState t (n + l))-              else Left (bs, [])-{-# INLINE string #-}+-- | This parser always succeeds.  It returns 'True' if any input is+-- available either immediately or on demand, and 'False' if the end+-- of all input has been reached.+wantInput :: Parser Bool+wantInput = Parser $ \st0@(S s0 a0 c0) _kf ks ->+  case undefined of+    _ | not (B.null s0) -> ks st0 True+      | c0 == Complete  -> ks st0 False+      | otherwise       -> Partial $ \s ->+                           if B.null s+                           then ks st0 False+                           else let st1 = S (s0 +++ s) (a0 +++ s) Incomplete+                                in  ks st1 True --- | Match the end of a line.  This may be any of a newline character,--- a carriage return character, or a carriage return followed by a newline.-endOfLine :: Parser ()-endOfLine = Parser $ \(S sb lb n) ->-            let bs = sb +: lb-            in if SB.null sb-               then Left (bs, ["EOL"])-               else case I.w2c (U.unsafeHead sb) of-                     '\n' -> Right ((), mkState (LB.tail bs) (n + 1))-                     '\r' -> let (h,t) = LB.splitAt 2 bs-                                 rn = L8.pack "\r\n"-                             in if h == rn-                                then Right ((), mkState t (n + 2))-                                else Right ((), mkState (LB.tail bs) (n + 1))-                     _ -> Left (bs, ["EOL"])+get :: Parser B.ByteString+get  = Parser (\st0 _kf ks -> ks st0 (input st0)) --- | Match a literal string, after applying a transformation to both--- it and the matching text.  Useful for e.g. case insensitive string--- comparison.-stringTransform :: (LB.ByteString -> LB.ByteString) -> LB.ByteString-                -> Parser LB.ByteString-stringTransform f s = Parser $ \(S sb lb n) ->-             let bs = sb +: lb-                 l = LB.length s-                 (h, t) = LB.splitAt l bs-             in if fs == f h-                then Right (s, mkState t (n + l))-                else Left (bs, [])-    where fs = f s-{-# INLINE stringTransform #-}+put :: B.ByteString -> Parser ()+put s = Parser (\(S _s0 a0 c0) _kf ks -> ks (S s a0 c0) ()) --- | Attempt a parse, but do not consume any input if the parse fails.+(+++) :: B.ByteString -> B.ByteString -> B.ByteString+(+++) = B.append+{-# INLINE (+++) #-}++-- | Attempt a parse, and if it fails, rewind the input so that no+-- input appears to have been consumed.+--+-- This combinator is useful in cases where a parser might consume+-- some input before failing, i.e. the parser needs arbitrary+-- lookahead.  The downside to using this combinator is that it can+-- retain input for longer than is desirable. try :: Parser a -> Parser a-try p = Parser $ \s@(S sb lb _) ->-        case unParser p s of-          Left (_, msgs) -> Left (sb +: lb, msgs)-          ok -> ok+try p = Parser $ \st0 kf ks ->+        runParser p (noAdds st0) (kf . mappend st0) ks --- | Succeed if we have reached the end of the input string.-endOfInput :: Parser ()-endOfInput = Parser $ \s@(S sb lb _) -> if SB.null sb && LB.null lb-                                        then Right ((), s)-                                        else Left (sb +: lb, ["EOF"])+-- | The parser @satisfy p@ succeeds for any byte for which the+-- predicate @p@ returns 'True'. Returns the byte that is actually+-- parsed.+--+-- >digit = satisfy isDigit+-- >    where isDigit w = w >= 48 && w <= 57+satisfy :: (Word8 -> Bool) -> Parser Word8+satisfy p = do+  ensure 1+  s <- get+  let w = B.unsafeHead s+  if p w+    then put (B.unsafeTail s) >> return w+    else fail "satisfy" --- | Return all of the remaining input as a single string.-takeAll :: Parser LB.ByteString-takeAll = Parser $ \(S sb lb n) ->-          let bs = sb +: lb-          in Right (bs, mkState LB.empty (n + LB.length bs))+-- | The parser @satisfyWith f p@ transforms a byte, and succeeds if+-- the predicate @p@ returns 'True' on the transformed value. The+-- parser returns the transformed byte that was parsed.+satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a+satisfyWith f p = do+  ensure 1+  s <- get+  let c = f (B.unsafeHead s)+  if p c+    then put (B.unsafeTail s) >> return c+    else fail "satisfyWith" --- | Return exactly the given number of bytes.  If not enough are--- available, fail.-takeCount :: Int -> Parser LB.ByteString-takeCount k =-  Parser $ \(S sb lb n) ->-      let bs = sb +: lb-          k' = fromIntegral k-          (h,t) = LB.splitAt k' bs-      in if LB.length h == k'-         then Right (h, mkState t (n + k'))-         else Left (bs, [show k ++ " bytes"])+storable :: Storable a => Parser a+storable = hack undefined+ where+  hack :: Storable b => b -> Parser b+  hack dummy = do+    (fp,o,_) <- B.toForeignPtr `fmapP` take (sizeOf dummy)+    return . B.inlinePerformIO . withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o) --- | Consume bytes while the predicate succeeds.-takeWhile :: (Word8 -> Bool) -> Parser LB.ByteString-takeWhile p =-    Parser $ \(S sb lb n) ->-    let (h,t) = LB.span p (sb +: lb)-    in Right (h, mkState t (n + LB.length h))-{-# INLINE takeWhile #-}+-- | Consume @n@ bytes of input, but succeed only if the predicate+-- returns 'True'.+takeWith :: Int -> (B.ByteString -> Bool) -> Parser B.ByteString+takeWith n p = do+  ensure n+  s <- get+  let (h,t) = B.splitAt n s+  if p h+    then put t >> return h+    else failDesc "takeWith" --- | Consume bytes while the predicate fails.  If the predicate never--- succeeds, the entire input string is returned.-takeTill :: (Word8 -> Bool) -> Parser LB.ByteString-takeTill p =-  Parser $ \(S sb lb n) ->-  let (h,t) = LB.break p (sb +: lb)-  in Right (h, mkState t (n + LB.length h))+-- | Consume exactly @n@ bytes of input.+take :: Int -> Parser B.ByteString+take n = takeWith n (const True)+{-# INLINE take #-}++-- | @string s@ parses a sequence of bytes that identically match+-- @s@. Returns the parsed string (i.e. @s@).  This parser consumes no+-- input if it fails (even if a partial match).+--+-- /Note/: The behaviour of this parser is different to that of the+-- similarly-named parser in Parsec, as this one is all-or-nothing.+-- To illustrate the difference, the following parser will fail under+-- Parsec given an input of @"for"@:+--+-- >string "foo" <|> string "for"+--+-- The reason for its failure is that that the first branch is a+-- partial match, and will consume the letters @\'f\'@ and @\'o\'@+-- before failing.  In Attoparsec, the above parser will /succeed/ on+-- that input, because the failed first branch will consume nothing.+string :: B.ByteString -> Parser B.ByteString+string s = takeWith (B.length s) (==s)+{-# INLINE string #-}++stringTransform :: (B.ByteString -> B.ByteString) -> B.ByteString+                -> Parser B.ByteString+stringTransform f s = takeWith (B.length s) ((==s) . f)+{-# INLINE stringTransform #-}++-- | Skip past input for as long as the predicate returns 'True'.+skipWhile :: (Word8 -> Bool) -> Parser ()+skipWhile p = go+ where+  go = do+    input <- wantInput+    when input $ do+      t <- B8.dropWhile p <$> get+      put t+      when (B.null t) go++-- | Consume input as long as the predicate returns 'False'+-- (i.e. until it returns 'True'), and return the consumed input.+--+-- This parser does not fail.  It will return an empty string if the+-- predicate returns 'True' on the first byte of input.+--+-- /Note/: Because this parser does not fail, do not use it with+-- combinators such as 'many', because such parsers loop until a+-- failure occurs.  Careless use will thus result in an infinite loop.+takeTill :: (Word8 -> Bool) -> Parser B.ByteString+takeTill p = takeWhile (not . p) {-# INLINE takeTill #-} --- | Consume bytes while the predicate is true.  Fails if the--- predicate fails on the first byte.-takeWhile1 :: (Word8 -> Bool) -> Parser LB.ByteString-takeWhile1 p =-    Parser $ \(S sb lb n) ->-    case LB.span p (sb +: lb) of-      (h,t) | LB.null h -> Left (t, [])-            | otherwise -> Right (h, mkState t (n + LB.length h))-{-# INLINE takeWhile1 #-}+-- | Consume input as long as the predicate returns 'True', and return+-- the consumed input.+--+-- This parser does not fail.  It will return an empty string if the+-- predicate returns 'False' on the first byte of input.+--+-- /Note/: Because this parser does not fail, do not use it with+-- combinators such as 'many', because such parsers loop until a+-- failure occurs.  Careless use will thus result in an infinite loop.+takeWhile :: (Word8 -> Bool) -> Parser B.ByteString+takeWhile p = go+ where+  go = do+    input <- wantInput+    if input+      then do+        (h,t) <- B8.span p <$> get+        put t+        if B.null t+          then (h+++) `fmapP` go+          else return h+      else return B.empty --- | Test that a parser returned a non-null 'LB.ByteString'.-notEmpty :: Parser LB.ByteString -> Parser LB.ByteString -notEmpty p = Parser $ \s ->-             case unParser p s of-               o@(Right (a, _)) ->-                   if LB.null a-                   then Left (a, ["notEmpty"])-                   else o-               x -> x+-- | Consume input as long as the predicate returns 'True', and return+-- the consumed input.+--+-- This parser requires the predicate to succeed on at least one byte+-- of input: it will fail if the predicate never returns 'True' or if+-- there is no input left.+takeWhile1 :: (Word8 -> Bool) -> Parser B.ByteString+takeWhile1 p = do+  (`when` demandInput) =<< B.null <$> get+  (h,t) <- B8.span p <$> get+  when (B.null h) $ failDesc "takeWhile1"+  put t+  if B.null t+    then (h+++) `fmapP` takeWhile p+    else return h --- | Parse some input with the given parser, and return the input it--- consumed as a string.-match :: Parser a -> Parser LB.ByteString-match p = do bs <- getInput-             start <- getConsumed-             p-             end <- getConsumed-             return (LB.take (end - start) bs)+-- | Match any byte in a set.+--+-- >vowel = inClass "aeiou"+--+-- Range notation is supported.+--+-- >halfAlphabet = inClass "a-nA-N"+--+-- To add a literal @\'-\'@ to a set, place it at the beginning or end+-- of the string.+inClass :: String -> Word8 -> Bool+inClass s = (`memberWord8` mySet)+    where mySet = charClass s+{-# INLINE inClass #-} --- | Apply a parser without consuming any input.-lookAhead :: Parser a -> Parser a-lookAhead p = Parser $ \s ->-         case unParser p s of-           Right (m, _) -> Right (m, s)-           err -> err+-- | Match any byte not in a set.+notInClass :: String -> Word8 -> Bool+notInClass s = not . inClass s+{-# INLINE notInClass #-} --- | Run a parser. The 'Int64' value is used as a base to count the--- number of bytes consumed.-parseAt :: Parser a             -- ^ parser to run-        -> LB.ByteString        -- ^ input to parse-        -> Int64                -- ^ offset to count input from-        -> (LB.ByteString, Either ParseError (a, Int64))-parseAt p bs n = -    case unParser p (mkState bs n) of-      Left (bs', msg) -> (bs', Left $ showError msg)-      Right (a, ~(S sb lb n')) -> (sb +: lb, Right (a, n'))-    where-      showError [""] = "Parser error\n"-      showError [msg] = "Parser error, expected:\n" ++ msg ++ "\n"-      showError [] = "Parser error\n"-      showError msgs = "Parser error, expected one of:\n" ++ unlines msgs+-- | Match any byte.+anyWord8 :: Parser Word8+anyWord8 = satisfy $ const True+{-# INLINE anyWord8 #-} --- | Run a parser.-parse :: Parser a               -- ^ parser to run-      -> LB.ByteString          -- ^ input to parse-      -> (LB.ByteString, Either ParseError a)-parse p bs = case parseAt p bs 0 of-               (bs', Right (a, _)) -> (bs', Right a)-               (bs', Left err) -> (bs', Left err)+-- | Match a specific byte.+word8 :: Word8 -> Parser Word8+word8 c = satisfy (== c) <?> show c+{-# INLINE word8 #-} --- | Try out a parser, and print its result.-parseTest :: (Show a) => Parser a -> LB.ByteString -> IO ()-parseTest p s =-    case parse p s of-      (st, Left msg) -> putStrLn $ msg ++ "\nGot:\n" ++ show st-      (_, Right r) -> print r+-- | Match any byte except the given one.+notWord8 :: Word8 -> Parser Word8+notWord8 c = satisfy (/= c) <?> "not " ++ show c+{-# INLINE notWord8 #-} -#define PARSER Parser-#include "Word8Boilerplate.h"+-- | Match only if all input has been consumed.+endOfInput :: Parser ()+endOfInput = Parser $ \st0@S{..} kf ks ->+             if B.null input+             then if more == Complete+                  then ks st0 ()+                  else let kf' st1 _ _ = ks (mappend st0 st1) ()+                           ks' st1 _   = kf (mappend st0 st1) [] "endOfInput"+                       in  runParser demandInput st0 kf' ks'+             else kf st0 [] "endOfInput"+                                               +-- | Match either a single newline character @\'\\n\'@, or a carriage+-- return followed by a newline character @\"\\r\\n\"@.+endOfLine :: Parser ()+endOfLine = (word8 10 >> return ()) <|> (string (B.pack "\r\n") >> return ())++--- | Name the parser, in case failure occurs.+(<?>) :: Parser a+      -> String                 -- ^ the name to use if parsing fails+      -> Parser a+p <?> _msg = p+{-# INLINE (<?>) #-}+infix 0 <?>++-- | Terminal failure continuation.+failK :: Failure a+failK st0 stack msg = Fail st0 stack msg++-- | Terminal success continuation.+successK :: Success a a+successK state a = Done state a++-- | Run a parser.+parse :: Parser a -> B.ByteString -> Result a+parse m s = runParser m (S s B.empty Incomplete) failK successK+{-# INLINE parse #-}

@@ -0,0 +1,91 @@+-- |+-- Module      :  Data.Attoparsec.Lazy+-- Copyright   :  Bryan O'Sullivan 2010+-- License     :  BSD3+-- +-- Maintainer  :  bos@serpentine.com+-- Stability   :  experimental+-- Portability :  unknown+--+-- Simple, efficient combinator parsing for lazy 'ByteString'+-- strings, loosely based on the Parsec library.+--+-- This is essentially the same code as in the 'Data.Attoparsec'+-- module, only with a 'parse' function that can consume a lazy+-- 'ByteString' incrementally, and a 'Result' type that does not allow+-- more input to be fed in.  Think of this as suitable for use with a+-- lazily read file, e.g. via 'L.readFile' or 'L.hGetContents'.+--+-- Behind the scenes, strict 'B.ByteString' values are still used+-- internally to store parser input and manipulate it efficiently.+-- High-performance parsers such as 'string' still expect strict+-- 'B.ByteString' parameters.++module Data.Attoparsec.Lazy+    (+      Result(..)+    , module Data.Attoparsec+    -- * Running parsers+    , parse+    , parseTest+    -- ** Result conversion+    , maybeResult+    , eitherResult+    ) where++import Data.ByteString.Lazy.Internal (ByteString(..), chunk)+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as B+import qualified Data.Attoparsec as A+import Data.Attoparsec hiding (Result(..), eitherResult, maybeResult,+                               parse, parseWith, parseTest)++-- | The result of a parse.+data Result r = Fail ByteString [String] String+              -- ^ The parse failed.  The 'ByteString' is the input+              -- that had not yet been consumed when the failure+              -- occurred.  The @[@'String'@]@ is a list of contexts+              -- in which the error occurred.  The 'String' is the+              -- message describing the error, if any.+              | Done ByteString r+              -- ^ The parse succeeded.  The 'ByteString' is the+              -- input that had not yet been consumed (if any) when+              -- the parse succeeded.++instance Show r => Show (Result r) where+    show (Fail bs stk msg) =+        "Fail " ++ show bs ++ " " ++ show stk ++ " " ++ show msg+    show (Done bs r)       = "Done " ++ show bs ++ " " ++ show r++fmapR :: (a -> b) -> Result a -> Result b+fmapR _ (Fail st stk msg) = Fail st stk msg+fmapR f (Done bs r)       = Done bs (f r)++instance Functor Result where+    fmap = fmapR++-- | Run a parser and return its result.+parse :: A.Parser a -> ByteString -> Result a+parse p s = case s of+              Chunk x xs -> go (A.parse p x) xs+              empty      -> go (A.parse p B.empty) empty+  where+    go (A.Fail x stk msg) ys      = Fail (chunk x ys) stk msg+    go (A.Done x r) ys            = Done (chunk x ys) r+    go (A.Partial k) (Chunk y ys) = go (k y) ys+    go (A.Partial k) empty        = go (k B.empty) empty++-- | Run a parser and print its result to standard output.+parseTest :: (Show a) => A.Parser a -> ByteString -> IO ()+parseTest p s = print (parse p s)++-- | Convert a 'Result' value to a 'Maybe' value.+maybeResult :: Result r -> Maybe r+maybeResult (Done _ r) = Just r+maybeResult _          = Nothing++-- | Convert a 'Result' value to an 'Either' value.+eitherResult :: Result r -> Either String r+eitherResult (Done _ r)     = Right r+eitherResult (Fail _ _ msg) = Left msg+eitherResult _              = Left "Result: incomplete input"

@@ -1,34 +0,0 @@--- -*- haskell -*---- This file is intended to be #included by other source files.--instance MonadPlus (PARSER) where-    mzero = zero-    mplus = plus--instance Applicative (PARSER) where-    pure = return-    (<*>) = ap--instance Alternative (PARSER) where-    empty = zero-    (<|>) = plus---- | Skip over bytes while the predicate is true.-skipWhile :: (Word8 -> Bool) -> PARSER ()-skipWhile p = takeWhile p *> pure ()-{-# INLINE skipWhile #-}---- | Match any byte.-anyWord8 :: PARSER Word8-anyWord8 = satisfy $ const True-{-# INLINE anyWord8 #-}---- | Match a specific byte.-word8 :: Word8 -> PARSER Word8-word8 c = satisfy (== c) <?> show c-{-# INLINE word8 #-}---- | Match any byte except the given one.-notWord8 :: Word8 -> PARSER Word8-notWord8 c = satisfy (/= c) <?> "not " ++ show c-{-# INLINE notWord8 #-}

@@ -1,20 +1,32 @@ name:            attoparsec-version:         0.7.2+version:         0.8.0.0 license:         BSD3 license-file:    LICENSE category:        Text, Parsing author:          Bryan O'Sullivan <bos@serpentine.com> maintainer:      Bryan O'Sullivan <bos@serpentine.com> stability:       experimental-tested-with:     GHC == 6.8.3, GHC == 6.10.1-synopsis:        Fast combinator parsing with Data.ByteString.Lazy-description:     Fast combinator parsing with Data.ByteString.Lazy+tested-with:     GHC == 6.10.4, GHC == 6.12.1+synopsis:        Fast combinator parsing for bytestrings cabal-version:   >= 1.2 build-type:      Simple-description:     Fast, flexible text-oriented parsing of lazy ByteStrings.+description:+    A fast parser combinator library, aimed particularly at dealing+    efficiently with network protocols and complicated text/binary+    file formats. extra-source-files:-                 Data/Attoparsec/Char8Boilerplate.h-                 Data/Attoparsec/Word8Boilerplate.h+    benchmarks/Makefile+    benchmarks/Tiny.hs+    benchmarks/med.txt.bz2+    tests/Makefile+    tests/QC.hs+    tests/QCSupport.hs+    tests/TestFastSet.hs+    examples/Makefile+    examples/Parsec_RFC2616.hs+    examples/RFC2616.hs+    examples/TestRFC2616.hs+    examples/rfc2616.c  flag split-base flag applicative-in-base@@ -24,7 +36,7 @@     -- bytestring was in base-2.0 and 2.1.1     build-depends: base >= 2.0 && < 2.2   else-    -- in base 1.0 and 3.0 bytestring is a separate package+    -- in base 1.0 and >= 3.0 bytestring is a separate package     build-depends: base < 2.0 || >= 3, bytestring >= 0.9, containers >= 0.1.0.1    if flag(applicative-in-base)@@ -33,15 +45,12 @@   else     build-depends: base < 2.0 -  build-depends: bytestring-lexing >= 0.2-   extensions:      CPP   exposed-modules: Data.Attoparsec                    Data.Attoparsec.Char8                    Data.Attoparsec.Combinator-                   Data.Attoparsec.Incremental-                   Data.Attoparsec.Incremental.Char8                    Data.Attoparsec.FastSet+                   Data.Attoparsec.Lazy   other-modules:   Data.Attoparsec.Internal-  ghc-options:     -O2 -Wall -funbox-strict-fields-                   -fliberate-case-threshold=1000+  ghc-options:     -Wall+  ghc-prof-options: -auto-all

@@ -0,0 +1,10 @@+all: med.txt tiny++tiny: Tiny.hs+	ghc -O --make -o $@ $<++%: %.bz2+	bunzip2 -k $<++clean:+	-rm -f *.o *.hi tiny

@@ -0,0 +1,31 @@+import Control.Applicative ((<|>))+import Control.Monad (forM_)+import System.Environment (getArgs)+import qualified Data.Attoparsec.Char8 as A+import qualified Data.ByteString.Char8 as B+import qualified Text.Parsec as P+import qualified Text.Parsec.ByteString as P++attoparsec = do+  args <- getArgs+  forM_ args $ \arg -> do+    input <- B.readFile arg+    case A.parse p input `A.feed` B.empty of+      A.Done _ xs -> print (length xs)+      what        -> print what+ where+  slow = A.many (A.many1 A.letter <|> A.many1 A.digit)+  fast = A.many (A.takeWhile1 isLetter <|> A.takeWhile1 isDigit)+  isDigit c  = c >= '0' && c <= '9'+  isLetter c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')+  p = fast++parsec = do+  args <- getArgs+  forM_ args $ \arg -> do+    input <- readFile arg+    case P.parse (P.many (P.many1 P.letter P.<|> P.many1 P.digit)) "" input of+      Left err -> print err+      Right xs -> print (length xs)++main = attoparsec

binary file changed (absent → 518 bytes)

@@ -0,0 +1,15 @@+CC := gcc+CFLAGS := -O3 -Wall+# To make the code about 6% faster:+# CFLAGS += -fwhole-program --combine+CPPFLAGS := -I$(HOME)/hg/http-parser++all: c-http++c-http: rfc2616.c http_parser.c+	$(CC) $(CFLAGS) $(CPPFLAGS) -o $@ $^++clean:+	rm -f *.hi *.o c-http++vpath %.c $(HOME)/hg/http-parser

@@ -0,0 +1,85 @@+{-# LANGUAGE BangPatterns, CPP, FlexibleContexts #-}++module Main (main) where++import Control.Applicative+import Control.Exception (bracket)+import System.Environment (getArgs)+import System.IO (hClose, openFile, IOMode(ReadMode))+import Text.Parsec.Char (anyChar, char, satisfy, string)+import Text.Parsec.Combinator (many1, manyTill, skipMany1)+import Text.Parsec.Prim hiding (many, token, (<|>))+import qualified Data.IntSet as S++#if 1+import Text.Parsec.ByteString.Lazy (Parser, parseFromFile)+import qualified Data.ByteString.Lazy as B+#else+import Text.Parsec.ByteString (Parser, parseFromFile)+import qualified Data.ByteString as B+#endif++token :: Stream s m Char => ParsecT s u m Char+token = satisfy $ \c -> S.notMember (fromEnum c) set+  where set = S.fromList . map fromEnum $ ['\0'..'\31'] ++ "()<>@,;:\\\"/[]?={} \t" ++ ['\128'..'\255']++isHorizontalSpace c = c == ' ' || c == '\t'++skipHSpaces :: Stream s m Char => ParsecT s u m ()+skipHSpaces = skipMany1 (satisfy isHorizontalSpace)++data Request = Request {+      requestMethod   :: String+    , requestUri      :: String+    , requestProtocol :: String+    } deriving (Eq, Ord, Show)++requestLine :: Stream s m Char => ParsecT s u m Request+requestLine = do+  method <- many1 token <* skipHSpaces+  uri <- many1 (satisfy (not . isHorizontalSpace)) <* skipHSpaces <* string "HTTP/"+  proto <- many httpVersion <* endOfLine+  return $! Request method uri proto+ where+  httpVersion = satisfy $ \c -> c == '1' || c == '0' || c == '.'++endOfLine :: Stream s m Char => ParsecT s u m ()+endOfLine = (string "\r\n" *> pure ()) <|> (char '\n' *> pure ())++data Header = Header {+      headerName  :: String+    , headerValue :: [String]+    } deriving (Eq, Ord, Show)++messageHeader :: Stream s m Char => ParsecT s u m Header+messageHeader = do+  header <- many1 token <* char ':' <* skipHSpaces+  body <- manyTill anyChar endOfLine+  conts <- many $ skipHSpaces *> manyTill anyChar endOfLine+  return $! Header header (body:conts)++request :: Stream s m Char => ParsecT s u m (Request, [Header])+request = (,) <$> requestLine <*> many messageHeader <* endOfLine++listy arg = do+  r <- parseFromFile (many request) arg+  case r of+    Left err -> putStrLn $ arg ++ ": " ++ show err+    Right rs -> print (length rs)++chunky arg = bracket (openFile arg ReadMode) hClose $ \h ->+               loop 0 =<< B.hGetContents h+ where+  loop !n bs+      | B.null bs = print n+      | otherwise = case parse myReq arg bs of+                      Left err      -> putStrLn $ arg ++ ": " ++ show err+                      Right (r,bs') -> loop (n+1) bs'+  myReq :: Parser ((Request, [Header]), B.ByteString)+  myReq = liftA2 (,) request getInput++main :: IO ()+main = mapM_ f =<< getArgs+  where+    --f = listy+    f = chunky

@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}++module RFC2616+    (+      Request(..)+    , Header(..)+    , isToken+    , requestLine+    , messageHeader+    , request+    ) where++import Control.Applicative hiding (many)+import Data.Attoparsec as P+import Data.Attoparsec.Char8 (char8, endOfLine, isEndOfLine, isHorizontalSpace)+import Data.Word (Word8)+import qualified Data.ByteString.Char8 as B++isToken :: Word8 -> Bool+isToken w = notInClass "\0-\31()<>@,;:\\\"/[]?={} \t\128-\255" w++skipHSpaces :: Parser ()+skipHSpaces = satisfy isHorizontalSpace *> skipWhile isHorizontalSpace++data Request = Request {+      requestMethod   :: !B.ByteString+    , requestUri      :: !B.ByteString+    , requestProtocol :: !B.ByteString+    } deriving (Eq, Ord, Show)++requestLine :: Parser Request+requestLine = do+  method <- P.takeWhile1 isToken <* skipHSpaces+  uri <- P.takeWhile1 (not . isHorizontalSpace) <* skipHSpaces <* string "HTTP/"+  proto <- P.takeWhile1 isHttpVersion <* endOfLine+  return $! Request method uri proto+ where+  isHttpVersion w = w == 46 || w == 48 || w == 49++data Header = Header {+      headerName  :: !B.ByteString+    , headerValue :: [B.ByteString]+    } deriving (Eq, Ord, Show)++messageHeader :: Parser Header+messageHeader = do+  header <- P.takeWhile1 isToken <* char8 ':' <* skipHSpaces+  body <- takeTill isEndOfLine <* endOfLine+  conts <- many $ skipHSpaces *> takeTill isEndOfLine <* endOfLine+  return $! Header header (body:conts)++request :: Parser (Request, [Header])+request = (,) <$> requestLine <*> many messageHeader <* endOfLine

@@ -0,0 +1,37 @@+{-# LANGUAGE BangPatterns #-}+import RFC2616+import Control.Monad (forM_)+import System.IO+import Control.Exception (bracket)+import System.Environment+import qualified Data.ByteString.Char8 as B+import Data.Attoparsec++refill h = B.hGet h (4*1024)++listy file h = do+  r <- parseWith (refill h) (many request) =<< refill h+  case r of+    Fail _ _ msg -> hPutStrLn stderr $ file ++ ": " ++ msg+    Done _ reqs  -> print (length reqs)+  +incrementy file h = go 0 =<< refill h+ where+   go !n is = do+     r <- parseWith (refill h) request is+     case r of+       Fail _ _ msg -> hPutStrLn stderr $ file ++ ": " ++ msg+       Done bs _req+           | B.null bs -> do+              s <- refill h+              if B.null s+                then print (n+1)+                else go (n+1) s+           | otherwise -> go (n+1) bs+  +main = do+  args <- getArgs+  forM_ args $ \arg ->+    bracket (openFile arg ReadMode) hClose $+      -- listy arg+      incrementy arg

@@ -0,0 +1,238 @@+/*+ * This is a simple driver for Ryan Dahl's hand-bummed C http-parser+ * package.  It is intended to read one HTTP request after another+ * from a file, nothing more.+ *+ * For "feature parity" with the Haskell code in RFC2616.hs, we+ * allocate and populate a simple structure describing each request,+ * since that's the sort of thing that many real applications would+ * themselves do and the library doesn't do this for us.+ *+ * For the http-parser source, see http://github.com/ry/http-parser/+ */++/*+ * Turn off this preprocessor symbol to have the callbacks do nothing+ * at all, which "improves performance" by about 50%.+ */+#define LOOK_BUSY++#include <assert.h>+#include <fcntl.h>+#include <stdio.h>+#include <stdlib.h>+#include <string.h>+#include <sys/stat.h>+#include <sys/types.h>+#include <unistd.h>++#include "http_parser.h"+    +struct http_string {+    size_t len;+    char value[0];+};+    +struct http_header {+    struct http_string *name;+    struct http_string *value;+    struct http_header *next;+};+    +struct http_request {+    struct http_string *method;+    struct http_string *uri;+    struct http_header *headers, *last;+};++struct data {+    size_t count;+    struct http_request req;+};+  +static void *xmalloc(size_t size)+{+    void *ptr;++    if ((ptr = malloc(size)) == NULL) {+	perror("malloc");+	exit(1);+    }++    return ptr;+}++static struct http_string *xstrdup(const char *src, size_t len, size_t extra)+{+    struct http_string *dst = xmalloc(sizeof(*dst) + len + extra);+    memcpy(dst->value, src, len);+    dst->len = len;+    return dst;+}++static void xstrcat(struct http_string **dst, const char *src, size_t len)+{+    struct http_string *p;++    if (*dst == NULL) {+	*dst = xstrdup(src, len, 0);+	return;+    }+    +    p = xstrdup((*dst)->value, (*dst)->len, len);+    memcpy(p->value + (*dst)->len, src, len);+    p->len += len;+    free(*dst);+    *dst = p;+}++static int begin(http_parser *p)+{+    struct data *data = p->data;++    data->count++;++    return 0;+}++static int url(http_parser *p, const char *at, size_t len)+{+#ifdef LOOK_BUSY+    struct data *data = p->data;    ++    xstrcat(&data->req.uri, at, len);+#endif++    return 0;+}++static int header_field(http_parser *p, const char *at, size_t len)+{+#ifdef LOOK_BUSY+    struct data *data = p->data;++    if (data->req.last && data->req.last->value == NULL) {+	xstrcat(&data->req.last->name, at, len);+    } else {+	struct http_header *hdr = xmalloc(sizeof(*hdr));++	hdr->name = xstrdup(at, len, 0);+	hdr->value = NULL;+	hdr->next = NULL;+    +	if (data->req.last != NULL)+	    data->req.last->next = hdr;+	data->req.last = hdr;+	if (data->req.headers == NULL)+	    data->req.headers = hdr;+    }+#endif++    return 0;+}++static int header_value(http_parser *p, const char *at, size_t len)+{+#ifdef LOOK_BUSY+    struct data *data = p->data;++    xstrcat(&data->req.last->value, at, len);+#endif++    return 0;+}++static int complete(http_parser *p)+{+#ifdef LOOK_BUSY+    struct data *data = p->data;+    struct http_header *hdr, *next;++    free(data->req.method);+    free(data->req.uri);+	+    for (hdr = data->req.headers; hdr != NULL; hdr = next) {+	next = hdr->next;+	free(hdr->name);+	free(hdr->value);+	free(hdr);+	hdr = next;+    }++    data->req.method = NULL;+    data->req.uri = NULL;+    data->req.headers = NULL;+    data->req.last = NULL;+#endif+    +    /* Bludgeon http_parser into understanding that we really want to+     * keep parsing after a request that in principle ought to close+     * the "connection". */+    if (!http_should_keep_alive(p)) {+	p->http_major = 1;+	p->http_minor = 1;+	p->flags &= ~6;+    }++    return 0;+}++static void parse(const char *path, int fd)+{+    struct data data;+    http_parser p;+    ssize_t nread;++    http_parser_init(&p, HTTP_REQUEST);+    p.on_message_begin = begin;+    p.on_url = url;+    p.on_header_field = header_field;+    p.on_header_value = header_value;+    p.on_message_complete = complete;+    p.data = &data;+    data.count = 0;+    data.req.method = NULL;+    data.req.uri = NULL;+    data.req.headers = NULL;+    data.req.last = NULL;++    do {+	char buf[HTTP_MAX_HEADER_SIZE];+	size_t np;++	nread = read(fd, buf, sizeof(buf));++	np = http_parser_execute(&p, buf, nread);+	if (np != nread) {+	    fprintf(stderr, "%s: parse failed\n", path);+	    break;+	}+    } while (nread > 0);++    printf("%ld\n", (unsigned long) data.count);+}++int main(int argc, char **argv)+{+    int i;++    for (i = 1; i < argc; i++) {+	int fd;++	fd = open(argv[i], O_RDONLY);+	if (fd == -1) {+	    perror(argv[i]);+	    continue;+	}+	parse(argv[i], fd);+	close(fd);+    }++    return 0;+}++/*+ * Local Variables:+ * c-file-style: "stroustrup"+ * End:+ */

@@ -0,0 +1,14 @@+all: TestFastSet.out qc.out++%.out: %.exe+	./$< | tee $<.tmp+	mv $<.tmp $@++qc.exe: QC.hs+	ghc -O -fno-warn-orphans --make -o $@ $<++%.exe: %.hs+	ghc -O -fno-warn-orphans --make -o $@ $<++clean:+	-rm -f *.hi *.o *.exe *.out

@@ -0,0 +1,116 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import Control.Monad (forM_)+import Data.Maybe (isJust)+import Data.Word (Word8)+import Prelude hiding (takeWhile)+import QCSupport+import Test.Framework (defaultMain, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck hiding (NonEmpty)+import qualified Data.Attoparsec as P+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as C++-- Make sure that structures whose types claim they are non-empty+-- really are.++nonEmptyList l = length (nonEmpty l) > 0+    where types = l :: NonEmpty [Int]+nonEmptyBS l = B.length (nonEmpty l) > 0++-- Naming.++{-+label (NonEmpty s) = case parse (anyWord8 <?> s) B.empty of+                            (_, Left err) -> s `isInfixOf` err+                            _             -> False+-}++-- Basic byte-level combinators.++maybeP p s = case P.parse p s `P.feed` B.empty of+               P.Done _ i -> Just i+               _          -> Nothing++defP p s = P.parse p s `P.feed` B.empty++satisfy w s = maybeP (P.satisfy (<=w)) (B.cons w s) == Just w++word8 w s = maybeP (P.word8 w) (B.cons w s) == Just w++anyWord8 s = maybeP P.anyWord8 s == if B.null s+                                    then Nothing+                                    else Just (B.head s)++notWord8 w (NonEmpty s) = maybeP (P.notWord8 w) s == if v == w+                                                      then Nothing+                                                      else Just v+    where v = B.head s++string s = maybeP (P.string s) s == Just s++skipWhile w s =+    let t = B.dropWhile (<=w) s+    in case defP (P.skipWhile (<=w)) s of+         P.Done t' () -> t == t'+         _            -> False++takeCount (Positive k) s =+    case maybeP (P.take k) s of+      Nothing -> k > B.length s+      Just s' -> k <= B.length s++takeWhile w s =+    let (h,t) = B.span (==w) s+    in case defP (P.takeWhile (==w)) s of+         P.Done t' h' -> t == t' && h == h'+         _            -> False++takeWhile1 w s =+    let s'    = B.cons w s+        (h,t) = B.span (<=w) s'+    in case defP (P.takeWhile1 (<=w)) s' of+         P.Done t' h' -> t == t' && h == h'+         _            -> False++takeTill w s =+    let (h,t) = B.break (==w) s+    in case defP (P.takeTill (==w)) s of+         P.Done t' h' -> t == t' && h == h'+         _            -> False++ensure n s = case defP (P.ensure m) s of+               P.Done _ () -> B.length s >= m+               _           -> B.length s < m+    where m = (n `mod` 220) - 20++takeWhile1_empty = maybeP (P.takeWhile1 undefined) B.empty == Nothing++endOfInput s = maybeP P.endOfInput s == if B.null s+                                        then Just ()+                                        else Nothing++main = defaultMain tests++tests = [+  testGroup "fnord" [+    testProperty "nonEmptyList" nonEmptyList,+    testProperty "nonEmptyBS" nonEmptyBS,+    testProperty "satisfy" satisfy,+    testProperty "word8" word8,+    testProperty "notWord8" notWord8,+    testProperty "anyWord8" anyWord8,+    testProperty "string" string,+    testProperty "skipWhile" skipWhile,+    testProperty "takeCount" takeCount,+    testProperty "takeWhile" takeWhile,+    testProperty "takeWhile1" takeWhile1,+    testProperty "takeWhile1_empty" takeWhile1_empty,+    testProperty "takeTill" takeTill,+    testProperty "endOfInput" endOfInput,+    testProperty "ensure" ensure+    ]++  ]

@@ -0,0 +1,52 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances #-}+module QCSupport+    (+      NonEmpty(..)+    ) where++import Control.Applicative+import Data.Attoparsec+import Data.Word (Word8)+import System.Random (RandomGen, Random(..))+import Test.QuickCheck hiding (NonEmpty)+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L++integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)+integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer,+                                        fromIntegral b :: Integer) g of+                            (x,g') -> (fromIntegral x, g')++newtype NonEmpty a = NonEmpty { nonEmpty :: a }+    deriving (Eq, Ord, Read, Show)++instance Functor NonEmpty where+    fmap f (NonEmpty a) = NonEmpty (f a)++instance Applicative NonEmpty where+    NonEmpty f <*> NonEmpty a = NonEmpty (f a)+    pure a                    = NonEmpty a++instance Arbitrary a => Arbitrary (NonEmpty [a]) where+    arbitrary   = NonEmpty <$> sized (\n -> choose (1,n+1) >>= vector)++instance Arbitrary S.ByteString where+    arbitrary   = S.pack <$> arbitrary++instance Arbitrary (NonEmpty S.ByteString) where+    arbitrary   = fmap S.pack <$> arbitrary++instance Arbitrary L.ByteString where+    arbitrary   = sized $ \n -> resize (round (sqrt (toEnum n :: Double)))+                  ((L.fromChunks . map nonEmpty) <$> arbitrary)++instance Arbitrary (NonEmpty L.ByteString) where+    arbitrary   = sized $ \n -> resize (round (sqrt (toEnum n :: Double)))+                  (fmap (L.fromChunks . map nonEmpty) <$> arbitrary)++instance Random Word8 where+    randomR = integralRandomR+    random  = randomR (minBound,maxBound)++instance Arbitrary Word8 where+    arbitrary     = choose (minBound, maxBound)

@@ -0,0 +1,25 @@+module Main (main) where++import Data.Word (Word8)+import qualified Data.Attoparsec.FastSet as F+import System.Random (Random(..), RandomGen)+import Test.QuickCheck++integralRandomR :: (Integral a, RandomGen g) => (a, a) -> g -> (a, g)+integralRandomR (a,b) g = case randomR (fromIntegral a :: Int,+                                        fromIntegral b :: Int) g+                          of (x,g') -> (fromIntegral x, g')++instance Random Word8 where+  randomR = integralRandomR+  random = randomR (minBound,maxBound)++instance Arbitrary Word8 where+    arbitrary = choose (minBound, maxBound)++prop_AllMembers s =+    let set = F.fromList s+    in all (`F.memberWord8` set) s++main = do+  quickCheck prop_AllMembers