@@ -1,15 +1,15 @@
1−{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes,
1+{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings,
2− RecordWildCards #-}
2+ RecordWildCards, MagicHash, UnboxedTuples #-}
4-- Module : Data.Attoparsec.ByteString.Internal
4-- Module : Data.Attoparsec.ByteString.Internal
5−-- Copyright : Bryan O'Sullivan 2007-2015
5+-- Copyright : Bryan O'Sullivan 2007-2014
6-- License : BSD3
6-- License : BSD3
8-- Maintainer : bos@serpentine.com
8-- Maintainer : bos@serpentine.com
9-- Stability : experimental
9-- Stability : experimental
10-- Portability : unknown
10-- Portability : unknown
12−-- Simple, efficient parser combinators for 'ByteString' strings,
12+-- Simple, efficient parser combinators for 'B.ByteString' strings,
13-- loosely based on the Parsec library.
13-- loosely based on the Parsec library.
15module Data.Attoparsec.ByteString.Internal
15module Data.Attoparsec.ByteString.Internal
@@ -47,7 +47,7 @@ module Data.Attoparsec.ByteString.Internal
47 -- * Efficient string handling
47 -- * Efficient string handling
48 , skipWhile
48 , skipWhile
50− , stringCI
50+ , stringTransform
53 , runScanner
53 , runScanner
@@ -66,25 +66,17 @@ module Data.Attoparsec.ByteString.Internal
69−#if !MIN_VERSION_base(4,8,0)
70−import Control.Applicative ((<$>))
69+import Control.Applicative ((<|>), (<$>))
72−import Control.Applicative ((<|>))
73import Control.Monad (when)
70import Control.Monad (when)
74−import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)
75import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
71import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
76import Data.Attoparsec.Combinator ((<?>))
72import Data.Attoparsec.Combinator ((<?>))
77−import Data.Attoparsec.Internal
78−import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
79import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
73import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
80−import Data.ByteString (ByteString)
81−import Data.List (intercalate)
82import Data.Word (Word8)
74import Data.Word (Word8)
83import Foreign.ForeignPtr (withForeignPtr)
75import Foreign.ForeignPtr (withForeignPtr)
84import Foreign.Ptr (castPtr, minusPtr, plusPtr)
76import Foreign.Ptr (castPtr, minusPtr, plusPtr)
85import Foreign.Storable (Storable(peek, sizeOf))
77import Foreign.Storable (Storable(peek, sizeOf))
86import Prelude hiding (getChar, succ, take, takeWhile)
78import Prelude hiding (getChar, succ, take, takeWhile)
87−import qualified Data.Attoparsec.ByteString.Buffer as Buf
79+import Data.ByteString (ByteString)
88import qualified Data.Attoparsec.Internal.Types as T
80import qualified Data.Attoparsec.Internal.Types as T
89import qualified Data.ByteString as B8
81import qualified Data.ByteString as B8
90import qualified Data.ByteString.Char8 as B
82import qualified Data.ByteString.Char8 as B
@@ -92,10 +84,13 @@ import qualified Data.ByteString.Internal as B
92import qualified Data.ByteString.Lazy as L
84import qualified Data.ByteString.Lazy as L
93import qualified Data.ByteString.Unsafe as B
85import qualified Data.ByteString.Unsafe as B
87+import GHC.Base (realWorld#)
88+import GHC.IO (IO(IO))
95−type Parser = T.Parser ByteString
90+type Parser = T.Parser B.ByteString
96−type Result = IResult ByteString
91+type Result = IResult B.ByteString
97−type Failure r = T.Failure ByteString Buffer r
92+type Failure r = T.Failure B.ByteString r
98−type Success a r = T.Success ByteString Buffer a r
93+type Success a r = T.Success B.ByteString a r
100-- | The parser @satisfy p@ succeeds for any byte for which the
95-- | The parser @satisfy p@ succeeds for any byte for which the
101-- predicate @p@ returns 'True'. Returns the byte that is actually
96-- predicate @p@ returns 'True'. Returns the byte that is actually
@@ -105,7 +100,8 @@ type Success a r = T.Success ByteString Buffer a r
105-- > where isDigit w = w >= 48 && w <= 57
100-- > where isDigit w = w >= 48 && w <= 57
106satisfy :: (Word8 -> Bool) -> Parser Word8
101satisfy :: (Word8 -> Bool) -> Parser Word8
107satisfy p = do
102satisfy p = do
108− h <- peekWord8'
103+ c <- ensure 1
104+ let !h = B.unsafeHead c
110 then advance 1 >> return h
106 then advance 1 >> return h
111 else fail "satisfy"
107 else fail "satisfy"
@@ -118,8 +114,8 @@ satisfy p = do
118-- > where isDigit w = w >= 48 && w <= 57
114-- > where isDigit w = w >= 48 && w <= 57
119skip :: (Word8 -> Bool) -> Parser ()
115skip :: (Word8 -> Bool) -> Parser ()
120skip p = do
116skip p = do
121− h <- peekWord8'
117+ s <- ensure 1
122− if p h
118+ if p (B.unsafeHead s)
123 then advance 1
119 then advance 1
124 else fail "skip"
120 else fail "skip"
@@ -128,8 +124,8 @@ skip p = do
128-- parser returns the transformed byte that was parsed.
124-- parser returns the transformed byte that was parsed.
129satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a
125satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a
130satisfyWith f p = do
126satisfyWith f p = do
131− h <- peekWord8'
127+ s <- ensure 1
132− let c = f h
128+ let c = f $! B.unsafeHead s
134 then advance 1 >> return c
130 then advance 1 >> return c
135 else fail "satisfyWith"
131 else fail "satisfyWith"
@@ -141,15 +137,22 @@ storable = hack undefined
141 hack :: Storable b => b -> Parser b
137 hack :: Storable b => b -> Parser b
142 hack dummy = do
138 hack dummy = do
143 (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy)
139 (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy)
144− return . inlinePerformIO . withForeignPtr fp $ \p ->
140+ return . B.inlinePerformIO . withForeignPtr fp $ \p ->
145 peek (castPtr $ p `plusPtr` o)
141 peek (castPtr $ p `plusPtr` o)
147−-- | Consume exactly @n@ bytes of input.
143+-- | Consume @n@ bytes of input, but succeed only if the predicate
148−take :: Int -> Parser ByteString
145+takeWith :: Int -> (B.ByteString -> Bool) -> Parser B.ByteString
149−take n0 = do
146+takeWith n0 p = do
150 let n = max n0 0
147 let n = max n0 0
151 s <- ensure n
148 s <- ensure n
152− advance n >> return s
150+ then advance n >> return s
151+ else fail "takeWith"
153+-- | Consume exactly @n@ bytes of input.
154+take :: Int -> Parser B.ByteString
155+take n = takeWith n (const True)
153{-# INLINE take #-}
156{-# INLINE take #-}
155-- | @string s@ parses a sequence of bytes that identically match
158-- | @string s@ parses a sequence of bytes that identically match
@@ -165,62 +168,16 @@ take n0 = do
166-- The reason for its failure is that the first branch is a
169-- The reason for its failure is that the first branch is a
167-- partial match, and will consume the letters @\'f\'@ and @\'o\'@
170-- partial match, and will consume the letters @\'f\'@ and @\'o\'@
168−-- before failing. In attoparsec, the above parser will /succeed/ on
171+-- before failing. In Attoparsec, the above parser will /succeed/ on
169-- that input, because the failed first branch will consume nothing.
172-- that input, because the failed first branch will consume nothing.
170−string :: ByteString -> Parser ByteString
173+string :: B.ByteString -> Parser B.ByteString
171−string s = string_ (stringSuspended id) id s
174+string s = takeWith (B.length s) (==s)
172{-# INLINE string #-}
175{-# INLINE string #-}
174−-- ASCII-specific but fast, oh yes.
177+stringTransform :: (B.ByteString -> B.ByteString) -> B.ByteString
175−toLower :: Word8 -> Word8
178+ -> Parser B.ByteString
176−toLower w | w >= 65 && w <= 90 = w + 32
179+stringTransform f s = takeWith (B.length s) ((==f s) . f)
177− | otherwise = w
180+{-# INLINE stringTransform #-}
179−-- | Satisfy a literal string, ignoring case.
180−stringCI :: ByteString -> Parser ByteString
181−stringCI s = string_ (stringSuspended lower) lower s
182− where lower = B8.map toLower
183−{-# INLINE stringCI #-}
185−string_ :: (forall r. ByteString -> ByteString -> Buffer -> Pos -> More
186− -> Failure r -> Success ByteString r -> Result r)
187− -> (ByteString -> ByteString)
188− -> ByteString -> Parser ByteString
189−string_ suspended f s0 = T.Parser $ \t pos more lose succ ->
192− in if lengthAtLeast pos n t
193− then let t' = substring pos (Pos n) t
195− then succ t (pos + Pos n) more t'
196− else lose t pos more [] "string"
197− else let t' = Buf.unsafeDrop (fromPos pos) t
198− in if f t' `B.isPrefixOf` s
199− then suspended s (B.drop (B.length t') s) t pos more lose succ
200− else lose t pos more [] "string"
201−{-# INLINE string_ #-}
203−stringSuspended :: (ByteString -> ByteString)
204− -> ByteString -> ByteString -> Buffer -> Pos -> More
206− -> Success ByteString r
208−stringSuspended f s0 s t pos more lose succ =
209− runParser (demandInput_ >>= go) t pos more lose succ
210− where go s'0 = T.Parser $ \t' pos' more' lose' succ' ->
215− then if B.unsafeTake m s' == s
216− then let o = Pos (B.length s0)
217− in succ' t' (pos' + o) more'
218− (substring pos' o t')
219− else lose' t' pos' more' [] "string"
220− else if s' == B.unsafeTake n s
221− then stringSuspended f s0 (B.unsafeDrop n s)
222− t' pos' more' lose' succ'
223− else lose' t' pos' more' [] "string"
225-- | Skip past input for as long as the predicate returns 'True'.
182-- | Skip past input for as long as the predicate returns 'True'.
226skipWhile :: (Word8 -> Bool) -> Parser ()
183skipWhile :: (Word8 -> Bool) -> Parser ()
@@ -228,8 +185,11 @@ skipWhile p = go
230 t <- B8.takeWhile p <$> get
187 t <- B8.takeWhile p <$> get
231− continue <- inputSpansChunks (B.length t)
188+ advance (B.length t)
232− when continue go
189+ eoc <- endOfChunk
233{-# INLINE skipWhile #-}
193{-# INLINE skipWhile #-}
235-- | Consume input as long as the predicate returns 'False'
195-- | Consume input as long as the predicate returns 'False'
@@ -242,7 +202,7 @@ skipWhile p = go
242-- combinators such as 'Control.Applicative.many', because such
202-- combinators such as 'Control.Applicative.many', because such
243-- parsers loop until a failure occurs. Careless use will thus result
203-- parsers loop until a failure occurs. Careless use will thus result
244-- in an infinite loop.
204-- in an infinite loop.
245−takeTill :: (Word8 -> Bool) -> Parser ByteString
205+takeTill :: (Word8 -> Bool) -> Parser B.ByteString
246takeTill p = takeWhile (not . p)
206takeTill p = takeWhile (not . p)
247{-# INLINE takeTill #-}
207{-# INLINE takeTill #-}
@@ -256,27 +216,23 @@ takeTill p = takeWhile (not . p)
256-- combinators such as 'Control.Applicative.many', because such
216-- combinators such as 'Control.Applicative.many', because such
257-- parsers loop until a failure occurs. Careless use will thus result
217-- parsers loop until a failure occurs. Careless use will thus result
258-- in an infinite loop.
218-- in an infinite loop.
259−takeWhile :: (Word8 -> Bool) -> Parser ByteString
219+takeWhile :: (Word8 -> Bool) -> Parser B.ByteString
260−takeWhile p = do
220+takeWhile p = (B.concat . reverse) `fmap` go []
261− s <- B8.takeWhile p <$> get
262− continue <- inputSpansChunks (B.length s)
264− then takeWhileAcc p [s]
266−{-# INLINE takeWhile #-}
268−takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString
271 go acc = do
222 go acc = do
272 s <- B8.takeWhile p <$> get
223 s <- B8.takeWhile p <$> get
273− continue <- inputSpansChunks (B.length s)
224+ advance (B.length s)
274− if continue
225+ eoc <- endOfChunk
275− then go (s:acc)
230+ then go (s:acc)
276− else return $ concatReverse (s:acc)
231+ else return (s:acc)
277−{-# INLINE takeWhileAcc #-}
232+ else return (s:acc)
233+{-# INLINE takeWhile #-}
279−takeRest :: Parser [ByteString]
235+takeRest :: Parser [B.ByteString]
280takeRest = go []
236takeRest = go []
282 go acc = do
238 go acc = do
@@ -289,7 +245,7 @@ takeRest = go []
289 else return (reverse acc)
245 else return (reverse acc)
291-- | Consume all remaining input and return it as a single string.
247-- | Consume all remaining input and return it as a single string.
292−takeByteString :: Parser ByteString
248+takeByteString :: Parser B.ByteString
293takeByteString = B.concat `fmap` takeRest
249takeByteString = B.concat `fmap` takeRest
295-- | Consume all remaining input and return it as a single string.
251-- | Consume all remaining input and return it as a single string.
@@ -298,7 +254,7 @@ takeLazyByteString = L.fromChunks `fmap` takeRest
299data T s = T {-# UNPACK #-} !Int s
255data T s = T {-# UNPACK #-} !Int s
301−scan_ :: (s -> [ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s)
257+scan_ :: (s -> [B.ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s)
302 -> Parser r
258 -> Parser r
303scan_ f s0 p = go [] s0
259scan_ f s0 p = go [] s0
@@ -319,9 +275,14 @@ scan_ f s0 p = go [] s0
319 bs <- get
275 bs <- get
320 let T i s' = inlinePerformIO $ scanner bs
276 let T i s' = inlinePerformIO $ scanner bs
321 !h = B.unsafeTake i bs
277 !h = B.unsafeTake i bs
322− continue <- inputSpansChunks i
278+ advance i
323− if continue
279+ eoc <- endOfChunk
324− then go (h:acc) s'
284+ then go (h:acc) s'
325 else f s' (h:acc)
286 else f s' (h:acc)
326{-# INLINE scan_ #-}
287{-# INLINE scan_ #-}
@@ -337,14 +298,17 @@ scan_ f s0 p = go [] s0
337-- combinators such as 'Control.Applicative.many', because such
298-- combinators such as 'Control.Applicative.many', because such
338-- parsers loop until a failure occurs. Careless use will thus result
299-- parsers loop until a failure occurs. Careless use will thus result
339-- in an infinite loop.
300-- in an infinite loop.
340−scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString
301+scan :: s -> (s -> Word8 -> Maybe s) -> Parser B.ByteString
341−scan = scan_ $ \_ chunks -> return $! concatReverse chunks
302+scan = scan_ $ \_ chunks ->
305+ xs -> return $! B.concat $ reverse xs
342{-# INLINE scan #-}
306{-# INLINE scan #-}
344-- | Like 'scan', but generalized to return the final state of the
308-- | Like 'scan', but generalized to return the final state of the
345-- scanner.
309-- scanner.
346−runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
310+runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (B.ByteString, s)
347−runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
311+runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s)
348{-# INLINE runScanner #-}
312{-# INLINE runScanner #-}
350-- | Consume input as long as the predicate returns 'True', and return
314-- | Consume input as long as the predicate returns 'True', and return
@@ -353,7 +317,7 @@ runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
353-- This parser requires the predicate to succeed on at least one byte
317-- This parser requires the predicate to succeed on at least one byte
354-- of input: it will fail if the predicate never returns 'True' or if
318-- of input: it will fail if the predicate never returns 'True' or if
355-- there is no input left.
319-- there is no input left.
356−takeWhile1 :: (Word8 -> Bool) -> Parser ByteString
320+takeWhile1 :: (Word8 -> Bool) -> Parser B.ByteString
357takeWhile1 p = do
321takeWhile1 p = do
358 (`when` demandInput) =<< endOfChunk
322 (`when` demandInput) =<< endOfChunk
359 s <- B8.takeWhile p <$> get
323 s <- B8.takeWhile p <$> get
@@ -364,9 +328,8 @@ takeWhile1 p = do
364 advance len
328 advance len
365 eoc <- endOfChunk
329 eoc <- endOfChunk
367− then takeWhileAcc p [s]
331+ then (s<>) `fmap` takeWhile p
368 else return s
332 else return s
369−{-# INLINE takeWhile1 #-}
371-- | Match any byte in a set.
334-- | Match any byte in a set.
@@ -414,13 +377,13 @@ notWord8 c = satisfy (/= c) <?> "not " ++ show c
414peekWord8 :: Parser (Maybe Word8)
377peekWord8 :: Parser (Maybe Word8)
415peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ ->
378peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ ->
416 case () of
379 case () of
417− _| pos_ < Buf.length t ->
380+ _| pos_ < B.length t ->
418− let !w = Buf.unsafeIndex t pos_
381+ let !w = B.unsafeIndex t pos_
419 in succ t pos more (Just w)
382 in succ t pos more (Just w)
420 | more == Complete ->
383 | more == Complete ->
421 succ t pos more Nothing
384 succ t pos more Nothing
422 | otherwise ->
385 | otherwise ->
423− let succ' t' pos' more' = let !w = Buf.unsafeIndex t' pos_
386+ let succ' t' pos' more' = let !w = B.unsafeIndex t pos_
424 in succ t' pos' more' (Just w)
387 in succ t' pos' more' (Just w)
425 lose' t' pos' more' = succ t' pos' more' Nothing
388 lose' t' pos' more' = succ t' pos' more' Nothing
426 in prompt t pos more lose' succ'
389 in prompt t pos more lose' succ'
@@ -429,11 +392,9 @@ peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ ->
429-- | Match any byte, to perform lookahead. Does not consume any
392-- | Match any byte, to perform lookahead. Does not consume any
430-- input, but will fail if end of input has been reached.
393-- input, but will fail if end of input has been reached.
431peekWord8' :: Parser Word8
394peekWord8' :: Parser Word8
432−peekWord8' = T.Parser $ \t pos more lose succ ->
395+peekWord8' = do
433− if lengthAtLeast pos 1 t
396+ s <- ensure 1
434− then succ t pos more (Buf.unsafeIndex t (fromPos pos))
397+ return $! B.unsafeHead s
435− else let succ' t' pos' more' bs' = succ t' pos' more' $! B.unsafeHead bs'
436− in ensureSuspended 1 t pos more lose succ'
437{-# INLINE peekWord8' #-}
398{-# INLINE peekWord8' #-}
439-- | Match either a single newline character @\'\\n\'@, or a carriage
400-- | Match either a single newline character @\'\\n\'@, or a carriage
@@ -443,62 +404,51 @@ endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ())
444-- | Terminal failure continuation.
405-- | Terminal failure continuation.
445failK :: Failure a
406failK :: Failure a
446−failK t (Pos pos) _more stack msg = Fail (Buf.unsafeDrop pos t) stack msg
407+failK t (Pos pos) _more stack msg = Fail (B.unsafeDrop pos t) stack msg
447{-# INLINE failK #-}
408{-# INLINE failK #-}
449-- | Terminal success continuation.
410-- | Terminal success continuation.
450successK :: Success a a
411successK :: Success a a
451−successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a
412+successK t (Pos pos) _more a = Done (B.unsafeDrop pos t) a
452{-# INLINE successK #-}
413{-# INLINE successK #-}
454-- | Run a parser.
415-- | Run a parser.
455−parse :: Parser a -> ByteString -> Result a
416+parse :: Parser a -> B.ByteString -> Result a
456−parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK
417+parse m s = T.runParser m s (Pos 0) Incomplete failK successK
457{-# INLINE parse #-}
418{-# INLINE parse #-}
459-- | Run a parser that cannot be resupplied via a 'Partial' result.
420-- | Run a parser that cannot be resupplied via a 'Partial' result.
461−-- This function does not force a parser to consume all of its input.
462−-- Instead, any residual input will be discarded. To force a parser
463−-- to consume all of its input, use something like this:
466−--'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput')
468−parseOnly :: Parser a -> ByteString -> Either String a
421+parseOnly :: Parser a -> B.ByteString -> Either String a
469−parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of
422+parseOnly m s = case T.runParser m s (Pos 0) Complete failK successK of
470− Fail _ [] err -> Left err
471− Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err)
423+ Fail _ _ err -> Left err
472− Done _ a -> Right a
424+ Done _ a -> Right a
473− _ -> error "parseOnly: impossible error!"
425+ _ -> error "parseOnly: impossible error!"
474{-# INLINE parseOnly #-}
426{-# INLINE parseOnly #-}
428+-- | Just like unsafePerformIO, but we inline it. Big performance gains as
429+-- it exposes lots of things to further inlining. /Very unsafe/. In
430+-- particular, you should do no memory allocation inside an
431+-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.
432+inlinePerformIO :: IO a -> a
433+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
434+{-# INLINE inlinePerformIO #-}
476get :: Parser ByteString
436get :: Parser ByteString
477get = T.Parser $ \t pos more _lose succ ->
437get = T.Parser $ \t pos more _lose succ ->
478− succ t pos more (Buf.unsafeDrop (fromPos pos) t)
438+ succ t pos more (B.unsafeDrop (fromPos pos) t)
479{-# INLINE get #-}
439{-# INLINE get #-}
481endOfChunk :: Parser Bool
441endOfChunk :: Parser Bool
482endOfChunk = T.Parser $ \t pos more _lose succ ->
442endOfChunk = T.Parser $ \t pos more _lose succ ->
483− succ t pos more (fromPos pos == Buf.length t)
443+ succ t pos more (fromPos pos == B.length t)
484{-# INLINE endOfChunk #-}
444{-# INLINE endOfChunk #-}
486−inputSpansChunks :: Int -> Parser Bool
487−inputSpansChunks i = T.Parser $ \t pos_ more _lose succ ->
488− let pos = pos_ + Pos i
489− in if fromPos pos < Buf.length t || more == Complete
490− then succ t pos more False
491− else let lose' t' pos' more' = succ t' pos' more' False
492− succ' t' pos' more' = succ t' pos' more' True
493− in prompt t pos more lose' succ'
494−{-# INLINE inputSpansChunks #-}
496advance :: Int -> Parser ()
446advance :: Int -> Parser ()
497advance n = T.Parser $ \t pos more _lose succ ->
447advance n = T.Parser $ \t pos more _lose succ ->
498 succ t (pos + Pos n) more ()
448 succ t (pos + Pos n) more ()
499{-# INLINE advance #-}
449{-# INLINE advance #-}
501−ensureSuspended :: Int -> Buffer -> Pos -> More
451+ensureSuspended :: Int -> ByteString -> Pos -> More
502 -> Failure r
452 -> Failure r
503 -> Success ByteString r
453 -> Success ByteString r
504 -> Result r
454 -> Result r
@@ -517,8 +467,54 @@ ensure n = T.Parser $ \t pos more lose succ ->
517 then succ t pos more (substring pos (Pos n) t)
467 then succ t pos more (substring pos (Pos n) t)
518 -- The uncommon case is kept out-of-line to reduce code size:
468 -- The uncommon case is kept out-of-line to reduce code size:
519 else ensureSuspended n t pos more lose succ
469 else ensureSuspended n t pos more lose succ
470+-- Non-recursive so the bounds check can be inlined:
520{-# INLINE ensure #-}
471{-# INLINE ensure #-}
473+-- | Ask for input. If we receive any, pass it to a success
474+-- continuation, otherwise to a failure continuation.
475+prompt :: ByteString -> Pos -> More
476+ -> (ByteString -> Pos -> More -> IResult ByteString r)
477+ -> (ByteString -> Pos -> More -> IResult ByteString r)
478+ -> IResult ByteString r
479+prompt t pos _more lose succ = Partial $ \s ->
481+ then lose t pos Complete
482+ else succ (t <> s) pos Incomplete
484+-- | Immediately demand more input via a 'Partial' continuation
486+demandInput :: Parser ()
487+demandInput = T.Parser $ \t pos more lose succ ->
489+ Complete -> lose t pos more [] "not enough input"
490+ _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input"
491+ succ' t' pos' more' = succ t' pos' more' ()
492+ in prompt t pos more lose' succ'
494+-- | This parser always succeeds. It returns 'True' if any input is
495+-- available either immediately or on demand, and 'False' if the end
496+-- of all input has been reached.
497+wantInput :: Parser Bool
498+wantInput = T.Parser $ \t pos more _lose succ ->
500+ _ | lengthAtLeast pos 1 t -> succ t pos more True
501+ | more == Complete -> succ t pos more False
502+ | otherwise -> let lose' t' pos' more' = succ t' pos' more' False
503+ succ' t' pos' more' = succ t' pos' more' True
504+ in prompt t pos more lose' succ'
505+{-# INLINE wantInput #-}
507+-- | Match only if all input has been consumed.
508+endOfInput :: Parser ()
509+endOfInput = T.Parser $ \t pos more lose succ ->
511+ _| lengthAtLeast pos 1 t -> lose t pos more [] "endOfInput"
512+ | more == Complete -> succ t pos more ()
514+ let lose' t' pos' more' _ctx _msg = succ t' pos' more' ()
515+ succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput"
516+ in runParser demandInput t pos more lose' succ'
522-- | Return both the result of a parse and the portion of the input
518-- | Return both the result of a parse and the portion of the input
523-- that was consumed while it was being parsed.
519-- that was consumed while it was being parsed.
524match :: Parser a -> Parser (ByteString, a)
520match :: Parser a -> Parser (ByteString, a)
@@ -527,10 +523,16 @@ match p = T.Parser $ \t pos more lose succ ->
527 succ t' pos' more' (substring pos (pos'-pos) t', a)
523 succ t' pos' more' (substring pos (pos'-pos) t', a)
528 in runParser p t pos more lose succ'
524 in runParser p t pos more lose succ'
526+-- | Return an indication of whether the end of input has been
529+atEnd = not <$> wantInput
530−lengthAtLeast :: Pos -> Int -> Buffer -> Bool
532+lengthAtLeast :: Pos -> Int -> ByteString -> Bool
531−lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n
533+lengthAtLeast (Pos pos) n bs = B.length bs >= pos + n
532{-# INLINE lengthAtLeast #-}
534{-# INLINE lengthAtLeast #-}
534−substring :: Pos -> Pos -> Buffer -> ByteString
536+substring :: Pos -> Pos -> ByteString -> ByteString
535−substring (Pos pos) (Pos n) = Buf.substring pos n
537+substring (Pos pos) (Pos n) bs = B.unsafeTake n (B.unsafeDrop pos bs)
536{-# INLINE substring #-}
538{-# INLINE substring #-}