attoparsec 0.12.1.3 → 0.12.1.4

raw patch · 26 files changed

+314/−102 lines, 26 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• Data/Attoparsec.hs +1/−1
• Data/Attoparsec/ByteString.hs +10/−4
• Data/Attoparsec/ByteString/Buffer.hs +1/−1
• Data/Attoparsec/ByteString/Char8.hs +5/−12
• Data/Attoparsec/ByteString/FastSet.hs +1/−1
• Data/Attoparsec/ByteString/Internal.hs +60/−23
• Data/Attoparsec/ByteString/Lazy.hs +10/−3
• Data/Attoparsec/Char8.hs +1/−1
• Data/Attoparsec/Combinator.hs +17/−6
• Data/Attoparsec/Internal.hs +18/−4
• Data/Attoparsec/Internal/Types.hs +10/−7
• Data/Attoparsec/Lazy.hs +1/−1
• Data/Attoparsec/Number.hs +1/−1
• Data/Attoparsec/Text.hs +9/−4
• Data/Attoparsec/Text/Buffer.hs +1/−1
• Data/Attoparsec/Text/FastSet.hs +1/−1
• Data/Attoparsec/Text/Internal.hs +47/−15
• Data/Attoparsec/Text/Lazy.hs +11/−8
• Data/Attoparsec/Types.hs +1/−1
• Data/Attoparsec/Zepto.hs +5/−1
• attoparsec.cabal +4/−4
• benchmarks/Benchmarks.hs +2/−0
• benchmarks/Genome.hs +75/−0
• changelog.md +9/−0
• tests/QC/Combinator.hs +12/−1
• tests/QC/Rechunked.hs +1/−1

@@ -1,6 +1,6 @@ -- | -- Module      :  Data.Attoparsec--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com

@@ -1,6 +1,10 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif -- | -- Module      :  Data.Attoparsec.ByteString--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com@@ -92,6 +96,7 @@     ) where  import Data.Attoparsec.Combinator+import Data.List (intercalate) import qualified Data.Attoparsec.ByteString.Internal as I import qualified Data.Attoparsec.Internal as I import qualified Data.ByteString as B@@ -218,6 +223,7 @@ -- | Convert a 'Result' value to an 'Either' value. A 'T.Partial' -- result is treated as failure. eitherResult :: Result r -> Either String r-eitherResult (T.Done _ r)     = Right r-eitherResult (T.Fail _ _ msg) = Left msg-eitherResult _                = Left "Result: incomplete input"+eitherResult (T.Done _ r)        = Right r+eitherResult (T.Fail _ [] msg)   = Left msg+eitherResult (T.Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg)+eitherResult _                   = Left "Result: incomplete input"

