@@ -1,16 +1,16 @@
1−{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, GADTs, OverloadedStrings,
1+{-# LANGUAGE BangPatterns, FlexibleInstances, GADTs, OverloadedStrings,
2 Rank2Types, RecordWildCards, TypeFamilies, TypeSynonymInstances #-}
2 Rank2Types, RecordWildCards, TypeFamilies, TypeSynonymInstances #-}
3{-# OPTIONS_GHC -fno-warn-orphans #-}
3{-# OPTIONS_GHC -fno-warn-orphans #-}
5-- Module : Data.Attoparsec.Text.Internal
5-- Module : Data.Attoparsec.Text.Internal
6−-- Copyright : Bryan O'Sullivan 2011
6+-- Copyright : Bryan O'Sullivan 2007-2015
7-- License : BSD3
7-- License : BSD3
9-- Maintainer : bos@serpentine.com
9-- Maintainer : bos@serpentine.com
10-- Stability : experimental
10-- Stability : experimental
11-- Portability : unknown
11-- Portability : unknown
13−-- Simple, efficient parser combinators for 'T.Text' strings, loosely
13+-- Simple, efficient parser combinators for 'Text' strings, loosely
14-- based on the Parsec library.
14-- based on the Parsec library.
16module Data.Attoparsec.Text.Internal
16module Data.Attoparsec.Text.Internal
@@ -60,43 +60,37 @@ module Data.Attoparsec.Text.Internal
61 -- * Utilities
61 -- * Utilities
62 , endOfLine
62 , endOfLine
65−import Control.Applicative ((<|>), (<$>))
68+import Control.Applicative ((<|>), (<$>), pure, (*>))
66import Control.Monad (when)
69import Control.Monad (when)
67−import Data.Attoparsec.Combinator
70+import Data.Attoparsec.Combinator ((<?>))
68−import Data.Attoparsec.Internal.Types hiding (Parser, Input, Added, Failure, Success)
69import Data.Attoparsec.Internal
71import Data.Attoparsec.Internal
70−import Data.Monoid (Monoid(..))
72+import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
73+import qualified Data.Attoparsec.Text.Buffer as Buf
74+import Data.Attoparsec.Text.Buffer (Buffer, buffer)
75+import Data.Char (isAsciiUpper, isAsciiLower, toUpper, toLower)
76+import Data.List (intercalate)
71import Data.String (IsString(..))
77import Data.String (IsString(..))
72−import Data.Text (Text)
78+import Data.Text.Internal (Text(..))
73−import Prelude hiding (getChar, take, takeWhile)
79+import Prelude hiding (getChar, succ, take, takeWhile)
74−import Data.Char (chr, ord)
75import qualified Data.Attoparsec.Internal.Types as T
80import qualified Data.Attoparsec.Internal.Types as T
76import qualified Data.Attoparsec.Text.FastSet as Set
81import qualified Data.Attoparsec.Text.FastSet as Set
77import qualified Data.Text as T
82import qualified Data.Text as T
78import qualified Data.Text.Lazy as L
83import qualified Data.Text.Lazy as L
84+import qualified Data.Text.Unsafe as T
80type Parser = T.Parser Text
86type Parser = T.Parser Text
81type Result = IResult Text
87type Result = IResult Text
82−type Failure r = T.Failure Text r
88+type Failure r = T.Failure Text Buffer r
83−type Success a r = T.Success Text a r
89+type Success a r = T.Success Text Buffer a r
85instance (a ~ Text) => IsString (Parser a) where
91instance (a ~ Text) => IsString (Parser a) where
86 fromString = string . T.pack
92 fromString = string . T.pack
88−unsafeHead :: Text -> Char
91−unsafeTail :: Text -> Text
94−unsafeTake :: Int -> Text -> Text
97−unsafeDrop :: Int -> Text -> Text
100-- | The parser @satisfy p@ succeeds for any character for which the
94-- | The parser @satisfy p@ succeeds for any character for which the
101-- predicate @p@ returns 'True'. Returns the character that is
95-- predicate @p@ returns 'True'. Returns the character that is
102-- actually parsed.
96-- actually parsed.
@@ -104,7 +98,12 @@ unsafeDrop = T.drop
104-- >digit = satisfy isDigit
98-- >digit = satisfy isDigit
105-- > where isDigit c = c >= '0' && c <= '9'
99-- > where isDigit c = c >= '0' && c <= '9'
106satisfy :: (Char -> Bool) -> Parser Char
100satisfy :: (Char -> Bool) -> Parser Char
107−satisfy = satisfyElem
101+satisfy p = do
103+ let !h = T.unsafeHead c
105+ then advance k >> return h
108{-# INLINE satisfy #-}
107{-# INLINE satisfy #-}
110-- | The parser @skip p@ succeeds for any character for which the
109-- | The parser @skip p@ succeeds for any character for which the
@@ -114,9 +113,9 @@ satisfy = satisfyElem
114-- > where isDigit c = c >= '0' && c <= '9'
113-- > where isDigit c = c >= '0' && c <= '9'
115skip :: (Char -> Bool) -> Parser ()
114skip :: (Char -> Bool) -> Parser ()
116skip p = do
115skip p = do
117− s <- ensure 1
116+ (k,s) <- ensure 1
118− if p (unsafeHead s)
117+ if p (T.unsafeHead s)
119− then put (unsafeTail s)
118+ then advance k
120 else fail "skip"
119 else fail "skip"
122-- | The parser @satisfyWith f p@ transforms a character, and succeeds
121-- | The parser @satisfyWith f p@ transforms a character, and succeeds
@@ -124,11 +123,10 @@ skip p = do
124-- parser returns the transformed character that was parsed.
123-- parser returns the transformed character that was parsed.
125satisfyWith :: (Char -> a) -> (a -> Bool) -> Parser a
124satisfyWith :: (Char -> a) -> (a -> Bool) -> Parser a
126satisfyWith f p = do
125satisfyWith f p = do
127− s <- ensure 1
126+ (k,s) <- ensure 1
128− let c = f $! unsafeHead s
127+ let c = f $! T.unsafeHead s
130− then let !t = unsafeTail s
129+ then advance k >> return c
131− in put t >> return c
132 else fail "satisfyWith"
130 else fail "satisfyWith"
133{-# INLINE satisfyWith #-}
131{-# INLINE satisfyWith #-}
@@ -136,15 +134,14 @@ satisfyWith f p = do
136-- predicate returns 'True'.
134-- predicate returns 'True'.
137takeWith :: Int -> (Text -> Bool) -> Parser Text
135takeWith :: Int -> (Text -> Bool) -> Parser Text
138takeWith n p = do
136takeWith n p = do
139− s <- ensure n
137+ (k,s) <- ensure n
140− let (h,t) = T.splitAt n s
138+ if p s
141− if p h
139+ then advance k >> return s
142− then put t >> return h
143 else fail "takeWith"
140 else fail "takeWith"
145-- | Consume exactly @n@ characters of input.
142-- | Consume exactly @n@ characters of input.
146take :: Int -> Parser Text
143take :: Int -> Parser Text
147−take n = takeWith n (const True)
144+take n = takeWith (max n 0) (const True)
148{-# INLINE take #-}
145{-# INLINE take #-}
150-- | @string s@ parses a sequence of characters that identically match
147-- | @string s@ parses a sequence of characters that identically match
@@ -160,12 +157,49 @@ take n = takeWith n (const True)
161-- The reason for its failure is that the first branch is a
158-- The reason for its failure is that the first branch is a
162-- partial match, and will consume the letters @\'f\'@ and @\'o\'@
159-- partial match, and will consume the letters @\'f\'@ and @\'o\'@
163−-- before failing. In Attoparsec, the above parser will /succeed/ on
160+-- before failing. In attoparsec, the above parser will /succeed/ on
164-- that input, because the failed first branch will consume nothing.
161-- that input, because the failed first branch will consume nothing.
165string :: Text -> Parser Text
162string :: Text -> Parser Text
166−string s = takeWith (T.length s) (==s)
163+string s = string_ (stringSuspended id) id s
167{-# INLINE string #-}
164{-# INLINE string #-}
166+string_ :: (forall r. Text -> Text -> Buffer -> Pos -> More
167+ -> Failure r -> Success Text r -> Result r)
169+ -> Text -> Parser Text
170+string_ suspended f s0 = T.Parser $ \t pos more lose succ ->
172+ ft = f (Buf.unbufferAt (fromPos pos) t)
173+ in case T.commonPrefixes s ft of
175+ | T.null s -> succ t pos more T.empty
176+ | T.null ft -> suspended s s t pos more lose succ
177+ | otherwise -> lose t pos more [] "string"
178+ Just (pfx,ssfx,tsfx)
179+ | T.null ssfx -> let l = Pos (T.lengthWord16 pfx)
180+ in succ t (pos + l) more (substring pos l t)
181+ | not (T.null tsfx) -> lose t pos more [] "string"
182+ | otherwise -> suspended s ssfx t pos more lose succ
183+{-# INLINE string_ #-}
185+stringSuspended :: (Text -> Text)
186+ -> Text -> Text -> Buffer -> Pos -> More
190+stringSuspended f s000 s0 t0 pos0 more0 lose0 succ0 =
191+ runParser (demandInput_ >>= go) t0 pos0 more0 lose0 succ0
193+ go s' = T.Parser $ \t pos more lose succ ->
195+ in case T.commonPrefixes s0 s of
196+ Nothing -> lose t pos more [] "string"
197+ Just (_pfx,ssfx,tsfx)
198+ | T.null ssfx -> let l = Pos (T.lengthWord16 s000)
199+ in succ t (pos + l) more (substring pos l t)
200+ | T.null tsfx -> stringSuspended f s000 ssfx t pos more lose succ
201+ | otherwise -> lose t pos more [] "string"
169-- | Satisfy a literal string, ignoring case.
203-- | Satisfy a literal string, ignoring case.
171-- Note: this function is currently quite inefficient. Unicode case
205-- Note: this function is currently quite inefficient. Unicode case
@@ -178,10 +212,9 @@ stringCI s = go 0
179 | n > T.length fs = fail "stringCI"
213 | n > T.length fs = fail "stringCI"
180 | otherwise = do
214 | otherwise = do
181− t <- ensure n
215+ (k,t) <- ensure n
182− let h = unsafeTake n t
216+ if T.toCaseFold t == fs
183− if T.toCaseFold h == fs
217+ then advance k >> return t
184− then put (unsafeDrop n t) >> return h
185 else go (n+1)
218 else go (n+1)
186 fs = T.toCaseFold s
219 fs = T.toCaseFold s
187{-# INLINE stringCI #-}
220{-# INLINE stringCI #-}
@@ -189,34 +222,24 @@ stringCI s = go 0
190-- | Satisfy a literal string, ignoring case for characters in the ASCII range.
223-- | Satisfy a literal string, ignoring case for characters in the ASCII range.
191asciiCI :: Text -> Parser Text
224asciiCI :: Text -> Parser Text
192−asciiCI input = do
225+asciiCI s = fmap fst $ match $ T.foldr ((*>) . asciiCharCI) (pure ()) s
194− let h = unsafeTake n t
195− if asciiToLower h == s
196− then put (unsafeDrop n t) >> return h
200− s = asciiToLower input
202− -- convert letters in the ASCII range to lower-case
203− asciiToLower = T.map f
205− offset = ord 'a' - ord 'A'
206− f c | 'A' <= c && c <= 'Z' = chr (ord c + offset)
208{-# INLINE asciiCI #-}
226{-# INLINE asciiCI #-}
228+asciiCharCI :: Char -> Parser Char
230+ | isAsciiUpper c = char c <|> char (toLower c)
231+ | isAsciiLower c = char c <|> char (toUpper c)
232+ | otherwise = char c
233+{-# INLINE asciiCharCI #-}
210-- | Skip past input for as long as the predicate returns 'True'.
235-- | Skip past input for as long as the predicate returns 'True'.
211skipWhile :: (Char -> Bool) -> Parser ()
236skipWhile :: (Char -> Bool) -> Parser ()
212skipWhile p = go
237skipWhile p = go
215− t <- T.dropWhile p <$> get
240+ t <- T.takeWhile p <$> get
216− put t
241+ continue <- inputSpansChunks (size t)
217− when (T.null t) $ do
242+ when continue go
220{-# INLINE skipWhile #-}
243{-# INLINE skipWhile #-}
222-- | Consume input as long as the predicate returns 'False'
245-- | Consume input as long as the predicate returns 'False'
@@ -226,8 +249,9 @@ skipWhile p = go
226-- predicate returns 'True' on the first character of input.
249-- predicate returns 'True' on the first character of input.
228-- /Note/: Because this parser does not fail, do not use it with
251-- /Note/: Because this parser does not fail, do not use it with
229−-- combinators such as 'many', because such parsers loop until a
252+-- combinators such as 'Control.Applicative.many', because such
230−-- failure occurs. Careless use will thus result in an infinite loop.
253+-- parsers loop until a failure occurs. Careless use will thus result
254+-- in an infinite loop.
231takeTill :: (Char -> Bool) -> Parser Text
255takeTill :: (Char -> Bool) -> Parser Text
232takeTill p = takeWhile (not . p)
256takeTill p = takeWhile (not . p)
233{-# INLINE takeTill #-}
257{-# INLINE takeTill #-}
@@ -239,21 +263,29 @@ takeTill p = takeWhile (not . p)
239-- predicate returns 'False' on the first character of input.
263-- predicate returns 'False' on the first character of input.
241-- /Note/: Because this parser does not fail, do not use it with
265-- /Note/: Because this parser does not fail, do not use it with
242−-- combinators such as 'many', because such parsers loop until a
266+-- combinators such as 'Control.Applicative.many', because such
243−-- failure occurs. Careless use will thus result in an infinite loop.
267+-- parsers loop until a failure occurs. Careless use will thus result
268+-- in an infinite loop.
244takeWhile :: (Char -> Bool) -> Parser Text
269takeWhile :: (Char -> Bool) -> Parser Text
245−takeWhile p = (T.concat . reverse) `fmap` go []
270+takeWhile p = do
271+ h <- T.takeWhile p <$> get
272+ continue <- inputSpansChunks (size h)
273+ -- only use slow concat path if necessary
275+ then takeWhileAcc p [h]
277+{-# INLINE takeWhile #-}
279+takeWhileAcc :: (Char -> Bool) -> [Text] -> Parser Text
247 go acc = do
282 go acc = do
248− (h,t) <- T.span p <$> get
283+ h <- T.takeWhile p <$> get
249− put t
284+ continue <- inputSpansChunks (size h)
250− if T.null t
285+ if continue
251− then do
286+ then go (h:acc)
252− input <- wantInput
287+ else return $ concatReverse (h:acc)
253− if input
288+{-# INLINE takeWhileAcc #-}
258takeRest :: Parser [Text]
290takeRest :: Parser [Text]
259takeRest = go []
291takeRest = go []
@@ -263,7 +295,7 @@ takeRest = go []
266− put T.empty
298+ advance (size s)
267 go (s:acc)
299 go (s:acc)
268 else return (reverse acc)
300 else return (reverse acc)
@@ -276,7 +308,7 @@ takeLazyText :: Parser L.Text
276takeLazyText = L.fromChunks `fmap` takeRest
308takeLazyText = L.fromChunks `fmap` takeRest
278data Scan s = Continue s
310data Scan s = Continue s
279− | Finished {-# UNPACK #-} !Int T.Text
311+ | Finished s {-# UNPACK #-} !Int Text
281scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
313scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
282scan_ f s0 p = go [] s0
314scan_ f s0 p = go [] s0
@@ -285,17 +317,17 @@ scan_ f s0 p = go [] s0
285 case T.uncons t of
317 case T.uncons t of
286 Just (c,t') -> case p s c of
318 Just (c,t') -> case p s c of
287 Just s' -> scanner s' (n+1) t'
319 Just s' -> scanner s' (n+1) t'
288− Nothing -> Finished n t
320+ Nothing -> Finished s n t
289 Nothing -> Continue s
321 Nothing -> Continue s
290 go acc s = do
322 go acc s = do
291 input <- get
323 input <- get
292 case scanner s 0 input of
324 case scanner s 0 input of
293− Continue s' -> do put T.empty
325+ Continue s' -> do continue <- inputSpansChunks (size input)
294− more <- wantInput
326+ if continue
296 then go (input : acc) s'
327 then go (input : acc) s'
297 else f s' (input : acc)
328 else f s' (input : acc)
298− Finished n t -> put t >> f s (T.take n input : acc)
329+ Finished s' n t -> do advance (size input - size t)
330+ f s' (T.take n input : acc)
299{-# INLINE scan_ #-}
331{-# INLINE scan_ #-}
301-- | A stateful scanner. The predicate consumes and transforms a
333-- | A stateful scanner. The predicate consumes and transforms a
@@ -307,19 +339,17 @@ scan_ f s0 p = go [] s0
307-- predicate returns 'Nothing' on the first character of input.
339-- predicate returns 'Nothing' on the first character of input.
309-- /Note/: Because this parser does not fail, do not use it with
341-- /Note/: Because this parser does not fail, do not use it with
310−-- combinators such as 'many', because such parsers loop until a
342+-- combinators such as 'Control.Applicative.many', because such
311−-- failure occurs. Careless use will thus result in an infinite loop.
343+-- parsers loop until a failure occurs. Careless use will thus result
344+-- in an infinite loop.
312scan :: s -> (s -> Char -> Maybe s) -> Parser Text
345scan :: s -> (s -> Char -> Maybe s) -> Parser Text
313−scan = scan_ $ \_ chunks ->
346+scan = scan_ $ \_ chunks -> return $! concatReverse chunks
316− xs -> return . T.concat . reverse $ xs
317{-# INLINE scan #-}
347{-# INLINE scan #-}
319-- | Like 'scan', but generalized to return the final state of the
349-- | Like 'scan', but generalized to return the final state of the
320-- scanner.
350-- scanner.
321runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
351runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
322−runScanner = scan_ $ \s xs -> return (T.concat (reverse xs), s)
352+runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
323{-# INLINE runScanner #-}
353{-# INLINE runScanner #-}
325-- | Consume input as long as the predicate returns 'True', and return
355-- | Consume input as long as the predicate returns 'True', and return
@@ -330,13 +360,16 @@ runScanner = scan_ $ \s xs -> return (T.concat (reverse xs), s)
330-- 'True' or if there is no input left.
360-- 'True' or if there is no input left.
331takeWhile1 :: (Char -> Bool) -> Parser Text
361takeWhile1 :: (Char -> Bool) -> Parser Text
332takeWhile1 p = do
362takeWhile1 p = do
333− (`when` demandInput) =<< T.null <$> get
363+ (`when` demandInput) =<< endOfChunk
334− (h,t) <- T.span p <$> get
364+ h <- T.takeWhile p <$> get
335− when (T.null h) $ fail "takeWhile1"
365+ let size' = size h
336− put t
366+ when (size' == 0) $ fail "takeWhile1"
337− if T.null t
367+ advance size'
338− then (h<>) `fmap` takeWhile p
368+ eoc <- endOfChunk
370+ then takeWhileAcc p [h]
339 else return h
371 else return h
372+{-# INLINE takeWhile1 #-}
341-- | Match any character in a set.
374-- | Match any character in a set.
@@ -378,27 +411,31 @@ notChar c = satisfy (/= c) <?> "not " ++ show c
378-- end of input has been reached. Does not consume any input.
411-- end of input has been reached. Does not consume any input.
380-- /Note/: Because this parser does not fail, do not use it with
413-- /Note/: Because this parser does not fail, do not use it with
381−-- combinators such as 'many', because such parsers loop until a
414+-- combinators such as 'Control.Applicative.many', because such
382−-- failure occurs. Careless use will thus result in an infinite loop.
415+-- parsers loop until a failure occurs. Careless use will thus result
416+-- in an infinite loop.
383peekChar :: Parser (Maybe Char)
417peekChar :: Parser (Maybe Char)
384−peekChar = T.Parser $ \i0 a0 m0 _kf ks ->
418+peekChar = T.Parser $ \t pos more _lose succ ->
385− if T.null (unI i0)
419+ case () of
386− then if m0 == Complete
420+ _| pos < lengthOf t ->
387− then ks i0 a0 m0 Nothing
421+ let T.Iter !c _ = Buf.iter t (fromPos pos)
388− else let ks' i a m = let !c = unsafeHead (unI i)
422+ in succ t pos more (Just c)
389− in ks i a m (Just c)
423+ | more == Complete ->
390− kf' i a m = ks i a m Nothing
424+ succ t pos more Nothing
391− in prompt i0 a0 m0 kf' ks'
425+ | otherwise ->
392− else let !c = unsafeHead (unI i0)
426+ let succ' t' pos' more' =
393− in ks i0 a0 m0 (Just c)
427+ let T.Iter !c _ = Buf.iter t' (fromPos pos')
428+ in succ t' pos' more' (Just c)
429+ lose' t' pos' more' = succ t' pos' more' Nothing
430+ in prompt t pos more lose' succ'
394{-# INLINE peekChar #-}
431{-# INLINE peekChar #-}
396-- | Match any character, to perform lookahead. Does not consume any
433-- | Match any character, to perform lookahead. Does not consume any
397-- input, but will fail if end of input has been reached.
434-- input, but will fail if end of input has been reached.
398peekChar' :: Parser Char
435peekChar' :: Parser Char
399peekChar' = do
436peekChar' = do
400− s <- ensure 1
437+ (_,s) <- ensure 1
401− return $! unsafeHead s
438+ return $! T.unsafeHead s
402{-# INLINE peekChar' #-}
439{-# INLINE peekChar' #-}
404-- | Match either a single newline character @\'\\n\'@, or a carriage
441-- | Match either a single newline character @\'\\n\'@, or a carriage
@@ -408,23 +445,105 @@ endOfLine = (char '\n' >> return ()) <|> (string "\r\n" >> return ())
409-- | Terminal failure continuation.
446-- | Terminal failure continuation.
410failK :: Failure a
447failK :: Failure a
411−failK i0 _a0 _m0 stack msg = Fail (unI i0) stack msg
448+failK t (Pos pos) _more stack msg = Fail (Buf.dropWord16 pos t) stack msg
412{-# INLINE failK #-}
449{-# INLINE failK #-}
414-- | Terminal success continuation.
451-- | Terminal success continuation.
415successK :: Success a a
452successK :: Success a a
416−successK i0 _a0 _m0 a = Done (unI i0) a
453+successK t (Pos pos) _more a = Done (Buf.dropWord16 pos t) a
417{-# INLINE successK #-}
454{-# INLINE successK #-}
419-- | Run a parser.
456-- | Run a parser.
420parse :: Parser a -> Text -> Result a
457parse :: Parser a -> Text -> Result a
421−parse m s = runParser m (I s) mempty Incomplete failK successK
458+parse m s = runParser m (buffer s) 0 Incomplete failK successK
422{-# INLINE parse #-}
459{-# INLINE parse #-}
424-- | Run a parser that cannot be resupplied via a 'Partial' result.
461-- | Run a parser that cannot be resupplied via a 'Partial' result.
463+-- This function does not force a parser to consume all of its input.
464+-- Instead, any residual input will be discarded. To force a parser
465+-- to consume all of its input, use something like this:
468+--'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput')
425parseOnly :: Parser a -> Text -> Either String a
470parseOnly :: Parser a -> Text -> Either String a
426−parseOnly m s = case runParser m (I s) mempty Complete failK successK of
471+parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of
427− Fail _ _ err -> Left err
472+ Fail _ [] err -> Left err
428− Done _ a -> Right a
473+ Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err)
429− _ -> error "parseOnly: impossible error!"
474+ Done _ a -> Right a
475+ _ -> error "parseOnly: impossible error!"
430{-# INLINE parseOnly #-}
476{-# INLINE parseOnly #-}
479+get = T.Parser $ \t pos more _lose succ ->
480+ succ t pos more (Buf.dropWord16 (fromPos pos) t)
483+endOfChunk :: Parser Bool
484+endOfChunk = T.Parser $ \t pos more _lose succ ->
485+ succ t pos more (pos == lengthOf t)
486+{-# INLINE endOfChunk #-}
488+inputSpansChunks :: Pos -> Parser Bool
489+inputSpansChunks i = T.Parser $ \t pos_ more _lose succ ->
491+ in if pos < lengthOf t || more == Complete
492+ then succ t pos more False
493+ else let lose' t' pos' more' = succ t' pos' more' False
494+ succ' t' pos' more' = succ t' pos' more' True
495+ in prompt t pos more lose' succ'
496+{-# INLINE inputSpansChunks #-}
498+advance :: Pos -> Parser ()
499+advance n = T.Parser $ \t pos more _lose succ -> succ t (pos+n) more ()
500+{-# INLINE advance #-}
502+ensureSuspended :: Int -> Buffer -> Pos -> More
503+ -> Failure r -> Success (Pos, Text) r
505+ensureSuspended n t pos more lose succ =
506+ runParser (demandInput >> go) t pos more lose succ
507+ where go = T.Parser $ \t' pos' more' lose' succ' ->
508+ case lengthAtLeast pos' n t' of
509+ Just n' -> succ' t' pos' more' (n', substring pos n' t')
510+ Nothing -> runParser (demandInput >> go) t' pos' more' lose' succ'
512+-- | If at least @n@ elements of input are available, return the
513+-- current input, otherwise fail.
514+ensure :: Int -> Parser (Pos, Text)
515+ensure n = T.Parser $ \t pos more lose succ ->
516+ case lengthAtLeast pos n t of
517+ Just n' -> succ t pos more (n', substring pos n' t)
518+ -- The uncommon case is kept out-of-line to reduce code size:
519+ Nothing -> ensureSuspended n t pos more lose succ
520+{-# INLINE ensure #-}
522+-- | Return both the result of a parse and the portion of the input
523+-- that was consumed while it was being parsed.
524+match :: Parser a -> Parser (Text, a)
525+match p = T.Parser $ \t pos more lose succ ->
526+ let succ' t' pos' more' a = succ t' pos' more'
527+ (substring pos (pos'-pos) t', a)
528+ in runParser p t pos more lose succ'
530+-- | Ensure that at least @n@ code points of input are available.
531+-- Returns the number of words consumed while traversing.
532+lengthAtLeast :: Pos -> Int -> Buffer -> Maybe Pos
533+lengthAtLeast pos n t = go 0 (fromPos pos)
535+ | i == n = Just (Pos p - pos)
536+ | p == len = Nothing
537+ | otherwise = go (i+1) (p + Buf.iter_ t p)
538+ Pos len = lengthOf t
539+{-# INLINE lengthAtLeast #-}
541+substring :: Pos -> Pos -> Buffer -> Text
542+substring (Pos pos) (Pos n) = Buf.substring pos n
543+{-# INLINE substring #-}
545+lengthOf :: Buffer -> Pos
546+lengthOf = Pos . Buf.length
549+size (Text _ _ l) = Pos l