@@ -3,7 +3,7 @@
33{-# OPTIONS_GHC -fno-warn-orphans #-}
44-- |
55-- Module : Data.Attoparsec.Text.Internal
6−-- Copyright : Bryan O'Sullivan 2007-2015
6+-- Copyright : Bryan O'Sullivan 2007-2014
77-- License : BSD3
88--
99-- Maintainer : bos@serpentine.com
@@ -65,15 +65,14 @@ module Data.Attoparsec.Text.Internal
6565 , atEnd
6666 ) where
6767
68−import Control.Applicative ((<|>), (<$>), pure, (*>))
68+import Control.Applicative ((<|>), (<$>))
6969import Control.Monad (when)
7070import Data.Attoparsec.Combinator ((<?>))
7171import Data.Attoparsec.Internal
7272import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
7373import qualified Data.Attoparsec.Text.Buffer as Buf
7474import Data.Attoparsec.Text.Buffer (Buffer, buffer)
75−import Data.Char (isAsciiUpper, isAsciiLower, toUpper, toLower)
76−import Data.List (intercalate)
75+import Data.Char (chr, ord)
7776import Data.String (IsString(..))
7877import Data.Text.Internal (Text(..))
7978import Prelude hiding (getChar, succ, take, takeWhile)
@@ -160,46 +159,9 @@ take n = takeWith (max n 0) (const True)
160159-- before failing. In attoparsec, the above parser will /succeed/ on
161160-- that input, because the failed first branch will consume nothing.
162161string :: Text -> Parser Text
163−string s = string_ (stringSuspended id) id s
162+string s = takeWith (T.length s) (==s)
164163{-# INLINE string #-}
165164
166−string_ :: (forall r. Text -> Text -> Buffer -> Pos -> More
167− -> Failure r -> Success Text r -> Result r)
168− -> (Text -> Text)
169− -> Text -> Parser Text
170−string_ suspended f s0 = T.Parser $ \t pos more lose succ ->
171− let s = f s0
172− ft = f (Buf.unbufferAt (fromPos pos) t)
173− in case T.commonPrefixes s ft of
174− Nothing
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_ #-}
184−
185−stringSuspended :: (Text -> Text)
186− -> Text -> Text -> Buffer -> Pos -> More
187− -> Failure r
188− -> Success Text r
189− -> Result r
190−stringSuspended f s000 s0 t0 pos0 more0 lose0 succ0 =
191− runParser (demandInput_ >>= go) t0 pos0 more0 lose0 succ0
192− where
193− go s' = T.Parser $ \t pos more lose succ ->
194− let s = f s'
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"
202−
203165-- | Satisfy a literal string, ignoring case.
204166--
205167-- Note: this function is currently quite inefficient. Unicode case
@@ -222,16 +184,23 @@ stringCI s = go 0
222184
223185-- | Satisfy a literal string, ignoring case for characters in the ASCII range.
224186asciiCI :: Text -> Parser Text
225−asciiCI s = fmap fst $ match $ T.foldr ((*>) . asciiCharCI) (pure ()) s
187+asciiCI input = do
188+ (k,t) <- ensure n
189+ if asciiToLower t == s
190+ then advance k >> return t
191+ else fail "asciiCI"
192+ where
193+ n = T.length input
194+ s = asciiToLower input
195+
196+ -- convert letters in the ASCII range to lower-case
197+ asciiToLower = T.map f
198+ where
199+ offset = ord 'a' - ord 'A'
200+ f c | 'A' <= c && c <= 'Z' = chr (ord c + offset)
201+ | otherwise = c
226202{-# INLINE asciiCI #-}
227203
228−asciiCharCI :: Char -> Parser Char
229−asciiCharCI c
230− | isAsciiUpper c = char c <|> char (toLower c)
231− | isAsciiLower c = char c <|> char (toUpper c)
232− | otherwise = char c
233−{-# INLINE asciiCharCI #-}
234−
235204-- | Skip past input for as long as the predicate returns 'True'.
236205skipWhile :: (Char -> Bool) -> Parser ()
237206skipWhile p = go
@@ -267,25 +236,14 @@ takeTill p = takeWhile (not . p)
267236-- parsers loop until a failure occurs. Careless use will thus result
268237-- in an infinite loop.
269238takeWhile :: (Char -> Bool) -> Parser Text
270−takeWhile p = do
271− h <- T.takeWhile p <$> get
272− continue <- inputSpansChunks (size h)
273− -- only use slow concat path if necessary
274− if continue
275− then takeWhileAcc p [h]
276− else return h
277−{-# INLINE takeWhile #-}
278−
279−takeWhileAcc :: (Char -> Bool) -> [Text] -> Parser Text
280−takeWhileAcc p = go
239+takeWhile p = (T.concat . reverse) `fmap` go []
281240 where
282241 go acc = do
283242 h <- T.takeWhile p <$> get
284243 continue <- inputSpansChunks (size h)
285244 if continue
286245 then go (h:acc)
287− else return $ concatReverse (h:acc)
288−{-# INLINE takeWhileAcc #-}
246+ else return (h:acc)
289247
290248takeRest :: Parser [Text]
291249takeRest = go []
@@ -308,7 +266,7 @@ takeLazyText :: Parser L.Text
308266takeLazyText = L.fromChunks `fmap` takeRest
309267
310268data Scan s = Continue s
311− | Finished s {-# UNPACK #-} !Int Text
269+ | Finished {-# UNPACK #-} !Int Text
312270
313271scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
314272scan_ f s0 p = go [] s0
@@ -317,7 +275,7 @@ scan_ f s0 p = go [] s0
317275 case T.uncons t of
318276 Just (c,t') -> case p s c of
319277 Just s' -> scanner s' (n+1) t'
320− Nothing -> Finished s n t
278+ Nothing -> Finished n t
321279 Nothing -> Continue s
322280 go acc s = do
323281 input <- get
@@ -326,8 +284,8 @@ scan_ f s0 p = go [] s0
326284 if continue
327285 then go (input : acc) s'
328286 else f s' (input : acc)
329− Finished s' n t -> do advance (size input - size t)
330− f s' (T.take n input : acc)
287+ Finished n t -> do advance (size input - size t)
288+ f s (T.take n input : acc)
331289{-# INLINE scan_ #-}
332290
333291-- | A stateful scanner. The predicate consumes and transforms a
@@ -343,13 +301,16 @@ scan_ f s0 p = go [] s0
343301-- parsers loop until a failure occurs. Careless use will thus result
344302-- in an infinite loop.
345303scan :: s -> (s -> Char -> Maybe s) -> Parser Text
346−scan = scan_ $ \_ chunks -> return $! concatReverse chunks
304+scan = scan_ $ \_ chunks ->
305+ case chunks of
306+ [x] -> return x
307+ xs -> return . T.concat . reverse $ xs
347308{-# INLINE scan #-}
348309
349310-- | Like 'scan', but generalized to return the final state of the
350311-- scanner.
351312runScanner :: s -> (s -> Char -> Maybe s) -> Parser (Text, s)
352−runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
313+runScanner = scan_ $ \s xs -> return (T.concat (reverse xs), s)
353314{-# INLINE runScanner #-}
354315
355316-- | Consume input as long as the predicate returns 'True', and return
@@ -367,9 +328,8 @@ takeWhile1 p = do
367328 advance size'
368329 eoc <- endOfChunk
369330 if eoc
370− then takeWhileAcc p [h]
331+ then (h<>) `fmap` takeWhile p
371332 else return h
372−{-# INLINE takeWhile1 #-}
373333
374334-- | Match any character in a set.
375335--
@@ -469,10 +429,9 @@ parse m s = runParser m (buffer s) 0 Incomplete failK successK
469429-- @
470430parseOnly :: Parser a -> Text -> Either String a
471431parseOnly 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)
474− Done _ a -> Right a
475− _ -> error "parseOnly: impossible error!"
432+ Fail _ _ err -> Left err
433+ Done _ a -> Right a
434+ _ -> error "parseOnly: impossible error!"
476435{-# INLINE parseOnly #-}
477436
478437get :: Parser Text
@@ -517,6 +476,7 @@ ensure n = T.Parser $ \t pos more lose succ ->
517476 Just n' -> succ t pos more (n', substring pos n' t)
518477 -- The uncommon case is kept out-of-line to reduce code size:
519478 Nothing -> ensureSuspended n t pos more lose succ
479+-- Non-recursive so the bounds check can be inlined:
520480{-# INLINE ensure #-}
521481
522482-- | Return both the result of a parse and the portion of the input
@@ -527,8 +487,6 @@ match p = T.Parser $ \t pos more lose succ ->
527487 (substring pos (pos'-pos) t', a)
528488 in runParser p t pos more lose succ'
529489
530−-- | Ensure that at least @n@ code points of input are available.
531−-- Returns the number of words consumed while traversing.
532490lengthAtLeast :: Pos -> Int -> Buffer -> Maybe Pos
533491lengthAtLeast pos n t = go 0 (fromPos pos)
534492 where go i !p