@@ -1,14 +1,15 @@
1−{-# LANGUAGE BangPatterns, OverloadedStrings, RecordWildCards #-}
1+{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes,
3-- Module : Data.Attoparsec.ByteString.Internal
4-- Module : Data.Attoparsec.ByteString.Internal
4−-- Copyright : Bryan O'Sullivan 2007-2014
5+-- Copyright : Bryan O'Sullivan 2007-2015
5-- License : BSD3
6-- License : BSD3
7-- Maintainer : bos@serpentine.com
8-- Maintainer : bos@serpentine.com
8-- Stability : experimental
9-- Stability : experimental
9-- Portability : unknown
10-- Portability : unknown
11−-- Simple, efficient parser combinators for 'B.ByteString' strings,
12+-- Simple, efficient parser combinators for 'ByteString' strings,
12-- loosely based on the Parsec library.
13-- loosely based on the Parsec library.
14module Data.Attoparsec.ByteString.Internal
15module Data.Attoparsec.ByteString.Internal
@@ -46,7 +47,7 @@ module Data.Attoparsec.ByteString.Internal
46 -- * Efficient string handling
47 -- * Efficient string handling
47 , skipWhile
48 , skipWhile
49− , stringTransform
50+ , stringCI
52 , runScanner
53 , runScanner
@@ -65,14 +66,19 @@ module Data.Attoparsec.ByteString.Internal
69+#if !MIN_VERSION_base(4,8,0)
68−import Control.Applicative ((<|>), (<$>))
70+import Control.Applicative ((<$>))
72+import Control.Applicative ((<|>))
69import Control.Monad (when)
73import Control.Monad (when)
70import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)
74import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)
71import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
75import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
72import Data.Attoparsec.Combinator ((<?>))
76import Data.Attoparsec.Combinator ((<?>))
77+import Data.Attoparsec.Internal
73import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
78import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
74import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
79import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
75import Data.ByteString (ByteString)
80import Data.ByteString (ByteString)
81+import Data.List (intercalate)
76import Data.Word (Word8)
82import Data.Word (Word8)
77import Foreign.ForeignPtr (withForeignPtr)
83import Foreign.ForeignPtr (withForeignPtr)
78import Foreign.Ptr (castPtr, minusPtr, plusPtr)
84import Foreign.Ptr (castPtr, minusPtr, plusPtr)
@@ -86,10 +92,10 @@ import qualified Data.ByteString.Internal as B
86import qualified Data.ByteString.Lazy as L
92import qualified Data.ByteString.Lazy as L
87import qualified Data.ByteString.Unsafe as B
93import qualified Data.ByteString.Unsafe as B
89−type Parser = T.Parser B.ByteString Buffer
95+type Parser = T.Parser ByteString
90−type Result = IResult B.ByteString Buffer
96+type Result = IResult ByteString
91−type Failure r = T.Failure B.ByteString Buffer r
97+type Failure r = T.Failure ByteString Buffer r
92−type Success a r = T.Success B.ByteString Buffer a r
98+type Success a r = T.Success ByteString Buffer a r
94-- | The parser @satisfy p@ succeeds for any byte for which the
100-- | The parser @satisfy p@ succeeds for any byte for which the
95-- predicate @p@ returns 'True'. Returns the byte that is actually
101-- predicate @p@ returns 'True'. Returns the byte that is actually
@@ -135,22 +141,15 @@ storable = hack undefined
135 hack :: Storable b => b -> Parser b
141 hack :: Storable b => b -> Parser b
136 hack dummy = do
142 hack dummy = do
137 (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy)
143 (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy)
138− return . B.inlinePerformIO . withForeignPtr fp $ \p ->
144+ return . inlinePerformIO . withForeignPtr fp $ \p ->
139 peek (castPtr $ p `plusPtr` o)
145 peek (castPtr $ p `plusPtr` o)
141−-- | Consume @n@ bytes of input, but succeed only if the predicate
147+-- | Consume exactly @n@ bytes of input.
143−takeWith :: Int -> (B.ByteString -> Bool) -> Parser B.ByteString
148+take :: Int -> Parser ByteString
144−takeWith n0 p = do
149+take n0 = do
145 let n = max n0 0
150 let n = max n0 0
146 s <- ensure n
151 s <- ensure n
148− then advance n >> return s
152+ advance n >> return s
149− else fail "takeWith"
151−-- | Consume exactly @n@ bytes of input.
152−take :: Int -> Parser B.ByteString
153−take n = takeWith n (const True)
154{-# INLINE take #-}
153{-# INLINE take #-}
156-- | @string s@ parses a sequence of bytes that identically match
155-- | @string s@ parses a sequence of bytes that identically match
@@ -166,16 +165,62 @@ take n = takeWith n (const True)
167-- The reason for its failure is that the first branch is a
166-- The reason for its failure is that the first branch is a
168-- partial match, and will consume the letters @\'f\'@ and @\'o\'@
167-- partial match, and will consume the letters @\'f\'@ and @\'o\'@
169−-- before failing. In Attoparsec, the above parser will /succeed/ on
168+-- before failing. In attoparsec, the above parser will /succeed/ on
170-- that input, because the failed first branch will consume nothing.
169-- that input, because the failed first branch will consume nothing.
171−string :: B.ByteString -> Parser B.ByteString
170+string :: ByteString -> Parser ByteString
172−string s = takeWith (B.length s) (==s)
171+string s = string_ (stringSuspended id) id s
173{-# INLINE string #-}
172{-# INLINE string #-}
175−stringTransform :: (B.ByteString -> B.ByteString) -> B.ByteString
174+-- ASCII-specific but fast, oh yes.
176− -> Parser B.ByteString
175+toLower :: Word8 -> Word8
177−stringTransform f s = takeWith (B.length s) ((==f s) . f)
176+toLower w | w >= 65 && w <= 90 = w + 32
178−{-# INLINE stringTransform #-}
177+ | otherwise = w
179+-- | Satisfy a literal string, ignoring case.
180+stringCI :: ByteString -> Parser ByteString
181+stringCI s = string_ (stringSuspended lower) lower s
182+ where lower = B8.map toLower
183+{-# INLINE stringCI #-}
185+string_ :: (forall r. ByteString -> ByteString -> Buffer -> Pos -> More
186+ -> Failure r -> Success ByteString r -> Result r)
187+ -> (ByteString -> ByteString)
188+ -> ByteString -> Parser ByteString
189+string_ suspended f s0 = T.Parser $ \t pos more lose succ ->
192+ in if lengthAtLeast pos n t
193+ then let t' = substring pos (Pos n) t
195+ then succ t (pos + Pos n) more t'
196+ else lose t pos more [] "string"
197+ else let t' = Buf.unsafeDrop (fromPos pos) t
198+ in if f t' `B.isPrefixOf` s
199+ then suspended s (B.drop (B.length t') s) t pos more lose succ
200+ else lose t pos more [] "string"
201+{-# INLINE string_ #-}
203+stringSuspended :: (ByteString -> ByteString)
204+ -> ByteString -> ByteString -> Buffer -> Pos -> More
206+ -> Success ByteString r
208+stringSuspended f s0 s t pos more lose succ =
209+ runParser (demandInput_ >>= go) t pos more lose succ
210+ where go s'0 = T.Parser $ \t' pos' more' lose' succ' ->
215+ then if B.unsafeTake m s' == s
216+ then let o = Pos (B.length s0)
217+ in succ' t' (pos' + o) more'
218+ (substring pos' o t')
219+ else lose' t' pos' more' [] "string"
220+ else if s' == B.unsafeTake n s
221+ then stringSuspended f s0 (B.unsafeDrop n s)
222+ t' pos' more' lose' succ'
223+ else lose' t' pos' more' [] "string"
180-- | Skip past input for as long as the predicate returns 'True'.
225-- | Skip past input for as long as the predicate returns 'True'.
181skipWhile :: (Word8 -> Bool) -> Parser ()
226skipWhile :: (Word8 -> Bool) -> Parser ()
@@ -183,11 +228,8 @@ skipWhile p = go
185 t <- B8.takeWhile p <$> get
230 t <- B8.takeWhile p <$> get
186− advance (B.length t)
231+ continue <- inputSpansChunks (B.length t)
187− eoc <- endOfChunk
232+ when continue go
191{-# INLINE skipWhile #-}
233{-# INLINE skipWhile #-}
193-- | Consume input as long as the predicate returns 'False'
235-- | Consume input as long as the predicate returns 'False'
@@ -200,7 +242,7 @@ skipWhile p = go
200-- combinators such as 'Control.Applicative.many', because such
242-- combinators such as 'Control.Applicative.many', because such
201-- parsers loop until a failure occurs. Careless use will thus result
243-- parsers loop until a failure occurs. Careless use will thus result
202-- in an infinite loop.
244-- in an infinite loop.
203−takeTill :: (Word8 -> Bool) -> Parser B.ByteString
245+takeTill :: (Word8 -> Bool) -> Parser ByteString
204takeTill p = takeWhile (not . p)
246takeTill p = takeWhile (not . p)
205{-# INLINE takeTill #-}
247{-# INLINE takeTill #-}
@@ -214,23 +256,27 @@ takeTill p = takeWhile (not . p)
214-- combinators such as 'Control.Applicative.many', because such
256-- combinators such as 'Control.Applicative.many', because such
215-- parsers loop until a failure occurs. Careless use will thus result
257-- parsers loop until a failure occurs. Careless use will thus result
216-- in an infinite loop.
258-- in an infinite loop.
217−takeWhile :: (Word8 -> Bool) -> Parser B.ByteString
259+takeWhile :: (Word8 -> Bool) -> Parser ByteString
218−takeWhile p = (B.concat . reverse) `fmap` go []
260+takeWhile p = do
261+ s <- B8.takeWhile p <$> get
262+ continue <- inputSpansChunks (B.length s)
264+ then takeWhileAcc p [s]
266+{-# INLINE takeWhile #-}
268+takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString
220 go acc = do
271 go acc = do
221 s <- B8.takeWhile p <$> get
272 s <- B8.takeWhile p <$> get
222− advance (B.length s)
273+ continue <- inputSpansChunks (B.length s)
223− eoc <- endOfChunk
274+ if continue
228− then go (s:acc)
275+ then go (s:acc)
229− else return (s:acc)
276+ else return $ concatReverse (s:acc)
230− else return (s:acc)
277+{-# INLINE takeWhileAcc #-}
231−{-# INLINE takeWhile #-}
233−takeRest :: Parser [B.ByteString]
279+takeRest :: Parser [ByteString]
234takeRest = go []
280takeRest = go []
236 go acc = do
282 go acc = do
@@ -243,7 +289,7 @@ takeRest = go []
243 else return (reverse acc)
289 else return (reverse acc)
245-- | Consume all remaining input and return it as a single string.
291-- | Consume all remaining input and return it as a single string.
246−takeByteString :: Parser B.ByteString
292+takeByteString :: Parser ByteString
247takeByteString = B.concat `fmap` takeRest
293takeByteString = B.concat `fmap` takeRest
249-- | Consume all remaining input and return it as a single string.
295-- | Consume all remaining input and return it as a single string.
@@ -252,7 +298,7 @@ takeLazyByteString = L.fromChunks `fmap` takeRest
253data T s = T {-# UNPACK #-} !Int s
299data T s = T {-# UNPACK #-} !Int s
255−scan_ :: (s -> [B.ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s)
301+scan_ :: (s -> [ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s)
256 -> Parser r
302 -> Parser r
257scan_ f s0 p = go [] s0
303scan_ f s0 p = go [] s0
@@ -273,14 +319,9 @@ scan_ f s0 p = go [] s0
273 bs <- get
319 bs <- get
274 let T i s' = inlinePerformIO $ scanner bs
320 let T i s' = inlinePerformIO $ scanner bs
275 !h = B.unsafeTake i bs
321 !h = B.unsafeTake i bs
276− advance i
322+ continue <- inputSpansChunks i
277− eoc <- endOfChunk
323+ if continue
282− then go (h:acc) s'
324+ then go (h:acc) s'
284 else f s' (h:acc)
325 else f s' (h:acc)
285{-# INLINE scan_ #-}
326{-# INLINE scan_ #-}
@@ -296,17 +337,14 @@ scan_ f s0 p = go [] s0
296-- combinators such as 'Control.Applicative.many', because such
337-- combinators such as 'Control.Applicative.many', because such
297-- parsers loop until a failure occurs. Careless use will thus result
338-- parsers loop until a failure occurs. Careless use will thus result
298-- in an infinite loop.
339-- in an infinite loop.
299−scan :: s -> (s -> Word8 -> Maybe s) -> Parser B.ByteString
340+scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString
300−scan = scan_ $ \_ chunks ->
341+scan = scan_ $ \_ chunks -> return $! concatReverse chunks
303− xs -> return $! B.concat $ reverse xs
304{-# INLINE scan #-}
342{-# INLINE scan #-}
306-- | Like 'scan', but generalized to return the final state of the
344-- | Like 'scan', but generalized to return the final state of the
307-- scanner.
345-- scanner.
308−runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (B.ByteString, s)
346+runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
309−runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s)
347+runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
310{-# INLINE runScanner #-}
348{-# INLINE runScanner #-}
312-- | Consume input as long as the predicate returns 'True', and return
350-- | Consume input as long as the predicate returns 'True', and return
@@ -315,7 +353,7 @@ runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s)
315-- This parser requires the predicate to succeed on at least one byte
353-- This parser requires the predicate to succeed on at least one byte
316-- of input: it will fail if the predicate never returns 'True' or if
354-- of input: it will fail if the predicate never returns 'True' or if
317-- there is no input left.
355-- there is no input left.
318−takeWhile1 :: (Word8 -> Bool) -> Parser B.ByteString
356+takeWhile1 :: (Word8 -> Bool) -> Parser ByteString
319takeWhile1 p = do
357takeWhile1 p = do
320 (`when` demandInput) =<< endOfChunk
358 (`when` demandInput) =<< endOfChunk
321 s <- B8.takeWhile p <$> get
359 s <- B8.takeWhile p <$> get
@@ -326,8 +364,9 @@ takeWhile1 p = do
326 advance len
364 advance len
327 eoc <- endOfChunk
365 eoc <- endOfChunk
329− then (s<>) `fmap` takeWhile p
367+ then takeWhileAcc p [s]
330 else return s
368 else return s
369+{-# INLINE takeWhile1 #-}
332-- | Match any byte in a set.
371-- | Match any byte in a set.
@@ -381,7 +420,7 @@ peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ ->
381 | more == Complete ->
420 | more == Complete ->
382 succ t pos more Nothing
421 succ t pos more Nothing
383 | otherwise ->
422 | otherwise ->
384− let succ' t' pos' more' = let !w = Buf.unsafeIndex t pos_
423+ let succ' t' pos' more' = let !w = Buf.unsafeIndex t' pos_
385 in succ t' pos' more' (Just w)
424 in succ t' pos' more' (Just w)
386 lose' t' pos' more' = succ t' pos' more' Nothing
425 lose' t' pos' more' = succ t' pos' more' Nothing
387 in prompt t pos more lose' succ'
426 in prompt t pos more lose' succ'
@@ -413,16 +452,25 @@ successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a
413{-# INLINE successK #-}
452{-# INLINE successK #-}
415-- | Run a parser.
454-- | Run a parser.
416−parse :: Parser a -> B.ByteString -> Result a
455+parse :: Parser a -> ByteString -> Result a
417parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK
456parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK
418{-# INLINE parse #-}
457{-# INLINE parse #-}
420-- | Run a parser that cannot be resupplied via a 'Partial' result.
459-- | Run a parser that cannot be resupplied via a 'Partial' result.
461+-- This function does not force a parser to consume all of its input.
462+-- Instead, any residual input will be discarded. To force a parser
463+-- to consume all of its input, use something like this:
466+--'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput')
421−parseOnly :: Parser a -> B.ByteString -> Either String a
468+parseOnly :: Parser a -> ByteString -> Either String a
422parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of
469parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of
470+ Fail _ [] err -> Left err
423− Fail _ _ err -> Left err
471+ Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err)
424− Done _ a -> Right a
472+ Done _ a -> Right a
425− _ -> error "parseOnly: impossible error!"
473+ _ -> error "parseOnly: impossible error!"
426{-# INLINE parseOnly #-}
474{-# INLINE parseOnly #-}
428get :: Parser ByteString
476get :: Parser ByteString
@@ -435,6 +483,16 @@ endOfChunk = T.Parser $ \t pos more _lose succ ->
435 succ t pos more (fromPos pos == Buf.length t)
483 succ t pos more (fromPos pos == Buf.length t)
436{-# INLINE endOfChunk #-}
484{-# INLINE endOfChunk #-}
486+inputSpansChunks :: Int -> Parser Bool
487+inputSpansChunks i = T.Parser $ \t pos_ more _lose succ ->
488+ let pos = pos_ + Pos i
489+ in if fromPos pos < Buf.length t || more == Complete
490+ then succ t pos more False
491+ else let lose' t' pos' more' = succ t' pos' more' False
492+ succ' t' pos' more' = succ t' pos' more' True
493+ in prompt t pos more lose' succ'
494+{-# INLINE inputSpansChunks #-}
438advance :: Int -> Parser ()
496advance :: Int -> Parser ()
439advance n = T.Parser $ \t pos more _lose succ ->
497advance n = T.Parser $ \t pos more _lose succ ->
440 succ t (pos + Pos n) more ()
498 succ t (pos + Pos n) more ()
@@ -459,54 +517,8 @@ ensure n = T.Parser $ \t pos more lose succ ->
459 then succ t pos more (substring pos (Pos n) t)
517 then succ t pos more (substring pos (Pos n) t)
460 -- The uncommon case is kept out-of-line to reduce code size:
518 -- The uncommon case is kept out-of-line to reduce code size:
461 else ensureSuspended n t pos more lose succ
519 else ensureSuspended n t pos more lose succ
462−-- Non-recursive so the bounds check can be inlined:
463{-# INLINE ensure #-}
520{-# INLINE ensure #-}
465−-- | Ask for input. If we receive any, pass it to a success
466−-- continuation, otherwise to a failure continuation.
467−prompt :: Buffer -> Pos -> More
468− -> (Buffer -> Pos -> More -> IResult ByteString Buffer r)
469− -> (Buffer -> Pos -> More -> IResult ByteString Buffer r)
470− -> IResult ByteString Buffer r
471−prompt t pos _more lose succ = Partial $ \s ->
473− then lose t pos Complete
474− else succ (t <> buffer s) pos Incomplete
476−-- | Immediately demand more input via a 'Partial' continuation
478−demandInput :: Parser ()
479−demandInput = T.Parser $ \t pos more lose succ ->
481− Complete -> lose t pos more [] "not enough input"
482− _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input"
483− succ' t' pos' more' = succ t' pos' more' ()
484− in prompt t pos more lose' succ'
486−-- | This parser always succeeds. It returns 'True' if any input is
487−-- available either immediately or on demand, and 'False' if the end
488−-- of all input has been reached.
489−wantInput :: Parser Bool
490−wantInput = T.Parser $ \t pos more _lose succ ->
492− _ | lengthAtLeast pos 1 t -> succ t pos more True
493− | more == Complete -> succ t pos more False
494− | otherwise -> let lose' t' pos' more' = succ t' pos' more' False
495− succ' t' pos' more' = succ t' pos' more' True
496− in prompt t pos more lose' succ'
497−{-# INLINE wantInput #-}
499−-- | Match only if all input has been consumed.
500−endOfInput :: Parser ()
501−endOfInput = T.Parser $ \t pos more lose succ ->
503− _| lengthAtLeast pos 1 t -> lose t pos more [] "endOfInput"
504− | more == Complete -> succ t pos more ()
506− let lose' t' pos' more' _ctx _msg = succ t' pos' more' ()
507− succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput"
508− in runParser demandInput t pos more lose' succ'
510-- | Return both the result of a parse and the portion of the input
522-- | Return both the result of a parse and the portion of the input
511-- that was consumed while it was being parsed.
523-- that was consumed while it was being parsed.
512match :: Parser a -> Parser (ByteString, a)
524match :: Parser a -> Parser (ByteString, a)
@@ -515,12 +527,6 @@ match p = T.Parser $ \t pos more lose succ ->
515 succ t' pos' more' (substring pos (pos'-pos) t', a)
527 succ t' pos' more' (substring pos (pos'-pos) t', a)
516 in runParser p t pos more lose succ'
528 in runParser p t pos more lose succ'
518−-- | Return an indication of whether the end of input has been
521−atEnd = not <$> wantInput
524lengthAtLeast :: Pos -> Int -> Buffer -> Bool
530lengthAtLeast :: Pos -> Int -> Buffer -> Bool
525lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n
531lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n
526{-# INLINE lengthAtLeast #-}
532{-# INLINE lengthAtLeast #-}