diff --git a/Data/Attoparsec/ByteString/Internal.hs b/Data/Attoparsec/ByteString/Internal.hs --- a/Data/Attoparsec/ByteString/Internal.hs +++ b/Data/Attoparsec/ByteString/Internal.hs @@ -71,6 +71,7 @@ import Data.Attoparsec.Combinator import Data.Attoparsec.Internal.Types hiding (Parser, Input, Added, Failure, Success) +import Data.Monoid (Monoid(..)) import Data.Word (Word8) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr (castPtr, minusPtr, plusPtr) @@ -127,7 +128,7 @@ prompt i0 a0 _m0 kf ks = Partial $ \s -> if B.null s then kf i0 a0 Complete - else ks (I (unI i0 <> s)) (A (unA a0 <> s)) Incomplete + else ks (i0 <> I s) (a0 <> A s) Incomplete -- | Immediately demand more input via a 'Partial' continuation -- result. @@ -218,7 +219,8 @@ -- | 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 +takeWith n0 p = do + let n = max n0 0 s <- ensure n let h = B.unsafeTake n s t = B.unsafeDrop n s @@ -490,12 +492,12 @@ -- | Run a parser. parse :: Parser a -> B.ByteString -> Result a -parse m s = T.runParser m (I s) (A B.empty) Incomplete failK successK +parse m s = T.runParser m (I s) mempty Incomplete failK successK {-# INLINE parse #-} -- | Run a parser that cannot be resupplied via a 'Partial' result. parseOnly :: Parser a -> B.ByteString -> Either String a -parseOnly m s = case T.runParser m (I s) (A B.empty) Complete failK successK of +parseOnly m s = case T.runParser m (I s) mempty Complete failK successK of Fail _ _ err -> Left err Done _ a -> Right a _ -> error "parseOnly: impossible error!" diff --git a/Data/Attoparsec/Internal/Types.hs b/Data/Attoparsec/Internal/Types.hs --- a/Data/Attoparsec/Internal/Types.hs +++ b/Data/Attoparsec/Internal/Types.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, RecordWildCards, CPP #-} +{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, OverloadedStrings, + Rank2Types, RecordWildCards #-} -- | -- Module : Data.Attoparsec.Internal.Types -- Copyright : Bryan O'Sullivan 2007-2011 @@ -21,7 +22,6 @@ , Added(..) , More(..) , addS - , noAdds , (<>) ) where @@ -73,8 +73,8 @@ fmap = fmapR {-# INLINE fmap #-} -newtype Input t = I {unI :: t} -newtype Added t = A {unA :: t} +newtype Input t = I {unI :: t} deriving (Monoid) +newtype Added t = A {unA :: t} deriving (Monoid) -- | The core parser type. This is parameterised over the type @t@ of -- string being processed. @@ -109,19 +109,20 @@ data More = Complete | Incomplete deriving (Eq, Show) +instance Monoid More where + mappend c@Complete _ = c + mappend _ m = m + mempty = Incomplete + addS :: (Monoid t) => Input t -> Added t -> More -> Input t -> Added t -> More -> (Input t -> Added t -> More -> r) -> r addS i0 a0 m0 _i1 a1 m1 f = - let !i = I (unI i0 <> unA a1) - a = A (unA a0 <> unA a1) - !m = m0 m1 + let !i = i0 <> I (unA a1) + a = a0 <> a1 + !m = m0 <> m1 in f i a m - where - Complete _ = Complete - _ Complete = Complete - _ _ = Incomplete {-# INLINE addS #-} bindP :: Parser t a -> (a -> Parser t b) -> Parser t b @@ -142,14 +143,15 @@ noAdds :: (Monoid t) => Input t -> Added t -> More -> (Input t -> Added t -> More -> r) -> r -noAdds i0 _a0 m0 f = f i0 (A mempty) m0 +noAdds i0 _a0 m0 f = f i0 mempty m0 {-# INLINE noAdds #-} plus :: (Monoid t) => Parser t a -> Parser t a -> Parser t a plus a b = Parser $ \i0 a0 m0 kf ks -> let kf' i1 a1 m1 _ _ = addS i0 a0 m0 i1 a1 m1 $ \ i2 a2 m2 -> runParser b i2 a2 m2 kf ks - in noAdds i0 a0 m0 $ \i2 a2 m2 -> runParser a i2 a2 m2 kf' ks + ks' i1 a1 m1 = ks i1 (a0 <> a1) m1 + in noAdds i0 a0 m0 $ \i2 a2 m2 -> runParser a i2 a2 m2 kf' ks' {-# INLINE plus #-} instance (Monoid t) => MonadPlus (Parser t) where diff --git a/Data/Attoparsec/Text/Internal.hs b/Data/Attoparsec/Text/Internal.hs --- a/Data/Attoparsec/Text/Internal.hs +++ b/Data/Attoparsec/Text/Internal.hs @@ -68,6 +68,7 @@ import Control.Monad (when) import Data.Attoparsec.Combinator import Data.Attoparsec.Internal.Types hiding (Parser, Input, Added, Failure, Success) +import Data.Monoid (Monoid(..)) import Data.String (IsString(..)) import Data.Text (Text) import Prelude hiding (getChar, take, takeWhile) @@ -115,7 +116,7 @@ prompt i0 a0 _m0 kf ks = Partial $ \s -> if T.null s then kf i0 a0 Complete - else ks (I (unI i0 <> s)) (A (unA a0 <> s)) Incomplete + else ks (i0 <> I s) (a0 <> A s) Incomplete -- | Immediately demand more input via a 'Partial' continuation -- result. @@ -211,8 +212,7 @@ takeWith :: Int -> (Text -> Bool) -> Parser Text takeWith n p = do s <- ensure n - let h = unsafeTake n s - t = unsafeDrop n s + let (h,t) = T.splitAt n s if p h then put t >> return h else fail "takeWith" @@ -506,12 +506,12 @@ -- | Run a parser. parse :: Parser a -> Text -> Result a -parse m s = runParser m (I s) (A T.empty) Incomplete failK successK +parse m s = runParser m (I s) mempty Incomplete failK successK {-# INLINE parse #-} -- | Run a parser that cannot be resupplied via a 'Partial' result. parseOnly :: Parser a -> Text -> Either String a -parseOnly m s = case runParser m (I s) (A T.empty) Complete failK successK of +parseOnly m s = case runParser m (I s) mempty Complete failK successK of Fail _ _ err -> Left err Done _ a -> Right a _ -> error "parseOnly: impossible error!" diff --git a/attoparsec.cabal b/attoparsec.cabal --- a/attoparsec.cabal +++ b/attoparsec.cabal @@ -1,13 +1,13 @@ name: attoparsec -version: 0.10.3.0 +version: 0.10.4.0 license: BSD3 license-file: LICENSE category: Text, Parsing author: Bryan O'Sullivan maintainer: Bryan O'Sullivan stability: experimental -tested-with: GHC == 6.12.3, GHC == 7.0.3, GHC == 7.2.1 -synopsis: Fast combinator parsing for bytestrings +tested-with: GHC == 6.12.3, GHC == 7.0.3, GHC == 7.2.1, GHC == 7.4.2, GHC == 7.6.1 +synopsis: Fast combinator parsing for bytestrings and text cabal-version: >= 1.8 homepage: https://github.com/bos/attoparsec bug-reports: https://github.com/bos/attoparsec/issues