attoparsec 0.10.2.0 → 0.10.3.0

raw patch · 21 files changed

+325/−58 lines, 21 filesdep +criteriondep +parsecdep ~basedep ~textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: criterion, parsec

Dependency ranges changed: base, text

API changes (from Hackage documentation)

Files

• Data/Attoparsec.hs +1/−1
• Data/Attoparsec/ByteString.hs +3/−1
• Data/Attoparsec/ByteString/Char8.hs +6/−3
• Data/Attoparsec/ByteString/FastSet.hs +2/−2
• Data/Attoparsec/ByteString/Internal.hs +57/−18
• Data/Attoparsec/ByteString/Lazy.hs +1/−1
• Data/Attoparsec/Char8.hs +1/−1
• Data/Attoparsec/Combinator.hs +86/−2
• Data/Attoparsec/Internal.hs +31/−0
• Data/Attoparsec/Internal/Types.hs +1/−1
• Data/Attoparsec/Lazy.hs +1/−1
• Data/Attoparsec/Text.hs +4/−1
• Data/Attoparsec/Text/Internal.hs +56/−16
• Data/Attoparsec/Text/Lazy.hs +1/−1
• Data/Attoparsec/Zepto.hs +1/−1
• attoparsec.cabal +15/−2
• benchmarks/Benchmarks.hs +36/−1
• examples/RFC2616.hs +1/−1
• tests/QC.hs +1/−0
• tests/QC/ByteString.hs +8/−3
• tests/QC/Text.hs +12/−1

@@ -2,7 +2,7 @@ -- Module      :  Data.Attoparsec -- Copyright   :  Bryan O'Sullivan 2007-2011 -- License     :  BSD3--- +-- -- Maintainer  :  bos@serpentine.com -- Stability   :  experimental -- Portability :  unknown

@@ -2,7 +2,7 @@ -- Module      :  Data.Attoparsec.ByteString -- Copyright   :  Bryan O'Sullivan 2007-2011 -- License     :  BSD3--- +-- -- Maintainer  :  bos@serpentine.com -- Stability   :  experimental -- Portability :  unknown@@ -25,6 +25,7 @@       I.Parser     , Result     , T.IResult(..)+    , I.compareResults      -- * Running parsers     , parse@@ -75,6 +76,7 @@  import Data.Attoparsec.Combinator import qualified Data.Attoparsec.ByteString.Internal as I+import qualified Data.Attoparsec.Internal as I import qualified Data.ByteString as B import Data.Attoparsec.ByteString.Internal (Result, parse) import qualified Data.Attoparsec.Internal.Types as T

