git.iko.soy/typeable/attoparsec
on master help sign in
Rework string for ByteString to fail early (gh-97)
commit633e189412eccb83196173f659fc801f79916205 authorBryan O'Sullivan <bos@serpentine.com> dateThu 26 Mar 2015, 12:37 (12 years ago) parentca250b1
2 files changed+46−4
compare with master
unifiedsplit
Data/Attoparsec/ByteString/Internal.hs+29−1 Data/Attoparsec/Internal.hs+17−3
Data/Attoparsec/ByteString/Internal.hs+29−1
@@ -170,9 +170,37 @@ take n = takeWith n (const True)
170170-- before failing. In attoparsec, the above parser will /succeed/ on
171171-- that input, because the failed first branch will consume nothing.
172172string :: ByteString -> Parser ByteString
173−string s = takeWith (B.length s) (==s)
173+string s = T.Parser $ \t pos more lose succ ->
174+ let n = B.length s
175+ in if lengthAtLeast pos n t
176+ then if s == substring pos (Pos n) t
177+ then succ t (pos + Pos n) more s
178+ else lose t pos more [] "string"
179+ else let t' = Buf.unsafeDrop (fromPos pos) t
180+ in if t' `B.isPrefixOf` s
181+ then stringSuspended s (B.drop (B.length t') s)
182+ t pos more lose succ
183+ else lose t pos more [] "string"
174184{-# INLINE string #-}
175185
186+stringSuspended :: ByteString -> ByteString -> Buffer -> Pos -> More
187+ -> Failure r
188+ -> Success ByteString r
189+ -> Result r
190+stringSuspended s0 s t pos more lose succ =
191+ runParser (demandInput_ >>= go) t pos more lose succ
192+ where go s' = T.Parser $ \t' pos' more' lose' succ' ->
193+ let m = B.length s
194+ n = B.length s'
195+ in if n >= m
196+ then if B.unsafeTake m s' == s
197+ then succ' t' (pos' + Pos (B.length s0)) more' s0
198+ else lose' t' pos' more' [] "string"
199+ else if s' == B.unsafeTake n s
200+ then stringSuspended s0 (B.unsafeDrop n s)
201+ t' pos' more' lose' succ'
202+ else lose' t' pos' more' [] "string"
203+
176204stringTransform :: (ByteString -> ByteString) -> ByteString
177205 -> Parser ByteString
178206stringTransform f s = takeWith (B.length s) ((==f s) . f)
Data/Attoparsec/Internal.hs+17−3
@@ -15,6 +15,7 @@ module Data.Attoparsec.Internal
1515 ( compareResults
1616 , prompt
1717 , demandInput
18+ , demandInput_
1819 , wantInput
1920 , endOfInput
2021 , atEnd
@@ -40,8 +41,8 @@ compareResults (Done t0 r0) (Done t1 r1) =
4041compareResults (Partial _) (Partial _) = Nothing
4142compareResults _ _ = Just False
4243
43−-- | Ask for input. If we receive any, pass it to a success
44−-- continuation, otherwise to a failure continuation.
44+-- | Ask for input. If we receive any, pass the augmented input to a
45+-- success continuation, otherwise to a failure continuation.
4546prompt :: Chunk t
4647 => State t -> Pos -> More
4748 -> (State t -> Pos -> More -> IResult t r)
@@ -68,12 +69,25 @@ demandInput :: Chunk t => Parser t ()
6869demandInput = Parser $ \t pos more lose succ ->
6970 case more of
7071 Complete -> lose t pos more [] "not enough input"
71− _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input"
72+ _ -> let lose' _ pos' more' = lose t pos' more' [] "not enough input"
7273 succ' t' pos' more' = succ t' pos' more' ()
7374 in prompt t pos more lose' succ'
7475{-# SPECIALIZE demandInput :: Parser ByteString () #-}
7576{-# SPECIALIZE demandInput :: Parser Text () #-}
7677
78+-- | Immediately demand more input via a 'Partial' continuation
79+-- result. Return the new input.
80+demandInput_ :: Chunk t => Parser t t
81+demandInput_ = Parser $ \t pos more lose succ ->
82+ case more of
83+ Complete -> lose t pos more [] "not enough input"
84+ _ -> Partial $ \s ->
85+ if nullChunk s
86+ then lose t pos Complete [] "not enough input"
87+ else succ (pappendChunk t s) pos more s
88+{-# SPECIALIZE demandInput_ :: Parser ByteString ByteString #-}
89+{-# SPECIALIZE demandInput_ :: Parser Text Text #-}
90+
7791-- | This parser always succeeds. It returns 'True' if any input is
7892-- available either immediately or on demand, and 'False' if the end
7993-- of all input has been reached.