@@ -1,7 +1,7 @@ {-# LANGUAGE BangPatterns, CPP #-} -- | -- Module      :  Data.Attoparsec.ByteString.Buffer--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com

@@ -1,10 +1,13 @@ {-# LANGUAGE BangPatterns, CPP, FlexibleInstances, TypeFamilies,     TypeSynonymInstances, GADTs #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-} -- Imports internal modules+#endif {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-}  -- | -- Module      :  Data.Attoparsec.ByteString.Char8--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com@@ -67,7 +70,7 @@      -- * Efficient string handling     , I.string-    , stringCI+    , I.stringCI     , skipSpace     , skipWhile     , I.take@@ -165,16 +168,6 @@ -- @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 :: B.ByteString -> Parser B.ByteString-stringCI = I.stringTransform (B8.map toLower)-{-# INLINE stringCI #-}  -- | Consume input as long as the predicate returns 'True', and return -- the consumed input.

@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module      :  Data.Attoparsec.ByteString.FastSet--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com

@@ -1,7 +1,7 @@-{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings, RecordWildCards #-}+{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings, RankNTypes, RecordWildCards #-} -- | -- Module      :  Data.Attoparsec.ByteString.Internal--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com@@ -46,7 +46,7 @@     -- * Efficient string handling     , skipWhile     , string-    , stringTransform+    , stringCI     , take     , scan     , runScanner@@ -74,6 +74,7 @@ import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO) import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success) import Data.ByteString (ByteString)+import Data.List (intercalate) import Data.Word (Word8) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr (castPtr, minusPtr, plusPtr)@@ -139,19 +140,12 @@     return . inlinePerformIO . withForeignPtr fp $ \p ->         peek (castPtr $ p `plusPtr` o) --- | Consume @n@ bytes of input, but succeed only if the predicate--- returns 'True'.-takeWith :: Int -> (ByteString -> Bool) -> Parser ByteString-takeWith n0 p = do-  let n = max n0 0-  s <- ensure n-  if p s-    then advance n >> return s-    else fail "takeWith"- -- | Consume exactly @n@ bytes of input. take :: Int -> Parser ByteString-take n = takeWith n (const True)+take n0 = do+  let n = max n0 0+  s <- ensure n+  advance n >> return s {-# INLINE take #-}  -- | @string s@ parses a sequence of bytes that identically match@@ -170,14 +164,57 @@ -- before failing.  In attoparsec, the above parser will /succeed/ on -- that input, because the failed first branch will consume nothing. string :: ByteString -> Parser ByteString-string s = takeWith (B.length s) (==s)+string s = string_ (stringSuspended id) id s {-# INLINE string #-} -stringTransform :: (ByteString -> ByteString) -> ByteString-                -> Parser ByteString-stringTransform f s = takeWith (B.length s) ((==f s) . f)-{-# INLINE stringTransform #-}+-- 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 :: ByteString -> Parser ByteString+stringCI s = string_ (stringSuspended lower) lower s+  where lower = B8.map toLower+{-# INLINE stringCI #-}++string_ :: (forall r. ByteString -> ByteString -> Buffer -> Pos -> More+            -> Failure r -> Success ByteString r -> Result r)+        -> (ByteString -> ByteString)+        -> ByteString -> Parser ByteString+string_ suspended f s0 = T.Parser $ \t pos more lose succ ->+  let n = B.length s+      s = f s0+  in if lengthAtLeast pos n t+     then if s == substring pos (Pos n) t+          then succ t (pos + Pos n) more s+          else lose t pos more [] "string"+     else let t' = Buf.unsafeDrop (fromPos pos) t+          in if t' `B.isPrefixOf` s+             then suspended s (B.drop (B.length t') s) t pos more lose succ+             else lose t pos more [] "string"+{-# INLINE string_ #-}++stringSuspended :: (ByteString -> ByteString)+                -> ByteString -> ByteString -> Buffer -> Pos -> More+                -> Failure r+                -> Success ByteString r+                -> Result r+stringSuspended f s0 s t pos more lose succ =+    runParser (demandInput_ >>= go) t pos more lose succ+  where go s'0   = T.Parser $ \t' pos' more' lose' succ' ->+          let m  = B.length s+              s' = f s'0+              n  = B.length s'+          in if n >= m+             then if B.unsafeTake m s' == s+                  then succ' t' (pos' + Pos (B.length s0)) more' s0+                  else lose' t' pos' more' [] "string"+             else if s' == B.unsafeTake n s+                  then stringSuspended f s0 (B.unsafeDrop n s)+                       t' pos' more' lose' succ'+                  else lose' t' pos' more' [] "string"+ -- | Skip past input for as long as the predicate returns 'True'. skipWhile :: (Word8 -> Bool) -> Parser () skipWhile p = go@@ -416,9 +453,10 @@ -- @ parseOnly :: Parser a -> ByteString -> Either String a parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of-                  Fail _ _ err -> Left err-                  Done _ a     -> Right a-                  _            -> error "parseOnly: impossible error!"+                  Fail _ [] err   -> Left err+                  Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err)+                  Done _ a        -> Right a+                  _               -> error "parseOnly: impossible error!" {-# INLINE parseOnly #-}  get :: Parser ByteString@@ -465,7 +503,6 @@     then succ t pos more (substring pos (Pos n) t)     -- The uncommon case is kept out-of-line to reduce code size:     else ensureSuspended n t pos more lose succ--- Non-recursive so the bounds check can be inlined: {-# INLINE ensure #-}  -- | Return both the result of a parse and the portion of the input

@@ -1,6 +1,11 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-} -- Imports internal modules+#endif+ -- | -- Module      :  Data.Attoparsec.ByteString.Lazy--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com@@ -36,6 +41,7 @@  import Control.DeepSeq (NFData(rnf)) import Data.ByteString.Lazy.Internal (ByteString(..), chunk)+import Data.List (intercalate) import qualified Data.ByteString as B import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.Internal.Types as T@@ -99,5 +105,6 @@  -- | 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 (Done _ r)        = Right r+eitherResult (Fail _ [] msg)   = Left msg+eitherResult (Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg)

@@ -1,6 +1,6 @@ -- | -- Module      :  Data.Attoparsec.Char8--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com

@@ -1,7 +1,10 @@ {-# LANGUAGE BangPatterns, CPP #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-} -- Imports internal modules+#endif -- | -- Module      :  Data.Attoparsec.Combinator--- Copyright   :  Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2014+-- Copyright   :  Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com@@ -33,6 +36,7 @@     , satisfyElem     , endOfInput     , atEnd+    , lookAhead     ) where  #if !MIN_VERSION_base(4,8,0)@@ -129,7 +133,7 @@ -- | @sepBy p sep@ applies /zero/ 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 `sepBy` (char ',') sepBy :: Alternative f => f a -> f s -> f [a] sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure [] {-# SPECIALIZE sepBy :: Parser ByteString a -> Parser ByteString s@@ -141,7 +145,7 @@ -- 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 ",")+-- > commaSep p  = p `sepBy'` (char ',') 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 [])@@ -153,7 +157,7 @@ -- | @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 `sepBy1` (symbol ",")+-- > commaSep p  = p `sepBy1` (char ',') sepBy1 :: Alternative f => f a -> f s -> f [a] sepBy1 p s = scan     where scan = liftA2 (:) p ((s *> scan) <|> pure [])@@ -166,7 +170,7 @@ -- 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 ",")+-- > commaSep p  = p `sepBy1'` (char ',') sepBy1' :: (MonadPlus m) => m a -> m s -> m [a] sepBy1' p s = scan     where scan = liftM2' (:) p ((s >> scan) `mplus` return [])@@ -239,7 +243,14 @@ -- | If a parser has returned a 'T.Partial' result, supply it with more -- input. feed :: Monoid i => IResult i r -> i -> IResult i r-feed f@(Fail _ _ _) _ = f+feed (Fail t ctxs msg) d = Fail (mappend t d) ctxs msg feed (Partial k) d    = k d feed (Done t r) d     = Done (mappend t d) r {-# INLINE feed #-}++-- | Apply a parser without consuming any input.+lookAhead :: Parser i a -> Parser i a+lookAhead p = Parser $ \t pos more lose succ ->+  let succ' t' _pos' more' = succ t' pos more'+  in runParser p t pos more lose succ'+{-# INLINE lookAhead #-}

@@ -1,7 +1,7 @@ {-# LANGUAGE BangPatterns, ScopedTypeVariables #-} -- | -- Module      :  Data.Attoparsec.Internal--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com@@ -15,6 +15,7 @@     ( compareResults     , prompt     , demandInput+    , demandInput_     , wantInput     , endOfInput     , atEnd@@ -40,8 +41,8 @@ compareResults (Partial _) (Partial _) = Nothing compareResults _ _ = Just False --- | Ask for input.  If we receive any, pass it to a success--- continuation, otherwise to a failure continuation.+-- | Ask for input.  If we receive any, pass the augmented input to a+-- success continuation, otherwise to a failure continuation. prompt :: Chunk t        => State t -> Pos -> More        -> (State t -> Pos -> More -> IResult t r)@@ -68,11 +69,24 @@ demandInput = Parser $ \t pos more lose succ ->   case more of     Complete -> lose t pos more [] "not enough input"-    _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input"+    _ -> let lose' _ pos' more' = lose t pos' more' [] "not enough input"              succ' t' pos' more' = succ t' pos' more' ()          in prompt t pos more lose' succ' {-# SPECIALIZE demandInput :: Parser ByteString () #-} {-# SPECIALIZE demandInput :: Parser Text () #-}++-- | Immediately demand more input via a 'Partial' continuation+-- result.  Return the new input.+demandInput_ :: Chunk t => Parser t t+demandInput_ = Parser $ \t pos more lose succ ->+  case more of+    Complete -> lose t pos more [] "not enough input"+    _ -> Partial $ \s ->+         if nullChunk s+         then lose t pos Complete [] "not enough input"+         else succ (pappendChunk t s) pos more s+{-# SPECIALIZE demandInput_ :: Parser ByteString ByteString #-}+{-# SPECIALIZE demandInput_ :: Parser Text Text #-}  -- | This parser always succeeds.  It returns 'True' if any input is -- available either immediately or on demand, and 'False' if the end

@@ -2,7 +2,7 @@     Rank2Types, RecordWildCards, TypeFamilies #-} -- | -- Module      :  Data.Attoparsec.Internal.Types--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com@@ -70,10 +70,13 @@     -- not yet been consumed (if any) when the parse succeeded.  instance (Show i, Show r) => Show (IResult i r) where-    show (Fail t stk msg) =-      unwords [ "Fail", show t, show stk, show msg]-    show (Partial _)          = "Partial _"-    show (Done t r)       = unwords ["Done", show t, show r]+    showsPrec d ir = showParen (d > 10) $+      case ir of+        (Fail t stk msg) -> showString "Fail" . f t . f stk . f msg+        (Partial _)      -> showString "Partial _"+        (Done t r)       -> showString "Done" . f t . f r+      where f :: Show a => a -> ShowS+            f x = showChar ' ' . showsPrec 11 x  instance (NFData i, NFData r) => NFData (IResult i r) where     rnf (Fail t stk msg) = rnf t `seq` rnf stk `seq` rnf msg@@ -86,8 +89,8 @@     fmap f (Partial k)      = Partial (fmap f . k)     fmap f (Done t r)   = Done t (f r) --- | The core parser type.  This is parameterised over the types @i@--- of string being processed and @t@ of internal state representation.+-- | The core parser type.  This is parameterised over the type @i@+-- of string being processed. -- -- This type is an instance of the following classes: --

@@ -1,6 +1,6 @@ -- | -- Module      :  Data.Attoparsec.Lazy--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com

@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} -- | -- Module      :  Data.Attoparsec.Number--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com

@@ -1,9 +1,12 @@ {-# LANGUAGE BangPatterns, CPP, FlexibleInstances, TypeSynonymInstances #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-} -- Imports internal modules+#endif {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}  -- | -- Module      :  Data.Attoparsec.Text--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com@@ -135,6 +138,7 @@ import Data.Bits (Bits, (.|.), shiftL) import Data.Char (isAlpha, isDigit, isSpace, ord) import Data.Int (Int8, Int16, Int32, Int64)+import Data.List (intercalate) import Data.Text (Text) import Data.Word (Word8, Word16, Word32, Word64) import qualified Data.Attoparsec.Internal as I@@ -261,9 +265,10 @@ -- | Convert a 'Result' value to an 'Either' value. A 'Partial' result -- is treated as failure. eitherResult :: Result r -> Either String r-eitherResult (T.Done _ r)     = Right r-eitherResult (T.Fail _ _ msg) = Left msg-eitherResult _                = Left "Result: incomplete input"+eitherResult (T.Done _ r)        = Right r+eitherResult (T.Fail _ [] msg)   = Left msg+eitherResult (T.Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg)+eitherResult _                   = Left "Result: incomplete input"  -- | A predicate that matches either a carriage return @\'\\r\'@ or -- newline @\'\\n\'@ character.

@@ -3,7 +3,7 @@  -- | -- Module      :  Data.Attoparsec.Text.Buffer--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com

@@ -3,7 +3,7 @@ ------------------------------------------------------------------------------ -- | -- Module      :  Data.Attoparsec.FastSet--- Copyright   :  Felipe Lessa 2010, Bryan O'Sullivan 2007-2014+-- Copyright   :  Felipe Lessa 2010, Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  felipe.lessa@gmail.com

@@ -3,7 +3,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module      :  Data.Attoparsec.Text.Internal--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com@@ -73,6 +73,7 @@ import qualified Data.Attoparsec.Text.Buffer as Buf import Data.Attoparsec.Text.Buffer (Buffer, buffer) import Data.Char (chr, ord)+import Data.List (intercalate) import Data.String (IsString(..)) import Data.Text.Internal (Text(..)) import Prelude hiding (getChar, succ, take, takeWhile)@@ -159,9 +160,46 @@ -- before failing.  In attoparsec, the above parser will /succeed/ on -- that input, because the failed first branch will consume nothing. string :: Text -> Parser Text-string s = takeWith (T.length s) (==s)+string s = string_ (stringSuspended id) id s {-# INLINE string #-} +string_ :: (forall r. Text -> Text -> Buffer -> Pos -> More+            -> Failure r -> Success Text r -> Result r)+        -> (Text -> Text)+        -> Text -> Parser Text+string_ suspended f s0 = T.Parser $ \t pos more lose succ ->+  let s  = f s0+      ft = f (Buf.unbuffer t)+  in case T.commonPrefixes s ft of+       Nothing+         | T.null s          -> succ t pos more T.empty+         | T.null ft         -> suspended s s t pos more lose succ+         | otherwise         -> lose t pos more [] "string"+       Just (pfx,ssfx,tsfx)+         | T.null ssfx       -> let l = Pos (T.lengthWord16 pfx)+                                in succ t (pos + l) more (substring pos l t)+         | not (T.null tsfx) -> lose t pos more [] "string"+         | otherwise         -> suspended s ssfx t pos more lose succ+{-# INLINE string_ #-}++stringSuspended :: (Text -> Text)+                -> Text -> Text -> Buffer -> Pos -> More+                -> Failure r+                -> Success Text r+                -> Result r+stringSuspended f s000 s0 t0 pos0 more0 lose0 succ0 =+    runParser (demandInput_ >>= go) t0 pos0 more0 lose0 succ0+  where+    go s' = T.Parser $ \t pos more lose succ ->+      let s = f s'+      in case T.commonPrefixes s0 s of+        Nothing         -> lose t pos more [] "string"+        Just (_pfx,ssfx,tsfx)+          | T.null ssfx -> let l = Pos (T.lengthWord16 s000)+                           in succ t (pos + l) more (substring pos l t)+          | T.null tsfx -> stringSuspended f s000 ssfx t pos more lose succ+          | otherwise   -> lose t pos more [] "string"+ -- | Satisfy a literal string, ignoring case. -- -- Note: this function is currently quite inefficient. Unicode case@@ -184,16 +222,8 @@  -- | Satisfy a literal string, ignoring case for characters in the ASCII range. asciiCI :: Text -> Parser Text-asciiCI input = do-  (k,t) <- ensure n-  if asciiToLower t == s-    then advance k >> return t-    else fail "asciiCI"+asciiCI s = string_ (stringSuspended asciiToLower) asciiToLower s   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'@@ -429,9 +459,10 @@ -- @ parseOnly :: Parser a -> Text -> Either String a parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of-                  Fail _ _ err -> Left err-                  Done _ a     -> Right a-                  _            -> error "parseOnly: impossible error!"+                  Fail _ [] err   -> Left err+                  Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err)+                  Done _ a        -> Right a+                  _               -> error "parseOnly: impossible error!" {-# INLINE parseOnly #-}  get :: Parser Text@@ -476,7 +507,6 @@       Just n' -> succ t pos more (n', substring pos n' t)       -- The uncommon case is kept out-of-line to reduce code size:       Nothing -> ensureSuspended n t pos more lose succ--- Non-recursive so the bounds check can be inlined: {-# INLINE ensure #-}  -- | Return both the result of a parse and the portion of the input@@ -487,6 +517,8 @@                               (substring pos (pos'-pos) t', a)   in runParser p t pos more lose succ' +-- | Ensure that at least @n@ code points of input are available.+-- Returns the number of words consumed while traversing. lengthAtLeast :: Pos -> Int -> Buffer -> Maybe Pos lengthAtLeast pos n t = go 0 (fromPos pos)   where go i !p

@@ -1,7 +1,12 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-} -- Imports internal modules+#endif+ {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- | -- Module      :  Data.Attoparsec.Text.Lazy--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com@@ -36,6 +41,7 @@     ) where  import Control.DeepSeq (NFData(rnf))+import Data.List (intercalate) import Data.Text.Lazy.Internal (Text(..), chunk) import qualified Data.Attoparsec.Internal.Types as T import qualified Data.Attoparsec.Text as A@@ -54,11 +60,7 @@               -- ^ The parse succeeded.  The 'Text' 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+    deriving (Show)  instance NFData r => NFData (Result r) where     rnf (Fail bs ctxs msg) = rnf bs `seq` rnf ctxs `seq` rnf msg@@ -94,5 +96,6 @@  -- | 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 (Done _ r)        = Right r+eitherResult (Fail _ [] msg)   = Left msg+eitherResult (Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg)

@@ -1,6 +1,6 @@ -- | -- Module      :  Data.Attoparsec.Types--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com

@@ -1,8 +1,12 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-} -- Data.ByteString.Unsafe+#endif {-# LANGUAGE BangPatterns, MagicHash, UnboxedTuples #-}  -- | -- Module      :  Data.Attoparsec.Zepto--- Copyright   :  Bryan O'Sullivan 2007-2014+-- Copyright   :  Bryan O'Sullivan 2007-2015 -- License     :  BSD3 -- -- Maintainer  :  bos@serpentine.com

@@ -1,12 +1,12 @@ name:            attoparsec-version:         0.12.1.3+version:         0.12.1.4 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 == 7.0, GHC == 7.2, GHC == 7.4, GHC == 7.6, GHC == 7.8+tested-with:     GHC == 7.0, GHC == 7.2, GHC == 7.4, GHC == 7.6, GHC == 7.8, GHC == 7.10 synopsis:        Fast combinator parsing for bytestrings and text cabal-version:   >= 1.8 homepage:        https://github.com/bos/attoparsec@@ -53,6 +53,8 @@                    Data.Attoparsec.ByteString.Lazy                    Data.Attoparsec.Char8                    Data.Attoparsec.Combinator+                   Data.Attoparsec.Internal+                   Data.Attoparsec.Internal.Types                    Data.Attoparsec.Lazy                    Data.Attoparsec.Number                    Data.Attoparsec.Text@@ -62,9 +64,7 @@   other-modules:   Data.Attoparsec.ByteString.Buffer                    Data.Attoparsec.ByteString.FastSet                    Data.Attoparsec.ByteString.Internal-                   Data.Attoparsec.Internal                    Data.Attoparsec.Internal.Fhthagn-                   Data.Attoparsec.Internal.Types                    Data.Attoparsec.Text.Buffer                    Data.Attoparsec.Text.FastSet                    Data.Attoparsec.Text.Internal

@@ -13,6 +13,7 @@ import Text.Parsec.Text.Lazy () import qualified Warp import qualified Aeson+import qualified Genome import qualified Data.Attoparsec.ByteString as AB import qualified Data.Attoparsec.ByteString.Char8 as AC import qualified Data.Attoparsec.ByteString.Lazy as ABL@@ -80,6 +81,7 @@      , bench "long" $ nf (AB.parse quotedString) b      ]    , aeson+   , Genome.genome    , headersBS    , headersT    , Links.links

@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}++module Genome+    (+      genome+    ) where++import Control.Applicative+import Criterion.Main+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy.Char8 as L8+import Data.Attoparsec.ByteString.Char8 as B+import qualified Data.Attoparsec.ByteString.Lazy as BL+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import Data.Attoparsec.Text as T+import qualified Data.Attoparsec.Text.Lazy as TL+import Common (rechunkBS, rechunkT)++genome :: Benchmark+genome = bgroup "genome" [+    bgroup "bytestring" [+        bench "s" $ nf (map (B.parse searchBS)) (B8.tails geneB)+      , bench "l" $ nf (map (BL.parse searchBS)) (L8.tails geneBL)+      , bgroup "CI" [+          bench "s" $ nf (map (B.parse searchBSCI)) (B8.tails geneB)+        , bench "l" $ nf (map (BL.parse searchBSCI)) (L8.tails geneBL)+      ]+    ]+  , bgroup "text" [+        bench "s" $ nf (map (T.parse searchT)) (T.tails geneT)+      , bench "l" $ nf (map (TL.parse searchT)) (TL.tails geneTL)+      , bgroup "CI" [+          bench "s" $ nf (map (T.parse searchTCI)) (T.tails geneT)+        , bench "l" $ nf (map (TL.parse searchTCI)) (TL.tails geneTL)+      ]+    ]+  ]+  where geneB  = B8.pack gene+        geneBL = rechunkBS 4 geneB+        geneT  = T.pack gene+        geneTL = rechunkT 4 geneT++searchBS :: B.Parser ByteString+searchBS = "caac" *> ("aaca" <|> "aact")++searchBSCI :: B.Parser ByteString+searchBSCI = B.stringCI "CAAC" *> (B.stringCI "AACA" <|> B.stringCI "AACT")++searchT :: T.Parser Text+searchT = "caac" *> ("aaca" <|> "aact")++searchTCI :: T.Parser Text+searchTCI = T.asciiCI "CAAC" *> (T.asciiCI "AACA" <|> T.asciiCI "AACT")++-- Dictyostelium discoideum developmental protein DG1094 (gacT) gene,+-- partial cds. http://www.ncbi.nlm.nih.gov/nuccore/AF081586.1++gene :: String+gene = "atcgatttagaaagatacaaagatagaaccatcaataataaacaagagaagagagcaagt\+       \agagatattaataaagagattgaaagagagattgaaaagaagagattatcaccaagagaa\+       \agattaaatttatttggtctttcttcctcatcttcatcagtgaattcaacattaacaaga\+       \tctacagcaaatattatctctacaatagacggtagtggaggtagtaatcgtaatagtaaa\+       \aattatggtaatggctcatcctcctcctcaaatagaagatatagtaatactattaatcaa\+       \caattacaaatgcaattacaacaacttcaaatccaacaacaacaatatcaacaaactcaa\+       \caatctcaaataccattacaatatcaacaacaacaacagcaacaacaacaacaaaccact\+       \acaactacaactacatcaagtggtagtaatagattctcttcaaatagatataaaccagtt\+       \gatcttacacaatcatcttcaaactttcgttattcacgtgaaatttatgatgatgattat\+       \tattcaaataataatttaatgatgtttggtaatgagcaaccaaatcaaacaccaatttct\+       \gtatcatcttcatctgcattcacacgtcaaagatctcaaagttgctttgaaccagagaat\+       \cttgtattgctacaacaacaatatcaacaatatcaacaacaacaacaacaacaacaacaa\+       \attccattccaagcaaatccacaatatagtaatgctgttattgaacaaaaattggatcaa\+       \attagagataccattaataatttacatagagataaccgagtctctaga"

@@ -1,3 +1,12 @@+0.12.1.4++* Fixed a case where the string parser would consume an unnecessary+  amount of input before failing a match, when it could bail much+  earlier (https://github.com/bos/attoparsec/issues/97)++* Added more context to error messages+  (https://github.com/bos/attoparsec/pull/79)+ 0.12.1.3  * Fixed incorrect tracking of Text lengths

@@ -1,8 +1,11 @@+{-# LANGUAGE OverloadedStrings #-}+ module QC.Combinator where  import Control.Applicative+import Data.Maybe (fromJust, isJust) import Data.Word (Word8)-import QC.Common (Repack, parseBS, repackBS)+import QC.Common (Repack, parseBS, repackBS, toLazyBS) import Test.Framework (Test) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.QuickCheck@@ -22,6 +25,13 @@     (length <$> parseBS (C.count n (P.string s)) input) == Just n   where input = repackBS rs (B.concat (replicate (n+1) s)) +lookAhead :: NonEmptyList Word8 -> Bool+lookAhead (NonEmpty xs) =+  let ys = B.pack xs+      withLookAheadThenConsume = (\x y -> (x, y)) <$> C.lookAhead (P.string ys) <*> P.string ys+      mr = parseBS withLookAheadThenConsume $ toLazyBS ys+  in isJust mr && fst (fromJust mr) == snd (fromJust mr)+ match :: Int -> NonNegative Int -> NonNegative Int -> Repack -> Bool match n (NonNegative x) (NonNegative y) rs =     parseBS (P.match parser) (repackBS rs input) == Just (input, n)@@ -35,5 +45,6 @@ tests = [     testProperty "choice" choice   , testProperty "count" count+  , testProperty "lookAhead" lookAhead   , testProperty "match" match   ]

@@ -29,7 +29,7 @@  rechunkSizes :: Int -> Gen [Int] rechunkSizes n0 = shuffle =<< loop [] (0:repeat 1) n0-  where loop _ [] _ = error "it's 2014, where's my Stream type?"+  where loop _ [] _ = error "it's 2015, where's my Stream type?"         loop acc (lb:lbs) n           | n <= 0 = shuffle (reverse acc)           | otherwise = do