@@ -3,7 +3,7 @@
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 2007-2014
7-- License : BSD3
7-- License : BSD3
9-- Maintainer : bos@serpentine.com
9-- Maintainer : bos@serpentine.com
@@ -65,18 +65,16 @@ module Data.Attoparsec.Text.Internal
68−import Control.Applicative ((<|>), (<$>), pure, (*>))
68+import Control.Applicative ((<|>), (<$>))
69import Control.Monad (when)
69import Control.Monad (when)
70import Data.Attoparsec.Combinator ((<?>))
70import Data.Attoparsec.Combinator ((<?>))
71−import Data.Attoparsec.Internal
72import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
71import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
73import qualified Data.Attoparsec.Text.Buffer as Buf
72import qualified Data.Attoparsec.Text.Buffer as Buf
74import Data.Attoparsec.Text.Buffer (Buffer, buffer)
73import Data.Attoparsec.Text.Buffer (Buffer, buffer)
75−import Data.Char (isAsciiUpper, isAsciiLower, toUpper, toLower)
74+import Data.Char (chr, ord)
76−import Data.List (intercalate)
77import Data.String (IsString(..))
75import Data.String (IsString(..))
78import Data.Text.Internal (Text(..))
76import Data.Text.Internal (Text(..))
79−import Prelude hiding (getChar, succ, take, takeWhile)
77+import Prelude hiding (getChar, length, succ, take, takeWhile)
80import qualified Data.Attoparsec.Internal.Types as T
78import qualified Data.Attoparsec.Internal.Types as T
81import qualified Data.Attoparsec.Text.FastSet as Set
79import qualified Data.Attoparsec.Text.FastSet as Set
82import qualified Data.Text as T
80import qualified Data.Text as T
@@ -160,46 +158,9 @@ take n = takeWith (max n 0) (const True)
160-- before failing. In attoparsec, the above parser will /succeed/ on
158-- before failing. In attoparsec, the above parser will /succeed/ on
161-- that input, because the failed first branch will consume nothing.
159-- that input, because the failed first branch will consume nothing.
162string :: Text -> Parser Text
160string :: Text -> Parser Text
163−string s = string_ (stringSuspended id) id s
161+string s = takeWith (T.length s) (==s)
164{-# INLINE string #-}
162{-# 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.
164-- | Satisfy a literal string, ignoring case.
205-- Note: this function is currently quite inefficient. Unicode case
166-- Note: this function is currently quite inefficient. Unicode case
@@ -222,23 +183,30 @@ stringCI s = go 0
223-- | Satisfy a literal string, ignoring case for characters in the ASCII range.
184-- | Satisfy a literal string, ignoring case for characters in the ASCII range.
224asciiCI :: Text -> Parser Text
185asciiCI :: Text -> Parser Text
225−asciiCI s = fmap fst $ match $ T.foldr ((*>) . asciiCharCI) (pure ()) s
186+asciiCI input = do
188+ if asciiToLower t == s
189+ then advance k >> return t
193+ s = asciiToLower input
195+ -- convert letters in the ASCII range to lower-case
196+ asciiToLower = T.map f
198+ offset = ord 'a' - ord 'A'
199+ f c | 'A' <= c && c <= 'Z' = chr (ord c + offset)
226{-# INLINE asciiCI #-}
201{-# 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'.
203-- | Skip past input for as long as the predicate returns 'True'.
236skipWhile :: (Char -> Bool) -> Parser ()
204skipWhile :: (Char -> Bool) -> Parser ()
237skipWhile p = go
205skipWhile p = go
240 t <- T.takeWhile p <$> get
208 t <- T.takeWhile p <$> get
241− continue <- inputSpansChunks (size t)
209+ continue <- inputSpansChunks (length t)
242 when continue go
210 when continue go
243{-# INLINE skipWhile #-}
211{-# INLINE skipWhile #-}
@@ -267,25 +235,14 @@ takeTill p = takeWhile (not . p)
267-- parsers loop until a failure occurs. Careless use will thus result
235-- parsers loop until a failure occurs. Careless use will thus result
268-- in an infinite loop.
236-- in an infinite loop.
269takeWhile :: (Char -> Bool) -> Parser Text
237takeWhile :: (Char -> Bool) -> Parser Text
270−takeWhile p = do
238+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
240 go acc = do
283 h <- T.takeWhile p <$> get
241 h <- T.takeWhile p <$> get
284− continue <- inputSpansChunks (size h)
242+ continue <- inputSpansChunks (length h)
285 if continue
243 if continue
286 then go (h:acc)
244 then go (h:acc)
287− else return $ concatReverse (h:acc)
245+ else return (h:acc)
288−{-# INLINE takeWhileAcc #-}
290takeRest :: Parser [Text]
247takeRest :: Parser [Text]
291takeRest = go []
248takeRest = go []
@@ -295,7 +252,7 @@ takeRest = go []
298− advance (size s)
255+ advance (length s)
299 go (s:acc)
256 go (s:acc)
300 else return (reverse acc)
257 else return (reverse acc)
@@ -308,7 +265,7 @@ takeLazyText :: Parser L.Text
308takeLazyText = L.fromChunks `fmap` takeRest
265takeLazyText = L.fromChunks `fmap` takeRest
310data Scan s = Continue s
267data Scan s = Continue s
311− | Finished s {-# UNPACK #-} !Int Text
268+ | Finished {-# UNPACK #-} !Int Text
313scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
270scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
314scan_ f s0 p = go [] s0
271scan_ f s0 p = go [] s0
@@ -317,17 +274,17 @@ scan_ f s0 p = go [] s0
317 case T.uncons t of
274 case T.uncons t of
318 Just (c,t') -> case p s c of
275 Just (c,t') -> case p s c of
319 Just s' -> scanner s' (n+1) t'
276 Just s' -> scanner s' (n+1) t'
320− Nothing -> Finished s n t
277+ Nothing -> Finished n t
321 Nothing -> Continue s
278 Nothing -> Continue s
322 go acc s = do
279 go acc s = do
323 input <- get
280 input <- get
324 case scanner s 0 input of
281 case scanner s 0 input of
325− Continue s' -> do continue <- inputSpansChunks (size input)
282+ Continue s' -> do continue <- inputSpansChunks (length input)
326 if continue
283 if continue
327 then go (input : acc) s'
284 then go (input : acc) s'
328 else f s' (input : acc)
285 else f s' (input : acc)
329− Finished s' n t -> do advance (size input - size t)
286+ Finished n t -> do advance (length input - length t)
330− f s' (T.take n input : acc)
287+ f s (T.take n input : acc)
331{-# INLINE scan_ #-}
288{-# INLINE scan_ #-}
333-- | A stateful scanner. The predicate consumes and transforms a
290-- | A stateful scanner. The predicate consumes and transforms a
@@ -343,13 +300,16 @@ scan_ f s0 p = go [] s0
343-- parsers loop until a failure occurs. Careless use will thus result
300-- parsers loop until a failure occurs. Careless use will thus result
344-- in an infinite loop.
301-- in an infinite loop.
345scan :: s -> (s -> Char -> Maybe s) -> Parser Text
302scan :: s -> (s -> Char -> Maybe s) -> Parser Text
346−scan = scan_ $ \_ chunks -> return $! concatReverse chunks
303+scan = scan_ $ \_ chunks ->
306+ xs -> return . T.concat . reverse $ xs
347{-# INLINE scan #-}
307{-# INLINE scan #-}
349-- | Like 'scan', but generalized to return the final state of the
309-- | Like 'scan', but generalized to return the final state of the
350-- scanner.
310-- scanner.
351runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
311runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
352−runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
312+runScanner = scan_ $ \s xs -> return (T.concat (reverse xs), s)
353{-# INLINE runScanner #-}
313{-# INLINE runScanner #-}
355-- | Consume input as long as the predicate returns 'True', and return
315-- | Consume input as long as the predicate returns 'True', and return
@@ -362,14 +322,13 @@ takeWhile1 :: (Char -> Bool) -> Parser Text
362takeWhile1 p = do
322takeWhile1 p = do
363 (`when` demandInput) =<< endOfChunk
323 (`when` demandInput) =<< endOfChunk
364 h <- T.takeWhile p <$> get
324 h <- T.takeWhile p <$> get
365− let size' = size h
325+ let len = length h
366− when (size' == 0) $ fail "takeWhile1"
326+ when (len == 0) $ fail "takeWhile1"
367− advance size'
327+ advance len
368 eoc <- endOfChunk
328 eoc <- endOfChunk
370− then takeWhileAcc p [h]
330+ then (h<>) `fmap` takeWhile p
371 else return h
331 else return h
372−{-# INLINE takeWhile1 #-}
374-- | Match any character in a set.
333-- | Match any character in a set.
@@ -469,10 +428,9 @@ parse m s = runParser m (buffer s) 0 Incomplete failK successK
470parseOnly :: Parser a -> Text -> Either String a
429parseOnly :: Parser a -> Text -> Either String a
471parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of
430parseOnly m s = case runParser m (buffer s) 0 Complete failK successK of
472− Fail _ [] err -> Left err
473− Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err)
431+ Fail _ _ err -> Left err
474− Done _ a -> Right a
432+ Done _ a -> Right a
475− _ -> error "parseOnly: impossible error!"
433+ _ -> error "parseOnly: impossible error!"
476{-# INLINE parseOnly #-}
434{-# INLINE parseOnly #-}
478get :: Parser Text
436get :: Parser Text
@@ -517,8 +475,53 @@ ensure n = T.Parser $ \t pos more lose succ ->
517 Just n' -> succ t pos more (n', substring pos n' t)
475 Just n' -> succ t pos more (n', substring pos n' t)
518 -- The uncommon case is kept out-of-line to reduce code size:
476 -- The uncommon case is kept out-of-line to reduce code size:
519 Nothing -> ensureSuspended n t pos more lose succ
477 Nothing -> ensureSuspended n t pos more lose succ
478+-- Non-recursive so the bounds check can be inlined:
520{-# INLINE ensure #-}
479{-# INLINE ensure #-}
481+-- | Ask for input. If we receive any, pass it to a success
482+-- continuation, otherwise to a failure continuation.
483+prompt :: Buffer -> Pos -> More
484+ -> (Buffer -> Pos -> More -> IResult Text r)
485+ -> (Buffer -> Pos -> More -> IResult Text r)
487+prompt t pos _more lose succ = Partial $ \s ->
489+ then lose t pos Complete
490+ else succ (Buf.pappend t s) pos Incomplete
492+-- | Immediately demand more input via a 'Partial' continuation
494+demandInput :: Parser ()
495+demandInput = T.Parser $ \t pos more lose succ ->
497+ Complete -> lose t pos more [] "not enough input"
498+ _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input"
499+ succ' t' pos' more' = succ t' pos' more' ()
500+ in prompt t pos more lose' succ'
502+-- | This parser always succeeds. It returns 'True' if any input is
503+-- available either immediately or on demand, and 'False' if the end
504+-- of all input has been reached.
505+wantInput :: Parser Bool
506+wantInput = T.Parser $ \t pos more _lose succ ->
508+ _ | pos < lengthOf t -> succ t pos more True
509+ | more == Complete -> succ t pos more False
510+ | otherwise -> let lose' t' pos' more' = succ t' pos' more' False
511+ succ' t' pos' more' = succ t' pos' more' True
512+ in prompt t pos more lose' succ'
514+-- | Match only if all input has been consumed.
515+endOfInput :: Parser ()
516+endOfInput = T.Parser $ \t pos more lose succ ->
518+ _| pos < lengthOf t -> lose t pos more [] "endOfInput"
519+ | more == Complete -> succ t pos more ()
521+ let lose' t' pos' more' _ctx _msg = succ t' pos' more' ()
522+ succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput"
523+ in runParser demandInput t pos more lose' succ'
522-- | Return both the result of a parse and the portion of the input
525-- | Return both the result of a parse and the portion of the input
523-- that was consumed while it was being parsed.
526-- that was consumed while it was being parsed.
524match :: Parser a -> Parser (Text, a)
527match :: Parser a -> Parser (Text, a)
@@ -527,8 +530,12 @@ match p = T.Parser $ \t pos more lose succ ->
527 (substring pos (pos'-pos) t', a)
530 (substring pos (pos'-pos) t', a)
528 in runParser p t pos more lose succ'
531 in runParser p t pos more lose succ'
530−-- | Ensure that at least @n@ code points of input are available.
533+-- | Return an indication of whether the end of input has been
531−-- Returns the number of words consumed while traversing.
534+-- reached.
536+atEnd = not <$> wantInput
532lengthAtLeast :: Pos -> Int -> Buffer -> Maybe Pos
539lengthAtLeast :: Pos -> Int -> Buffer -> Maybe Pos
533lengthAtLeast pos n t = go 0 (fromPos pos)
540lengthAtLeast pos n t = go 0 (fromPos pos)
534 where go i !p
541 where go i !p
@@ -545,5 +552,5 @@ substring (Pos pos) (Pos n) = Buf.substring pos n
545lengthOf :: Buffer -> Pos
552lengthOf :: Buffer -> Pos
546lengthOf = Pos . Buf.length
553lengthOf = Pos . Buf.length
548−size :: Text -> Pos
555+length :: Text -> Pos
549−size (Text _ _ l) = Pos l
556+length = Pos . T.length