@@ -1,11 +1,12 @@-{-# LANGUAGE BangPatterns, FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE BangPatterns, FlexibleInstances, TypeFamilies,+    TypeSynonymInstances, GADTs #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  -- | -- Module      :  Data.Attoparsec.ByteString.Char8 -- Copyright   :  Bryan O'Sullivan 2007-2011 -- License     :  BSD3--- +-- -- Maintainer  :  bos@serpentine.com -- Stability   :  experimental -- Portability :  unknown@@ -22,6 +23,7 @@       Parser     , A.Result     , A.IResult(..)+    , I.compareResults      -- * Running parsers     , A.parse@@ -118,10 +120,11 @@ import Prelude hiding (takeWhile) import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString.Internal as I+import qualified Data.Attoparsec.Internal as I import qualified Data.ByteString as B8 import qualified Data.ByteString.Char8 as B -instance IsString (Parser B.ByteString) where+instance (a ~ B.ByteString) => IsString (Parser a) where     fromString = I.string . B.pack  -- $encodings

@@ -5,7 +5,7 @@ -- Module      :  Data.Attoparsec.ByteString.FastSet -- Copyright   :  Bryan O'Sullivan 2008 -- License     :  BSD3--- +-- -- Maintainer  :  bos@serpentine.com -- Stability   :  experimental -- Portability :  unknown@@ -14,7 +14,7 @@ -- set representation is unboxed for efficiency.  For small sets, we -- test for membership using a binary search.  For larger sets, we use -- a lookup table.--- +-- ----------------------------------------------------------------------------- module Data.Attoparsec.ByteString.FastSet     (

@@ -1,4 +1,5 @@-{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, RecordWildCards #-}+{-# LANGUAGE BangPatterns, CPP, Rank2Types, OverloadedStrings,+    RecordWildCards, MagicHash, UnboxedTuples #-} -- | -- Module      :  Data.Attoparsec.ByteString.Internal -- Copyright   :  Bryan O'Sullivan 2007-2011@@ -75,7 +76,6 @@ import Foreign.Ptr (castPtr, minusPtr, plusPtr) import Foreign.Storable (Storable(peek, sizeOf)) import Prelude hiding (getChar, take, takeWhile)-import System.IO.Unsafe (unsafePerformIO) import qualified Data.Attoparsec.Internal.Types as T import qualified Data.ByteString as B8 import qualified Data.ByteString.Char8 as B@@ -83,6 +83,13 @@ import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Unsafe as B +#if defined(__GLASGOW_HASKELL__)+import GHC.Base (realWorld#)+import GHC.IO (IO(IO))+#else+import System.IO.Unsafe (unsafePerformIO)+#endif+ type Parser = T.Parser B.ByteString type Result = IResult B.ByteString type Input = T.Input B.ByteString@@ -90,13 +97,26 @@ type Failure r = T.Failure B.ByteString r type Success a r = T.Success B.ByteString a r +ensure' :: Int -> Input -> Added -> More -> Failure r -> Success B.ByteString r+        -> IResult B.ByteString r+ensure' !n0 i0 a0 m0 kf0 ks0 =+    T.runParser (demandInput >> go n0) i0 a0 m0 kf0 ks0+  where+    go !n = T.Parser $ \i a m kf ks ->+        if B.length (unI i) >= n+        then ks i a m (unI i)+        else T.runParser (demandInput >> go n) i a m kf ks+ -- | If at least @n@ bytes of input are available, return the current -- input, otherwise fail. ensure :: Int -> Parser B.ByteString ensure !n = T.Parser $ \i0 a0 m0 kf ks ->     if B.length (unI i0) >= n     then ks i0 a0 m0 (unI i0)-    else T.runParser (demandInput >> ensure n) i0 a0 m0 kf ks+    -- The uncommon case is kept out-of-line to reduce code size:+    else ensure' n i0 a0 m0 kf ks+-- Non-recursive so the bounds check can be inlined:+{-# INLINE ensure #-}  -- | Ask for input.  If we receive any, pass it to a success -- continuation, otherwise to a failure continuation.@@ -155,10 +175,11 @@ satisfy :: (Word8 -> Bool) -> Parser Word8 satisfy p = do   s <- ensure 1-  let w = B.unsafeHead s+  let !w = B.unsafeHead s   if p w     then put (B.unsafeTail s) >> return w     else fail "satisfy"+{-# INLINE satisfy #-}  -- | The parser @skip p@ succeeds for any byte for which the predicate -- @p@ returns 'True'.@@ -178,10 +199,12 @@ satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a satisfyWith f p = do   s <- ensure 1-  let c = f (B.unsafeHead s)+  let c = f $! B.unsafeHead s   if p c-    then put (B.unsafeTail s) >> return c+    then let !t = B.unsafeTail s+         in put t >> return c     else fail "satisfyWith"+{-# INLINE satisfyWith #-}  storable :: Storable a => Parser a storable = hack undefined@@ -215,11 +238,11 @@ -- /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"@:+-- Parsec given an input of @\"for\"@: -- -- >string "foo" <|> string "for" ----- The reason for its failure is that that the first branch is a+-- The reason for its failure is 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.@@ -279,6 +302,7 @@           then go (h:acc)           else return (h:acc)       else return (h:acc)+{-# INLINE takeWhile #-}  takeRest :: Parser [B.ByteString] takeRest = go []@@ -318,7 +342,7 @@   chunks <- go [] s0   case chunks of     [x] -> return x-    xs  -> return . B.concat . reverse $ xs+    xs  -> return $! B.concat $ reverse xs  where   go acc s1 = do     let scanner (B.PS fp off len) =@@ -335,9 +359,9 @@                 done !i !s = return (T i s)             inner start s1     bs <- get-    let T i s' = unsafePerformIO $ scanner bs-        h = B.unsafeTake i bs-        t = B.unsafeDrop i bs+    let T i s' = inlinePerformIO $ scanner bs+        !h = B.unsafeTake i bs+        !t = B.unsafeDrop i bs     put t     if B.null t       then do@@ -408,12 +432,15 @@ -- failure occurs.  Careless use will thus result in an infinite loop. peekWord8 :: Parser (Maybe Word8) peekWord8 = T.Parser $ \i0 a0 m0 _kf ks ->-            let ks' i a m = let w = B.unsafeHead (unI i)-                            in w `seq` ks i a m (Just w)-                kf' i a m = ks i a m Nothing-            in if B.null (unI i0)-               then prompt i0 a0 m0 kf' ks'-               else ks' i0 a0 m0+            if B.null (unI i0)+            then if m0 == Complete+                 then ks i0 a0 m0 Nothing+                 else let ks' i a m = let !w = B.unsafeHead (unI i)+                                      in ks i a m (Just w)+                          kf' i a m = ks i a m Nothing+                      in prompt i0 a0 m0 kf' ks'+            else let !w = B.unsafeHead (unI i0)+                 in ks i0 a0 m0 (Just w) {-# INLINE peekWord8 #-}  -- | Match only if all input has been consumed.@@ -473,3 +500,15 @@                   Done _ a     -> Right a                   _            -> error "parseOnly: impossible error!" {-# INLINE parseOnly #-}++-- | Just like unsafePerformIO, but we inline it. Big performance gains as+-- it exposes lots of things to further inlining. /Very unsafe/. In+-- particular, you should do no memory allocation inside an+-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.+inlinePerformIO :: IO a -> a+#if defined(__GLASGOW_HASKELL__)+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r+#else+inlinePerformIO = unsafePerformIO+#endif+{-# INLINE inlinePerformIO #-}

@@ -2,7 +2,7 @@ -- Module      :  Data.Attoparsec.ByteString.Lazy -- Copyright   :  Bryan O'Sullivan 2010, 2011 -- License     :  BSD3--- +-- -- Maintainer  :  bos@serpentine.com -- Stability   :  experimental -- Portability :  unknown

@@ -2,7 +2,7 @@ -- Module      :  Data.Attoparsec.Char8 -- Copyright   :  Bryan O'Sullivan 2007-2011 -- License     :  BSD3--- +-- -- Maintainer  :  bos@serpentine.com -- Stability   :  experimental -- Portability :  unknown

@@ -3,7 +3,7 @@ -- Module      :  Data.Attoparsec.Combinator -- Copyright   :  Daan Leijen 1999-2001, Bryan O'Sullivan 2009-2010 -- License     :  BSD3--- +-- -- Maintainer  :  bos@serpentine.com -- Stability   :  experimental -- Portability :  portable@@ -14,10 +14,15 @@       choice     , count     , option+    , many'     , many1+    , many1'     , manyTill+    , manyTill'     , sepBy+    , sepBy'     , sepBy1+    , sepBy1'     , skipMany     , skipMany1     , eitherP@@ -25,6 +30,7 @@  import Control.Applicative (Alternative(..), Applicative(..), empty, liftA2,                             (<|>), (*>), (<$>))+import Control.Monad (MonadPlus(..)) #if !MIN_VERSION_base(4,2,0) import Control.Applicative (many) #endif@@ -60,6 +66,26 @@ {-# SPECIALIZE option :: a -> Z.Parser a -> Z.Parser a #-} #endif +-- | A version of 'liftM2' that is strict in the result of its first+-- action.+liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c+liftM2' f a b = do+  !x <- a+  y <- b+  return (f x y)+{-# INLINE liftM2' #-}++-- | @many' p@ applies the action @p@ /zero/ or more times. Returns a+-- list of the returned values of @p@. The value returned by @p@ is+-- forced to WHNF.+--+-- >  word  = many' letter+many' :: (MonadPlus m) => m a -> m [a]+many' p = many_p+  where many_p = some_p `mplus` return []+        some_p = liftM2' (:) p many_p+{-# INLINE many' #-}+ -- | @many1 p@ applies the action @p@ /one/ or more times. Returns a -- list of the returned values of @p@. --@@ -68,6 +94,15 @@ many1 p = liftA2 (:) p (many p) {-# INLINE many1 #-} +-- | @many1' p@ applies the action @p@ /one/ or more times. Returns a+-- list of the returned values of @p@. The value returned by @p@ is+-- forced to WHNF.+--+-- >  word  = many1' letter+many1' :: (MonadPlus m) => m a -> m [a]+many1' p = liftM2' (:) 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@. --@@ -81,10 +116,25 @@ {-# SPECIALIZE sepBy :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-} #endif +-- | @sepBy' p sep@ applies /zero/ or more occurrences of @p@, separated+-- by @sep@. Returns a list of the values returned by @p@. The value+-- returned by @p@ is forced to WHNF.+--+-- > commaSep p  = p `sepBy'` (symbol ",")+sepBy' :: (MonadPlus m) => m a -> m s -> m [a]+sepBy' p s = scan `mplus` return []+  where scan = liftM2' (:) p ((s >> sepBy1' p s) `mplus` return [])+#if __GLASGOW_HASKELL__ >= 700+{-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s+                      -> Parser ByteString [a] #-}+{-# SPECIALIZE sepBy' :: Parser Text a -> Parser Text s -> Parser Text [a] #-}+{-# SPECIALIZE sepBy' :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}+#endif+ -- | @sepBy1 p sep@ applies /one/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@. ----- > commaSep p  = p `sepBy` (symbol ",")+-- > commaSep p  = p `sepBy1` (symbol ",") sepBy1 :: Alternative f => f a -> f s -> f [a] sepBy1 p s = scan     where scan = liftA2 (:) p ((s *> scan) <|> pure [])@@ -95,6 +145,21 @@ {-# SPECIALIZE sepBy1 :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-} #endif +-- | @sepBy1' p sep@ applies /one/ or more occurrences of @p@, separated+-- by @sep@. Returns a list of the values returned by @p@. The value+-- returned by @p@ is forced to WHNF.+--+-- > commaSep p  = p `sepBy1'` (symbol ",")+sepBy1' :: (MonadPlus m) => m a -> m s -> m [a]+sepBy1' p s = scan+    where scan = liftM2' (:) p ((s >> scan) `mplus` return [])+#if __GLASGOW_HASKELL__ >= 700+{-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s+                       -> Parser ByteString [a] #-}+{-# SPECIALIZE sepBy1' :: Parser Text a -> Parser Text s -> Parser Text [a] #-}+{-# SPECIALIZE sepBy1' :: Z.Parser a -> Z.Parser s -> Z.Parser [a] #-}+#endif+ -- | @manyTill p end@ applies action @p@ /zero/ or more times until -- action @end@ succeeds, and returns the list of values returned by -- @p@.  This can be used to scan comments:@@ -111,6 +176,25 @@                         -> Parser ByteString [a] #-} {-# SPECIALIZE manyTill :: Parser Text a -> Parser Text b -> Parser Text [a] #-} {-# SPECIALIZE manyTill :: Z.Parser a -> Z.Parser b -> Z.Parser [a] #-}+#endif++-- | @manyTill' p end@ applies action @p@ /zero/ or more times until+-- action @end@ succeeds, and returns the list of values returned by+-- @p@.  This can be used to scan comments:+--+-- >  simpleComment   = string "<!--" *> manyTill' anyChar (try (string "-->"))+--+-- Note the overlapping parsers @anyChar@ and @string \"<!--\"@, and+-- therefore the use of the 'try' combinator. The value returned by @p@+-- is forced to WHNF.+manyTill' :: (MonadPlus m) => m a -> m b -> m [a]+manyTill' p end = scan+    where scan = (end >> return []) `mplus` liftM2' (:) p scan+#if __GLASGOW_HASKELL__ >= 700+{-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b+                         -> Parser ByteString [a] #-}+{-# SPECIALIZE manyTill' :: Parser Text a -> Parser Text b -> Parser Text [a] #-}+{-# SPECIALIZE manyTill' :: Z.Parser a -> Z.Parser b -> Z.Parser [a] #-} #endif  -- | Skip zero or more instances of an action.

@@ -0,0 +1,31 @@+-- |+-- Module      :  Data.Attoparsec.Internal+-- Copyright   :  Bryan O'Sullivan 2012+-- License     :  BSD3+--+-- Maintainer  :  bos@serpentine.com+-- Stability   :  experimental+-- Portability :  unknown+--+-- Simple, efficient parser combinators, loosely based on the Parsec+-- library.++module Data.Attoparsec.Internal+    (+      compareResults+    ) where++import Data.Attoparsec.Internal.Types (IResult(..))++-- | Compare two 'IResult' values for equality.+--+-- If both 'IResult's are 'Partial', the result will be 'Nothing', as+-- they are incomplete and hence their equality cannot be known.+-- (This is why there is no 'Eq' instance for 'IResult'.)+compareResults :: (Eq t, Eq r) => IResult t r -> IResult t r -> Maybe Bool+compareResults (Fail i0 ctxs0 msg0) (Fail i1 ctxs1 msg1) =+    Just (i0 == i1 && ctxs0 == ctxs1 && msg0 == msg1)+compareResults (Done i0 r0) (Done i1 r1) =+    Just (i0 == i1 && r0 == r1)+compareResults (Partial _) (Partial _) = Nothing+compareResults _ _ = Just False

@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, RecordWildCards #-}+{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, RecordWildCards, CPP #-} -- | -- Module      :  Data.Attoparsec.Internal.Types -- Copyright   :  Bryan O'Sullivan 2007-2011

@@ -2,7 +2,7 @@ -- Module      :  Data.Attoparsec.Lazy -- Copyright   :  Bryan O'Sullivan 2010 -- License     :  BSD3--- +-- -- Maintainer  :  bos@serpentine.com -- Stability   :  experimental -- Portability :  unknown

@@ -4,7 +4,7 @@ -- Module      :  Data.Attoparsec.Text -- Copyright   :  Bryan O'Sullivan 2011 -- License     :  BSD3--- +-- -- Maintainer  :  bos@serpentine.com -- Stability   :  experimental -- Portability :  unknown@@ -27,6 +27,7 @@       Parser     , Result     , T.IResult(..)+    , I.compareResults      -- * Running parsers     , parse@@ -65,6 +66,7 @@     -- * Efficient string handling     , I.string     , I.stringCI+    , I.asciiCI     , skipSpace     , I.skipWhile     , I.scan@@ -111,6 +113,7 @@ import Data.Ratio ((%)) import Data.Text (Text) import Data.Word (Word8, Word16, Word32, Word64, Word)+import qualified Data.Attoparsec.Internal as I import qualified Data.Attoparsec.Internal.Types as T import qualified Data.Attoparsec.Text.Internal as I import qualified Data.Text as T

@@ -1,5 +1,5 @@-{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings, Rank2Types,-    RecordWildCards, TypeSynonymInstances #-}+{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, GADTs, OverloadedStrings,+    Rank2Types, RecordWildCards, TypeFamilies, TypeSynonymInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module      :  Data.Attoparsec.Text.Internal@@ -45,6 +45,7 @@     , skipWhile     , string     , stringCI+    , asciiCI     , take     , scan     , takeWhile@@ -70,9 +71,11 @@ import Data.String (IsString(..)) import Data.Text (Text) import Prelude hiding (getChar, take, takeWhile)+import Data.Char (chr, ord) import qualified Data.Attoparsec.Internal.Types as T import qualified Data.Attoparsec.Text.FastSet as Set import qualified Data.Text as T+import qualified Data.Text.Internal as T import qualified Data.Text.Lazy as L  type Parser = T.Parser Text@@ -82,16 +85,26 @@ type Failure r = T.Failure Text r type Success a r = T.Success Text a r -instance IsString (Parser Text) where+instance (a ~ Text) => IsString (Parser a) where     fromString = string . T.pack +lengthAtLeast :: T.Text -> Int -> Bool+lengthAtLeast t@(T.Text _ _ len) n = (len `div` 2) >= n || T.length t >= n+{-# INLINE lengthAtLeast #-}+ -- | If at least @n@ characters of input are available, return the -- current input, otherwise fail. ensure :: Int -> Parser Text ensure !n = T.Parser $ \i0 a0 m0 kf ks ->-    if T.length (unI i0) >= n+    if lengthAtLeast (unI i0) n     then ks i0 a0 m0 (unI i0)-    else runParser (demandInput >> ensure n) i0 a0 m0 kf ks+    else runParser (demandInput >> go n) i0 a0 m0 kf ks+  where+    go n' = T.Parser $ \i0 a0 m0 kf ks ->+        if lengthAtLeast (unI i0) n'+        then ks i0 a0 m0 (unI i0)+        else runParser (demandInput >> go n') i0 a0 m0 kf ks+{-# INLINE ensure #-}  -- | Ask for input.  If we receive any, pass it to a success -- continuation, otherwise to a failure continuation.@@ -162,10 +175,11 @@ satisfy :: (Char -> Bool) -> Parser Char satisfy p = do   s <- ensure 1-  let w = unsafeHead s+  let !w = unsafeHead s   if p w     then put (unsafeTail s) >> return w     else fail "satisfy"+{-# INLINE satisfy #-}  -- | The parser @skip p@ succeeds for any character for which the -- predicate @p@ returns 'True'.@@ -185,10 +199,12 @@ satisfyWith :: (Char -> a) -> (a -> Bool) -> Parser a satisfyWith f p = do   s <- ensure 1-  let c = f (unsafeHead s)+  let c = f $! unsafeHead s   if p c-    then put (unsafeTail s) >> return c+    then let !t = unsafeTail s+         in put t >> return c     else fail "satisfyWith"+{-# INLINE satisfyWith #-}  -- | Consume @n@ characters of input, but succeed only if the -- predicate returns 'True'.@@ -213,11 +229,11 @@ -- /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"@:+-- Parsec given an input of @\"for\"@: -- -- >string "foo" <|> string "for" ----- The reason for its failure is that that the first branch is a+-- The reason for its failure is 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.@@ -244,7 +260,28 @@         else go (n+1)     fs = T.toCaseFold s {-# INLINE stringCI #-}+{-# DEPRECATED stringCI "this is very inefficient, use asciiCI instead" #-} +-- | Satisfy a literal string, ignoring case for characters in the ASCII range.+asciiCI :: Text -> Parser Text+asciiCI input = do+  t <- ensure n+  let h = unsafeTake n t+  if asciiToLower h == s+    then put (unsafeDrop n t) >> return h+    else fail "asciiCI"+  where+    n = T.length input+    s = asciiToLower input++    -- convert letters in the ASCII range to lower-case+    asciiToLower = T.map f+      where+        offset = ord 'a' - ord 'A'+        f c | 'A' <= c && c <= 'Z' = chr (ord c + offset)+            | otherwise            = c+{-# INLINE asciiCI #-}+ -- | Skip past input for as long as the predicate returns 'True'. skipWhile :: (Char -> Bool) -> Parser () skipWhile p = go@@ -411,12 +448,15 @@ -- failure occurs.  Careless use will thus result in an infinite loop. peekChar :: Parser (Maybe Char) peekChar = T.Parser $ \i0 a0 m0 _kf ks ->-       let ks' i a m = let w = unsafeHead (unI i)-                       in w `seq` ks i a m (Just w)-           kf' i a m = ks i a m Nothing-       in if T.null (unI i0)-          then prompt i0 a0 m0 kf' ks'-          else ks' i0 a0 m0+           if T.null (unI i0)+           then if m0 == Complete+                then ks i0 a0 m0 Nothing+                else let ks' i a m = let !c = unsafeHead (unI i)+                                     in ks i a m (Just c)+                         kf' i a m = ks i a m Nothing+                     in prompt i0 a0 m0 kf' ks'+           else let !c = unsafeHead (unI i0)+                in ks i0 a0 m0 (Just c) {-# INLINE peekChar #-}  -- | Match only if all input has been consumed.

@@ -2,7 +2,7 @@ -- Module      :  Data.Attoparsec.Text.Lazy -- Copyright   :  Bryan O'Sullivan 2011 -- License     :  BSD3--- +-- -- Maintainer  :  bos@serpentine.com -- Stability   :  experimental -- Portability :  unknown

@@ -4,7 +4,7 @@ -- Module      :  Data.Attoparsec.Zepto -- Copyright   :  Bryan O'Sullivan 2011 -- License     :  BSD3--- +-- -- Maintainer  :  bos@serpentine.com -- Stability   :  experimental -- Portability :  unknown

@@ -1,5 +1,5 @@ name:            attoparsec-version:         0.10.2.0+version:         0.10.3.0 license:         BSD3 license-file:    LICENSE category:        Text, Parsing@@ -45,7 +45,6 @@                  deepseq,                  text >= 0.11.1.5 -  extensions:      CPP   exposed-modules: Data.Attoparsec                    Data.Attoparsec.ByteString                    Data.Attoparsec.ByteString.Char8@@ -60,6 +59,7 @@                    Data.Attoparsec.Zepto   other-modules:   Data.Attoparsec.ByteString.FastSet                    Data.Attoparsec.ByteString.Internal+                   Data.Attoparsec.Internal                    Data.Attoparsec.Internal.Types                    Data.Attoparsec.Text.FastSet                    Data.Attoparsec.Text.Internal@@ -85,6 +85,19 @@     QuickCheck >= 2.4,     test-framework >= 0.4,     test-framework-quickcheck2 >= 0.2,+    text++benchmark benchmarks+  type: exitcode-stdio-1.0+  hs-source-dirs: benchmarks+  main-is: Benchmarks.hs+  build-depends:+    attoparsec,+    base,+    bytestring,+    criterion >= 0.5,+    deepseq >= 1.1,+    parsec >= 3.1.2,     text  source-repository head

@@ -1,10 +1,12 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns, CPP #-}  import Control.Applicative import Control.DeepSeq (NFData(rnf)) import Criterion.Main (bench, bgroup, defaultMain, nf, whnf)+import Data.Bits (unsafeShiftL) import Data.ByteString.Internal (ByteString(..)) import Data.Char+import Data.Word (Word32) import Text.Parsec.Text () import Text.Parsec.Text.Lazy () import qualified Data.Attoparsec.ByteString as AB@@ -17,10 +19,13 @@ import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Data.Text.Lazy as TL+import Data.Word (Word8) import qualified Text.Parsec as P +#if !MIN_VERSION_bytestring(0,10,0) instance NFData ByteString where     rnf (PS _ _ _) = ()+#endif  instance NFData P.ParseError where     rnf = rnf . show@@ -71,4 +76,34 @@      , bench "isAlpha_ascii" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_ascii)) bl      , bench "isAlpha_iso8859_15" $ nf (ABL.parse (AC.takeWhile AC.isAlpha_iso8859_15)) bl      ]+   , bench "word32LE" $ nf (AB.parse word32LE) b+   , bgroup "scan" [+       bench "short" $ nf (AB.parse quotedString) (BC.pack "abcdefghijk\"")+     , bench "long" $ nf (AB.parse quotedString) b+     ]    ]++-- Benchmarks bind and (potential) bounds-check merging.+word32LE :: AB.Parser Word32+word32LE = do+    w1 <- AB.anyWord8+    w2 <- AB.anyWord8+    w3 <- AB.anyWord8+    w4 <- AB.anyWord8+    return $! (fromIntegral w1 :: Word32) ++        fromIntegral w2 `unsafeShiftL` 8 ++        fromIntegral w3 `unsafeShiftL` 16 ++        fromIntegral w4 `unsafeShiftL` 32++doubleQuote, backslash :: Word8+doubleQuote = 34+backslash = 92+{-# INLINE backslash #-}+{-# INLINE doubleQuote #-}++-- | Parse a string without a leading quote.+quotedString :: AB.Parser B.ByteString+quotedString = AB.scan False $ \s c -> if s then Just False+                                       else if c == doubleQuote+                                            then Nothing+                                            else Just (c == backslash)

@@ -36,7 +36,7 @@     } deriving (Eq, Ord, Show)  httpVersion :: Parser B.ByteString-httpVersion = string "HTTP/" *> P.takeWhile (\c -> isDigit_w8 c || c == 46)+httpVersion = "HTTP/" *> P.takeWhile (\c -> isDigit_w8 c || c == 46)  requestLine :: Parser Request requestLine = do

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-} module Main (main) where  import qualified QC.ByteString as ByteString

@@ -1,5 +1,5 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE BangPatterns, OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-} module QC.ByteString (tests) where  import Control.Applicative ((<$>), (<*>))@@ -94,6 +94,10 @@                                         then Just ()                                         else Nothing +scan s (Positive k) = maybeP p s == (Just $ toStrict $ L.take k s)+  where p = P.scan k $ \ n _ ->+            if n > 0 then let !n' = n - 1 in Just n' else Nothing+ tests = [     testProperty "satisfy" satisfy,     testProperty "word8" word8,@@ -107,5 +111,6 @@     testProperty "takeWhile1" takeWhile1,     testProperty "takeWhile1_empty" takeWhile1_empty,     testProperty "takeTill" takeTill,-    testProperty "endOfInput" endOfInput+    testProperty "endOfInput" endOfInput,+    testProperty "scan" scan   ]

