@@ -1,15 +1,14 @@
1−{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes,
2− RecordWildCards #-}
1+{-# LANGUAGE BangPatterns, OverloadedStrings, RecordWildCards #-}
32-- |
43-- Module : Data.Attoparsec.ByteString.Internal
5−-- Copyright : Bryan O'Sullivan 2007-2015
4+-- Copyright : Bryan O'Sullivan 2007-2014
65-- License : BSD3
76--
87-- Maintainer : bos@serpentine.com
98-- Stability : experimental
109-- Portability : unknown
1110--
12−-- Simple, efficient parser combinators for 'ByteString' strings,
11+-- Simple, efficient parser combinators for 'B.ByteString' strings,
1312-- loosely based on the Parsec library.
1413
1514module Data.Attoparsec.ByteString.Internal
@@ -47,7 +46,7 @@ module Data.Attoparsec.ByteString.Internal
4746 -- * Efficient string handling
4847 , skipWhile
4948 , string
50− , stringCI
49+ , stringTransform
5150 , take
5251 , scan
5352 , runScanner
@@ -66,19 +65,14 @@ module Data.Attoparsec.ByteString.Internal
6665 , atEnd
6766 ) where
6867
69−#if !MIN_VERSION_base(4,8,0)
70−import Control.Applicative ((<$>))
71−#endif
72−import Control.Applicative ((<|>))
68+import Control.Applicative ((<|>), (<$>))
7369import Control.Monad (when)
7470import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)
7571import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)
7672import Data.Attoparsec.Combinator ((<?>))
77−import Data.Attoparsec.Internal
7873import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)
7974import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)
8075import Data.ByteString (ByteString)
81−import Data.List (intercalate)
8276import Data.Word (Word8)
8377import Foreign.ForeignPtr (withForeignPtr)
8478import Foreign.Ptr (castPtr, minusPtr, plusPtr)
@@ -92,10 +86,10 @@ import qualified Data.ByteString.Internal as B
9286import qualified Data.ByteString.Lazy as L
9387import qualified Data.ByteString.Unsafe as B
9488
95−type Parser = T.Parser ByteString
96−type Result = IResult ByteString
97−type Failure r = T.Failure ByteString Buffer r
98−type Success a r = T.Success ByteString Buffer a r
89+type Parser = T.Parser B.ByteString Buffer
90+type Result = IResult B.ByteString Buffer
91+type Failure r = T.Failure B.ByteString Buffer r
92+type Success a r = T.Success B.ByteString Buffer a r
9993
10094-- | The parser @satisfy p@ succeeds for any byte for which the
10195-- predicate @p@ returns 'True'. Returns the byte that is actually
@@ -141,15 +135,22 @@ storable = hack undefined
141135 hack :: Storable b => b -> Parser b
142136 hack dummy = do
143137 (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy)
144− return . inlinePerformIO . withForeignPtr fp $ \p ->
138+ return . B.inlinePerformIO . withForeignPtr fp $ \p ->
145139 peek (castPtr $ p `plusPtr` o)
146140
147−-- | Consume exactly @n@ bytes of input.
148−take :: Int -> Parser ByteString
149−take n0 = do
141+-- | Consume @n@ bytes of input, but succeed only if the predicate
142+-- returns 'True'.
143+takeWith :: Int -> (B.ByteString -> Bool) -> Parser B.ByteString
144+takeWith n0 p = do
150145 let n = max n0 0
151146 s <- ensure n
152− advance n >> return s
147+ if p s
148+ then advance n >> return s
149+ else fail "takeWith"
150+
151+-- | Consume exactly @n@ bytes of input.
152+take :: Int -> Parser B.ByteString
153+take n = takeWith n (const True)
153154{-# INLINE take #-}
154155
155156-- | @string s@ parses a sequence of bytes that identically match
@@ -165,62 +166,16 @@ take n0 = do
165166--
166167-- The reason for its failure is that the first branch is a
167168-- partial match, and will consume the letters @\'f\'@ and @\'o\'@
168−-- before failing. In attoparsec, the above parser will /succeed/ on
169+-- before failing. In Attoparsec, the above parser will /succeed/ on
169170-- that input, because the failed first branch will consume nothing.
170−string :: ByteString -> Parser ByteString
171−string s = string_ (stringSuspended id) id s
171+string :: B.ByteString -> Parser B.ByteString
172+string s = takeWith (B.length s) (==s)
172173{-# INLINE string #-}
173174
174−-- ASCII-specific but fast, oh yes.
175−toLower :: Word8 -> Word8
176−toLower w | w >= 65 && w <= 90 = w + 32
177− | otherwise = w
178−
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 #-}
184−
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 ->
190− let n = B.length s
191− s = f s0
192− in if lengthAtLeast pos n t
193− then let t' = substring pos (Pos n) t
194− in if s == f 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_ #-}
202−
203−stringSuspended :: (ByteString -> ByteString)
204− -> ByteString -> ByteString -> Buffer -> Pos -> More
205− -> Failure r
206− -> Success ByteString r
207− -> Result 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' ->
211− let m = B.length s
212− s' = f s'0
213− n = B.length s'
214− in if n >= m
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"
175+stringTransform :: (B.ByteString -> B.ByteString) -> B.ByteString
176+ -> Parser B.ByteString
177+stringTransform f s = takeWith (B.length s) ((==f s) . f)
178+{-# INLINE stringTransform #-}
224179
225180-- | Skip past input for as long as the predicate returns 'True'.
226181skipWhile :: (Word8 -> Bool) -> Parser ()
@@ -228,8 +183,11 @@ skipWhile p = go
228183 where
229184 go = do
230185 t <- B8.takeWhile p <$> get
231− continue <- inputSpansChunks (B.length t)
232− when continue go
186+ advance (B.length t)
187+ eoc <- endOfChunk
188+ when eoc $ do
189+ input <- wantInput
190+ when input go
233191{-# INLINE skipWhile #-}
234192
235193-- | Consume input as long as the predicate returns 'False'
@@ -242,7 +200,7 @@ skipWhile p = go
242200-- combinators such as 'Control.Applicative.many', because such
243201-- parsers loop until a failure occurs. Careless use will thus result
244202-- in an infinite loop.
245−takeTill :: (Word8 -> Bool) -> Parser ByteString
203+takeTill :: (Word8 -> Bool) -> Parser B.ByteString
246204takeTill p = takeWhile (not . p)
247205{-# INLINE takeTill #-}
248206
@@ -256,27 +214,23 @@ takeTill p = takeWhile (not . p)
256214-- combinators such as 'Control.Applicative.many', because such
257215-- parsers loop until a failure occurs. Careless use will thus result
258216-- in an infinite loop.
259−takeWhile :: (Word8 -> Bool) -> Parser ByteString
260−takeWhile p = do
261− s <- B8.takeWhile p <$> get
262− continue <- inputSpansChunks (B.length s)
263− if continue
264− then takeWhileAcc p [s]
265− else return s
266−{-# INLINE takeWhile #-}
267−
268−takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString
269−takeWhileAcc p = go
217+takeWhile :: (Word8 -> Bool) -> Parser B.ByteString
218+takeWhile p = (B.concat . reverse) `fmap` go []
270219 where
271220 go acc = do
272221 s <- B8.takeWhile p <$> get
273− continue <- inputSpansChunks (B.length s)
274− if continue
275− then go (s:acc)
276− else return $ concatReverse (s:acc)
277−{-# INLINE takeWhileAcc #-}
222+ advance (B.length s)
223+ eoc <- endOfChunk
224+ if eoc
225+ then do
226+ input <- wantInput
227+ if input
228+ then go (s:acc)
229+ else return (s:acc)
230+ else return (s:acc)
231+{-# INLINE takeWhile #-}
278232
279−takeRest :: Parser [ByteString]
233+takeRest :: Parser [B.ByteString]
280234takeRest = go []
281235 where
282236 go acc = do
@@ -289,7 +243,7 @@ takeRest = go []
289243 else return (reverse acc)
290244
291245-- | Consume all remaining input and return it as a single string.
292−takeByteString :: Parser ByteString
246+takeByteString :: Parser B.ByteString
293247takeByteString = B.concat `fmap` takeRest
294248
295249-- | Consume all remaining input and return it as a single string.
@@ -298,7 +252,7 @@ takeLazyByteString = L.fromChunks `fmap` takeRest
298252
299253data T s = T {-# UNPACK #-} !Int s
300254
301−scan_ :: (s -> [ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s)
255+scan_ :: (s -> [B.ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s)
302256 -> Parser r
303257scan_ f s0 p = go [] s0
304258 where
@@ -319,9 +273,14 @@ scan_ f s0 p = go [] s0
319273 bs <- get
320274 let T i s' = inlinePerformIO $ scanner bs
321275 !h = B.unsafeTake i bs
322− continue <- inputSpansChunks i
323− if continue
324− then go (h:acc) s'
276+ advance i
277+ eoc <- endOfChunk
278+ if eoc
279+ then do
280+ input <- wantInput
281+ if input
282+ then go (h:acc) s'
283+ else f s' (h:acc)
325284 else f s' (h:acc)
326285{-# INLINE scan_ #-}
327286
@@ -337,14 +296,17 @@ scan_ f s0 p = go [] s0
337296-- combinators such as 'Control.Applicative.many', because such
338297-- parsers loop until a failure occurs. Careless use will thus result
339298-- in an infinite loop.
340−scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString
341−scan = scan_ $ \_ chunks -> return $! concatReverse chunks
299+scan :: s -> (s -> Word8 -> Maybe s) -> Parser B.ByteString
300+scan = scan_ $ \_ chunks ->
301+ case chunks of
302+ [x] -> return x
303+ xs -> return $! B.concat $ reverse xs
342304{-# INLINE scan #-}
343305
344306-- | Like 'scan', but generalized to return the final state of the
345307-- scanner.
346−runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)
347−runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
308+runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (B.ByteString, s)
309+runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s)
348310{-# INLINE runScanner #-}
349311
350312-- | Consume input as long as the predicate returns 'True', and return
@@ -353,7 +315,7 @@ runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s)
353315-- This parser requires the predicate to succeed on at least one byte
354316-- of input: it will fail if the predicate never returns 'True' or if
355317-- there is no input left.
356−takeWhile1 :: (Word8 -> Bool) -> Parser ByteString
318+takeWhile1 :: (Word8 -> Bool) -> Parser B.ByteString
357319takeWhile1 p = do
358320 (`when` demandInput) =<< endOfChunk
359321 s <- B8.takeWhile p <$> get
@@ -364,9 +326,8 @@ takeWhile1 p = do
364326 advance len
365327 eoc <- endOfChunk
366328 if eoc
367− then takeWhileAcc p [s]
329+ then (s<>) `fmap` takeWhile p
368330 else return s
369−{-# INLINE takeWhile1 #-}
370331
371332-- | Match any byte in a set.
372333--
@@ -420,7 +381,7 @@ peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ ->
420381 | more == Complete ->
421382 succ t pos more Nothing
422383 | otherwise ->
423− let succ' t' pos' more' = let !w = Buf.unsafeIndex t' pos_
384+ let succ' t' pos' more' = let !w = Buf.unsafeIndex t pos_
424385 in succ t' pos' more' (Just w)
425386 lose' t' pos' more' = succ t' pos' more' Nothing
426387 in prompt t pos more lose' succ'
@@ -452,25 +413,16 @@ successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a
452413{-# INLINE successK #-}
453414
454415-- | Run a parser.
455−parse :: Parser a -> ByteString -> Result a
416+parse :: Parser a -> B.ByteString -> Result a
456417parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK
457418{-# INLINE parse #-}
458419
459420-- | Run a parser that cannot be resupplied via a 'Partial' result.
460−--
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:
464−--
465−-- @
466−--'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput')
467−-- @
468−parseOnly :: Parser a -> ByteString -> Either String a
421+parseOnly :: Parser a -> B.ByteString -> Either String a
469422parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of
470− Fail _ [] err -> Left err
471− Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err)
472− Done _ a -> Right a
473− _ -> error "parseOnly: impossible error!"
423+ Fail _ _ err -> Left err
424+ Done _ a -> Right a
425+ _ -> error "parseOnly: impossible error!"
474426{-# INLINE parseOnly #-}
475427
476428get :: Parser ByteString
@@ -483,16 +435,6 @@ endOfChunk = T.Parser $ \t pos more _lose succ ->
483435 succ t pos more (fromPos pos == Buf.length t)
484436{-# INLINE endOfChunk #-}
485437
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 #-}
495−
496438advance :: Int -> Parser ()
497439advance n = T.Parser $ \t pos more _lose succ ->
498440 succ t (pos + Pos n) more ()
@@ -517,8 +459,54 @@ ensure n = T.Parser $ \t pos more lose succ ->
517459 then succ t pos more (substring pos (Pos n) t)
518460 -- The uncommon case is kept out-of-line to reduce code size:
519461 else ensureSuspended n t pos more lose succ
462+-- Non-recursive so the bounds check can be inlined:
520463{-# INLINE ensure #-}
521464
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 ->
472+ if B.null s
473+ then lose t pos Complete
474+ else succ (Buf.pappend t s) pos Incomplete
475+
476+-- | Immediately demand more input via a 'Partial' continuation
477+-- result.
478+demandInput :: Parser ()
479+demandInput = T.Parser $ \t pos more lose succ ->
480+ case more of
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'
485+
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 ->
491+ case () of
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 #-}
498+
499+-- | Match only if all input has been consumed.
500+endOfInput :: Parser ()
501+endOfInput = T.Parser $ \t pos more lose succ ->
502+ case () of
503+ _| lengthAtLeast pos 1 t -> lose t pos more [] "endOfInput"
504+ | more == Complete -> succ t pos more ()
505+ | otherwise ->
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'
509+
522510-- | Return both the result of a parse and the portion of the input
523511-- that was consumed while it was being parsed.
524512match :: Parser a -> Parser (ByteString, a)
@@ -527,6 +515,12 @@ match p = T.Parser $ \t pos more lose succ ->
527515 succ t' pos' more' (substring pos (pos'-pos) t', a)
528516 in runParser p t pos more lose succ'
529517
518+-- | Return an indication of whether the end of input has been
519+-- reached.
520+atEnd :: Parser Bool
521+atEnd = not <$> wantInput
522+{-# INLINE atEnd #-}
523+
530524lengthAtLeast :: Pos -> Int -> Buffer -> Bool
531525lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n
532526{-# INLINE lengthAtLeast #-}