@@ -1,16 +1,16 @@
1−{-# LANGUAGE BangPatterns, FlexibleInstances, GADTs, OverloadedStrings,
1+{-# LANGUAGE BangPatterns, CPP, 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 2007-2015
6+-- Copyright : Bryan O'Sullivan 2011
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 'Text' strings, loosely
13+-- Simple, efficient parser combinators for 'T.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,37 +60,43 @@ module Data.Attoparsec.Text.Internal
61 -- * Utilities
61 -- * Utilities
62 , endOfLine
62 , endOfLine
68−import Control.Applicative ((<|>), (<$>), pure, (*>))
65+import Control.Applicative ((<|>), (<$>))
69import Control.Monad (when)
66import Control.Monad (when)
70−import Data.Attoparsec.Combinator ((<?>))
67+import Data.Attoparsec.Combinator
68+import Data.Attoparsec.Internal.Types hiding (Parser, Input, Added, Failure, Success)
71import Data.Attoparsec.Internal
69import Data.Attoparsec.Internal
72−import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
70+import Data.Monoid (Monoid(..))
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)
77import Data.String (IsString(..))
71import Data.String (IsString(..))
78−import Data.Text.Internal (Text(..))
72+import Data.Text (Text)
79−import Prelude hiding (getChar, succ, take, takeWhile)
73+import Prelude hiding (getChar, take, takeWhile)
74+import Data.Char (chr, ord)
80import qualified Data.Attoparsec.Internal.Types as T
75import qualified Data.Attoparsec.Internal.Types as T
81import qualified Data.Attoparsec.Text.FastSet as Set
76import qualified Data.Attoparsec.Text.FastSet as Set
82import qualified Data.Text as T
77import qualified Data.Text as T
83import qualified Data.Text.Lazy as L
78import qualified Data.Text.Lazy as L
84−import qualified Data.Text.Unsafe as T
86type Parser = T.Parser Text
80type Parser = T.Parser Text
87type Result = IResult Text
81type Result = IResult Text
88−type Failure r = T.Failure Text Buffer r
82+type Failure r = T.Failure Text r
89−type Success a r = T.Success Text Buffer a r
83+type Success a r = T.Success Text a r
91instance (a ~ Text) => IsString (Parser a) where
85instance (a ~ Text) => IsString (Parser a) where
92 fromString = string . T.pack
86 fromString = string . T.pack
88+unsafeHead :: Text -> Char
91+unsafeTail :: Text -> Text
94+unsafeTake :: Int -> Text -> Text
97+unsafeDrop :: Int -> Text -> Text
94-- | The parser @satisfy p@ succeeds for any character for which the
100-- | The parser @satisfy p@ succeeds for any character for which the
95-- predicate @p@ returns 'True'. Returns the character that is
101-- predicate @p@ returns 'True'. Returns the character that is
96-- actually parsed.
102-- actually parsed.
@@ -98,12 +104,7 @@ instance (a ~ Text) => IsString (Parser a) where
98-- >digit = satisfy isDigit
104-- >digit = satisfy isDigit
99-- > where isDigit c = c >= '0' && c <= '9'
105-- > where isDigit c = c >= '0' && c <= '9'
100satisfy :: (Char -> Bool) -> Parser Char
106satisfy :: (Char -> Bool) -> Parser Char
101−satisfy p = do
107+satisfy = satisfyElem
103− let !h = T.unsafeHead c
105− then advance k >> return h
107{-# INLINE satisfy #-}
108{-# INLINE satisfy #-}
109-- | The parser @skip p@ succeeds for any character for which the
110-- | The parser @skip p@ succeeds for any character for which the
@@ -113,9 +114,9 @@ satisfy p = do
113-- > where isDigit c = c >= '0' && c <= '9'
114-- > where isDigit c = c >= '0' && c <= '9'
114skip :: (Char -> Bool) -> Parser ()
115skip :: (Char -> Bool) -> Parser ()
115skip p = do
116skip p = do
116− (k,s) <- ensure 1
117+ s <- ensure 1
117− if p (T.unsafeHead s)
118+ if p (unsafeHead s)
118− then advance k
119+ then put (unsafeTail s)
119 else fail "skip"
120 else fail "skip"
121-- | The parser @satisfyWith f p@ transforms a character, and succeeds
122-- | The parser @satisfyWith f p@ transforms a character, and succeeds
@@ -123,10 +124,11 @@ skip p = do
123-- parser returns the transformed character that was parsed.
124-- parser returns the transformed character that was parsed.
124satisfyWith :: (Char -> a) -> (a -> Bool) -> Parser a
125satisfyWith :: (Char -> a) -> (a -> Bool) -> Parser a
125satisfyWith f p = do
126satisfyWith f p = do
126− (k,s) <- ensure 1
127+ s <- ensure 1
127− let c = f $! T.unsafeHead s
128+ let c = f $! unsafeHead s
130+ then let !t = unsafeTail s
129− then advance k >> return c
131+ in put t >> return c
130 else fail "satisfyWith"
132 else fail "satisfyWith"
131{-# INLINE satisfyWith #-}
133{-# INLINE satisfyWith #-}
@@ -134,14 +136,15 @@ satisfyWith f p = do
134-- predicate returns 'True'.
136-- predicate returns 'True'.
135takeWith :: Int -> (Text -> Bool) -> Parser Text
137takeWith :: Int -> (Text -> Bool) -> Parser Text
136takeWith n p = do
138takeWith n p = do
137− (k,s) <- ensure n
139+ s <- ensure n
140+ let (h,t) = T.splitAt n s
139− then advance k >> return s
142+ then put t >> return h
140 else fail "takeWith"
143 else fail "takeWith"
142-- | Consume exactly @n@ characters of input.
145-- | Consume exactly @n@ characters of input.
143take :: Int -> Parser Text
146take :: Int -> Parser Text
144−take n = takeWith (max n 0) (const True)
147+take n = takeWith n (const True)
145{-# INLINE take #-}
148{-# INLINE take #-}
147-- | @string s@ parses a sequence of characters that identically match
150-- | @string s@ parses a sequence of characters that identically match
@@ -157,49 +160,12 @@ take n = takeWith (max n 0) (const True)
158-- The reason for its failure is that the first branch is a
161-- The reason for its failure is that the first branch is a
159-- partial match, and will consume the letters @\'f\'@ and @\'o\'@
162-- partial match, and will consume the letters @\'f\'@ and @\'o\'@
160−-- before failing. In attoparsec, the above parser will /succeed/ on
163+-- before failing. In Attoparsec, the above parser will /succeed/ on
161-- that input, because the failed first branch will consume nothing.
164-- that input, because the failed first branch will consume nothing.
162string :: Text -> Parser Text
165string :: Text -> Parser Text
163−string s = string_ (stringSuspended id) id s
166+string s = takeWith (T.length s) (==s)
164{-# INLINE string #-}
167{-# 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"
203-- | Satisfy a literal string, ignoring case.
169-- | Satisfy a literal string, ignoring case.
205-- Note: this function is currently quite inefficient. Unicode case
171-- Note: this function is currently quite inefficient. Unicode case
@@ -212,9 +178,10 @@ stringCI s = go 0
213 | n > T.length fs = fail "stringCI"
179 | n > T.length fs = fail "stringCI"
214 | otherwise = do
180 | otherwise = do
215− (k,t) <- ensure n
181+ 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
218 else go (n+1)
185 else go (n+1)
219 fs = T.toCaseFold s
186 fs = T.toCaseFold s
220{-# INLINE stringCI #-}
187{-# INLINE stringCI #-}
@@ -222,24 +189,34 @@ stringCI s = go 0
223-- | Satisfy a literal string, ignoring case for characters in the ASCII range.
190-- | Satisfy a literal string, ignoring case for characters in the ASCII range.
224asciiCI :: Text -> Parser Text
191asciiCI :: Text -> Parser Text
225−asciiCI s = fmap fst $ match $ T.foldr ((*>) . asciiCharCI) (pure ()) s
192+asciiCI input = do
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)
226{-# INLINE asciiCI #-}
208{-# 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 #-}
235-- | Skip past input for as long as the predicate returns 'True'.
210-- | Skip past input for as long as the predicate returns 'True'.
236skipWhile :: (Char -> Bool) -> Parser ()
211skipWhile :: (Char -> Bool) -> Parser ()
237skipWhile p = go
212skipWhile p = go
240− t <- T.takeWhile p <$> get
215+ t <- T.dropWhile p <$> get
241− continue <- inputSpansChunks (size t)
216+ put t
217+ when (T.null t) $ do
242− when continue go
219+ when input go
243{-# INLINE skipWhile #-}
220{-# INLINE skipWhile #-}
245-- | Consume input as long as the predicate returns 'False'
222-- | Consume input as long as the predicate returns 'False'
@@ -249,9 +226,8 @@ skipWhile p = go
249-- predicate returns 'True' on the first character of input.
226-- predicate returns 'True' on the first character of input.
251-- /Note/: Because this parser does not fail, do not use it with
228-- /Note/: Because this parser does not fail, do not use it with
252−-- combinators such as 'Control.Applicative.many', because such
229+-- combinators such as 'many', because such parsers loop until a
253−-- parsers loop until a failure occurs. Careless use will thus result
230+-- failure occurs. Careless use will thus result in an infinite loop.
254−-- in an infinite loop.
255takeTill :: (Char -> Bool) -> Parser Text
231takeTill :: (Char -> Bool) -> Parser Text
256takeTill p = takeWhile (not . p)
232takeTill p = takeWhile (not . p)
257{-# INLINE takeTill #-}
233{-# INLINE takeTill #-}
@@ -263,29 +239,21 @@ takeTill p = takeWhile (not . p)
263-- predicate returns 'False' on the first character of input.
239-- predicate returns 'False' on the first character of input.
265-- /Note/: Because this parser does not fail, do not use it with
241-- /Note/: Because this parser does not fail, do not use it with
266−-- combinators such as 'Control.Applicative.many', because such
242+-- combinators such as 'many', because such parsers loop until a
267−-- parsers loop until a failure occurs. Careless use will thus result
243+-- failure occurs. Careless use will thus result in an infinite loop.
268−-- in an infinite loop.
269takeWhile :: (Char -> Bool) -> Parser Text
244takeWhile :: (Char -> Bool) -> Parser Text
270−takeWhile p = do
245+takeWhile p = (T.concat . reverse) `fmap` go []
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
282 go acc = do
247 go acc = do
283− h <- T.takeWhile p <$> get
248+ (h,t) <- T.span p <$> get
284− continue <- inputSpansChunks (size h)
249+ put t
285− if continue
250+ if T.null t
286− then go (h:acc)
254+ then go (h:acc)
287− else return $ concatReverse (h:acc)
255+ else return (h:acc)
288−{-# INLINE takeWhileAcc #-}
256+ else return (h:acc)
290takeRest :: Parser [Text]
258takeRest :: Parser [Text]
291takeRest = go []
259takeRest = go []
@@ -295,7 +263,7 @@ takeRest = go []
298− advance (size s)
266+ put T.empty
299 go (s:acc)
267 go (s:acc)
300 else return (reverse acc)
268 else return (reverse acc)
@@ -308,7 +276,7 @@ takeLazyText :: Parser L.Text
308takeLazyText = L.fromChunks `fmap` takeRest
276takeLazyText = L.fromChunks `fmap` takeRest
310data Scan s = Continue s
278data Scan s = Continue s
311− | Finished s {-# UNPACK #-} !Int Text
279+ | Finished {-# UNPACK #-} !Int T.Text
313scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
281scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
314scan_ f s0 p = go [] s0
282scan_ f s0 p = go [] s0
@@ -317,17 +285,17 @@ scan_ f s0 p = go [] s0
317 case T.uncons t of
285 case T.uncons t of
318 Just (c,t') -> case p s c of
286 Just (c,t') -> case p s c of
319 Just s' -> scanner s' (n+1) t'
287 Just s' -> scanner s' (n+1) t'
320− Nothing -> Finished s n t
288+ Nothing -> Finished n t
321 Nothing -> Continue s
289 Nothing -> Continue s
322 go acc s = do
290 go acc s = do
323 input <- get
291 input <- get
324 case scanner s 0 input of
292 case scanner s 0 input of
325− Continue s' -> do continue <- inputSpansChunks (size input)
293+ Continue s' -> do put T.empty
326− if continue
294+ more <- wantInput
327 then go (input : acc) s'
296 then go (input : acc) s'
328 else f s' (input : acc)
297 else f s' (input : acc)
329− Finished s' n t -> do advance (size input - size t)
330− f s' (T.take n input : acc)
298+ Finished n t -> put t >> f s (T.take n input : acc)
331{-# INLINE scan_ #-}
299{-# INLINE scan_ #-}
333-- | A stateful scanner. The predicate consumes and transforms a
301-- | A stateful scanner. The predicate consumes and transforms a
@@ -339,17 +307,19 @@ scan_ f s0 p = go [] s0
339-- predicate returns 'Nothing' on the first character of input.
307-- predicate returns 'Nothing' on the first character of input.
341-- /Note/: Because this parser does not fail, do not use it with
309-- /Note/: Because this parser does not fail, do not use it with
342−-- combinators such as 'Control.Applicative.many', because such
310+-- combinators such as 'many', because such parsers loop until a
343−-- parsers loop until a failure occurs. Careless use will thus result
311+-- failure occurs. Careless use will thus result in an infinite loop.
344−-- in an infinite loop.
345scan :: s -> (s -> Char -> Maybe s) -> Parser Text
312scan :: s -> (s -> Char -> Maybe s) -> Parser Text
346−scan = scan_ $ \_ chunks -> return $! concatReverse chunks
313+scan = scan_ $ \_ chunks ->
316+ xs -> return . T.concat . reverse $ xs
347{-# INLINE scan #-}
317{-# INLINE scan #-}
349-- | Like 'scan', but generalized to return the final state of the
319-- | Like 'scan', but generalized to return the final state of the
350-- scanner.
320-- scanner.
351runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
321runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
352−runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
322+runScanner = scan_ $ \s xs -> return (T.concat (reverse xs), s)
353{-# INLINE runScanner #-}
323{-# INLINE runScanner #-}
355-- | Consume input as long as the predicate returns 'True', and return
325-- | Consume input as long as the predicate returns 'True', and return
@@ -360,16 +330,13 @@ runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
360-- 'True' or if there is no input left.
330-- 'True' or if there is no input left.
361takeWhile1 :: (Char -> Bool) -> Parser Text
331takeWhile1 :: (Char -> Bool) -> Parser Text
362takeWhile1 p = do
332takeWhile1 p = do
363− (`when` demandInput) =<< endOfChunk
333+ (`when` demandInput) =<< T.null <$> get
364− h <- T.takeWhile p <$> get
334+ (h,t) <- T.span p <$> get
366− when (size' == 0) $ fail "takeWhile1"
335+ when (T.null h) $ fail "takeWhile1"
367− advance size'
336+ put t
368− eoc <- endOfChunk
337+ if T.null t
369− if eoc
338+ then (h<>) `fmap` takeWhile p
370− then takeWhileAcc p [h]
371 else return h
339 else return h
372−{-# INLINE takeWhile1 #-}
374-- | Match any character in a set.
341-- | Match any character in a set.
@@ -411,31 +378,27 @@ notChar c = satisfy (/= c) <?> "not " ++ show c
411-- end of input has been reached. Does not consume any input.
378-- end of input has been reached. Does not consume any input.
413-- /Note/: Because this parser does not fail, do not use it with
380-- /Note/: Because this parser does not fail, do not use it with
414−-- combinators such as 'Control.Applicative.many', because such
381+-- combinators such as 'many', because such parsers loop until a
415−-- parsers loop until a failure occurs. Careless use will thus result
382+-- failure occurs. Careless use will thus result in an infinite loop.
416−-- in an infinite loop.
417peekChar :: Parser (Maybe Char)
383peekChar :: Parser (Maybe Char)
418−peekChar = T.Parser $ \t pos more _lose succ ->
384+peekChar = T.Parser $ \i0 a0 m0 _kf ks ->
419− case () of
385+ if T.null (unI i0)
420− _| pos < lengthOf t ->
421− let T.Iter !c _ = Buf.iter t (fromPos pos)
422− in succ t pos more (Just c)
423− | more == Complete ->
386+ then if m0 == Complete
424− succ t pos more Nothing
387+ then ks i0 a0 m0 Nothing
425− | otherwise ->
388+ else let ks' i a m = let !c = unsafeHead (unI i)
426− let succ' t' pos' more' =
427− let T.Iter !c _ = Buf.iter t' (fromPos pos')
428− in succ t' pos' more' (Just c)
389+ in ks i a m (Just c)
429− lose' t' pos' more' = succ t' pos' more' Nothing
390+ kf' i a m = ks i a m Nothing
430− in prompt t pos more lose' succ'
391+ in prompt i0 a0 m0 kf' ks'
392+ else let !c = unsafeHead (unI i0)
393+ in ks i0 a0 m0 (Just c)
431{-# INLINE peekChar #-}
394{-# INLINE peekChar #-}
433-- | Match any character, to perform lookahead. Does not consume any
396-- | Match any character, to perform lookahead. Does not consume any
434-- input, but will fail if end of input has been reached.
397-- input, but will fail if end of input has been reached.
435peekChar' :: Parser Char
398peekChar' :: Parser Char
436peekChar' = do
399peekChar' = do
437− (_,s) <- ensure 1
400+ s <- ensure 1
438− return $! T.unsafeHead s
401+ return $! unsafeHead s
439{-# INLINE peekChar' #-}
402{-# INLINE peekChar' #-}
441-- | Match either a single newline character @\'\\n\'@, or a carriage
404-- | Match either a single newline character @\'\\n\'@, or a carriage
@@ -445,105 +408,23 @@ endOfLine = (char '\n' >> return ()) <|> (string "\r\n" >> return ())
446-- | Terminal failure continuation.
409-- | Terminal failure continuation.
447failK :: Failure a
410failK :: Failure a
448−failK t (Pos pos) _more stack msg = Fail (Buf.dropWord16 pos t) stack msg
411+failK i0 _a0 _m0 stack msg = Fail (unI i0) stack msg
449{-# INLINE failK #-}
412{-# INLINE failK #-}
451-- | Terminal success continuation.
414-- | Terminal success continuation.
452successK :: Success a a
415successK :: Success a a
453−successK t (Pos pos) _more a = Done (Buf.dropWord16 pos t) a
416+successK i0 _a0 _m0 a = Done (unI i0) a
454{-# INLINE successK #-}
417{-# INLINE successK #-}
456-- | Run a parser.
419-- | Run a parser.
457parse :: Parser a -> Text -> Result a
420parse :: Parser a -> Text -> Result a
458−parse m s = runParser m (buffer s) 0 Incomplete failK successK
421+parse m s = runParser m (I s) mempty Incomplete failK successK
459{-# INLINE parse #-}
422{-# INLINE parse #-}
461-- | Run a parser that cannot be resupplied via a 'Partial' result.
424-- | 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')
470parseOnly :: Parser a -> Text -> Either String a
425parseOnly :: Parser a -> Text -> Either String a
471−parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of
426+parseOnly m s = case runParser m (I s) mempty Complete failK successK of
472− Fail _ [] err -> Left err
473− Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err)
427+ Fail _ _ err -> Left err
474− Done _ a -> Right a
428+ Done _ a -> Right a
475− _ -> error "parseOnly: impossible error!"
429+ _ -> error "parseOnly: impossible error!"
476{-# INLINE parseOnly #-}
430{-# 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