@@ -1,11 +1,12 @@ {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-} module QC.Text (tests) where  import Control.Applicative ((<$>), (<*>)) import Prelude hiding (takeWhile) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck+import qualified Data.Char as Char import qualified Data.Attoparsec.Text as P import qualified Data.Attoparsec.Text.Lazy as PL import qualified Data.Text as T@@ -59,6 +60,15 @@ stringCI s = P.parseOnly (P.stringCI fs) s == Right s   where fs = T.toCaseFold s +asciiCI x =+  (\s i -> P.parseOnly (P.asciiCI s) i == Right i)+    <$> maybeModifyCase x+    <*> maybeModifyCase x+  where+    maybeModifyCase s = elements [s, toLower s, toUpper s]+    toLower = T.map (\c -> if c < Char.chr 127 then Char.toLower c else c)+    toUpper = T.map (\c -> if c < Char.chr 127 then Char.toUpper c else c)+ toStrict = T.concat . L.toChunks  skipWhile w s =@@ -105,6 +115,7 @@     testProperty "peekChar" peekChar,     testProperty "string" string,     testProperty "stringCI" stringCI,+    testProperty "asciiCI" asciiCI,     testProperty "skipWhile" skipWhile,     testProperty "takeCount" takeCount,     testProperty "takeWhile" takeWhile,