@@ -1,4 +1,4 @@
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 #-}
@@ -65,17 +65,14 @@ module Data.Attoparsec.Text.Internal
68−#if !MIN_VERSION_base(4,8,0)
69−import Control.Applicative ((<$>))
68+import Control.Applicative ((<|>), (<$>), pure, (*>))
71−import Control.Applicative ((<|>))
72import Control.Monad (when)
69import Control.Monad (when)
73import Data.Attoparsec.Combinator ((<?>))
70import Data.Attoparsec.Combinator ((<?>))
74import Data.Attoparsec.Internal
71import Data.Attoparsec.Internal
75import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
72import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
76import qualified Data.Attoparsec.Text.Buffer as Buf
73import qualified Data.Attoparsec.Text.Buffer as Buf
77import Data.Attoparsec.Text.Buffer (Buffer, buffer)
74import Data.Attoparsec.Text.Buffer (Buffer, buffer)
78−import Data.Char (chr, ord)
75+import Data.Char (isAsciiUpper, isAsciiLower, toUpper, toLower)
79import Data.List (intercalate)
76import Data.List (intercalate)
80import Data.String (IsString(..))
77import Data.String (IsString(..))
81import Data.Text.Internal (Text(..))
78import Data.Text.Internal (Text(..))
@@ -225,15 +222,16 @@ stringCI s = go 0
226-- | 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.
227asciiCI :: Text -> Parser Text
224asciiCI :: Text -> Parser Text
228−asciiCI s = string_ (stringSuspended asciiToLower) asciiToLower s
225+asciiCI s = fmap fst $ match $ T.foldr ((*>) . asciiCharCI) (pure ()) s
230− asciiToLower = T.map f
232− offset = ord 'a' - ord 'A'
233− f c | 'A' <= c && c <= 'Z' = chr (ord c + offset)
235{-# 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 #-}
237-- | Skip past input for as long as the predicate returns 'True'.
235-- | Skip past input for as long as the predicate returns 'True'.
238skipWhile :: (Char -> Bool) -> Parser ()
236skipWhile :: (Char -> Bool) -> Parser ()
239skipWhile p = go
237skipWhile p = go
@@ -269,14 +267,25 @@ takeTill p = takeWhile (not . p)
269-- parsers loop until a failure occurs. Careless use will thus result
267-- parsers loop until a failure occurs. Careless use will thus result
270-- in an infinite loop.
268-- in an infinite loop.
271takeWhile :: (Char -> Bool) -> Parser Text
269takeWhile :: (Char -> Bool) -> Parser Text
272−takeWhile p = concatReverse `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
274 go acc = do
282 go acc = do
275 h <- T.takeWhile p <$> get
283 h <- T.takeWhile p <$> get
276 continue <- inputSpansChunks (size h)
284 continue <- inputSpansChunks (size h)
277 if continue
285 if continue
278 then go (h:acc)
286 then go (h:acc)
279− else return (h:acc)
287+ else return $ concatReverse (h:acc)
288+{-# INLINE takeWhileAcc #-}
281takeRest :: Parser [Text]
290takeRest :: Parser [Text]
282takeRest = go []
291takeRest = go []
@@ -299,7 +308,7 @@ takeLazyText :: Parser L.Text
299takeLazyText = L.fromChunks `fmap` takeRest
308takeLazyText = L.fromChunks `fmap` takeRest
301data Scan s = Continue s
310data Scan s = Continue s
302− | Finished {-# UNPACK #-} !Int Text
311+ | Finished s {-# UNPACK #-} !Int Text
304scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
313scan_ :: (s -> [Text] -> Parser r) -> s -> (s -> Char -> Maybe s) -> Parser r
305scan_ f s0 p = go [] s0
314scan_ f s0 p = go [] s0
@@ -308,7 +317,7 @@ scan_ f s0 p = go [] s0
308 case T.uncons t of
317 case T.uncons t of
309 Just (c,t') -> case p s c of
318 Just (c,t') -> case p s c of
310 Just s' -> scanner s' (n+1) t'
319 Just s' -> scanner s' (n+1) t'
311− Nothing -> Finished n t
320+ Nothing -> Finished s n t
312 Nothing -> Continue s
321 Nothing -> Continue s
313 go acc s = do
322 go acc s = do
314 input <- get
323 input <- get
@@ -317,8 +326,8 @@ scan_ f s0 p = go [] s0
317 if continue
326 if continue
318 then go (input : acc) s'
327 then go (input : acc) s'
319 else f s' (input : acc)
328 else f s' (input : acc)
320− Finished n t -> do advance (size input - size t)
329+ Finished s' n t -> do advance (size input - size t)
321− f s (T.take n input : acc)
330+ f s' (T.take n input : acc)
322{-# INLINE scan_ #-}
331{-# INLINE scan_ #-}
324-- | A stateful scanner. The predicate consumes and transforms a
333-- | A stateful scanner. The predicate consumes and transforms a
@@ -358,8 +367,9 @@ takeWhile1 p = do
358 advance size'
367 advance size'
359 eoc <- endOfChunk
368 eoc <- endOfChunk
361− then (h<>) `fmap` takeWhile p
370+ then takeWhileAcc p [h]
362 else return h
371 else return h
372+{-# INLINE takeWhile1 #-}
364-- | Match any character in a set.
374-- | Match any character in a set.