@@ -21,6 +21,7 @@ module Data.ParserCombinators.Attoparsec.Incremental
2121 Parser
2222 , Result(..)
2323 , parse
24+ , parseWith
2425
2526 , (<?>)
2627 , takeWhile
@@ -57,7 +58,7 @@ import Prelude hiding (takeWhile)
5758
5859data S = S {-# UNPACK #-} !S.ByteString -- ^ first chunk of input
5960 L.ByteString -- ^ rest of input
60− [S.ByteString] -- ^ input acquired during backtracks
61+ [L.ByteString] -- ^ input acquired during backtracks
6162 {-# UNPACK #-} !Int -- ^ failure depth
6263
6364-- | The result of a partial parse
@@ -66,7 +67,7 @@ data Result a = Failed String
6667 | Done L.ByteString a
6768 -- ^ the parse finished and produced the given list of
6869 -- results doing so. Any unparsed data is returned.
69− | Partial (S.ByteString -> Result a)
70+ | Partial (L.ByteString -> Result a)
7071 -- ^ the parse ran out of data before finishing, but produced
7172 -- the given list of results before doing so. To continue the
7273 -- parse pass more data to the given continuation
@@ -82,7 +83,7 @@ instance (Show a) => Show (Result a) where
8283-- type just before giving it to the outside world.
8384data IResult a = IFailed S String
8485 | IDone S a
85− | IPartial (S.ByteString -> IResult a)
86+ | IPartial (L.ByteString -> IResult a)
8687
8788instance Show (IResult a) where
8889 show (IFailed _ err) = "IFailed " ++ err
@@ -128,7 +129,7 @@ plus p1 p2 =
128129 let
129130 filt f@(IFailed (S _ _ adds' failDepth') _)
130131 | failDepth' == failDepth + 1 =
131− let lb' = lb `appL` L.fromChunks (reverse adds')
132+ let lb' = lb `appL` L.concat (reverse adds')
132133 in unParser p2 (S sb lb' (adds' ++ adds) failDepth) k
133134 | otherwise = f
134135 filt (IPartial cont) = IPartial (filt . cont)
@@ -150,26 +151,23 @@ p <?> msg =
150151 IFailed st' _ -> IFailed st' msg
151152 ok -> ok
152153
153−initState :: S.ByteString -> S
154−initState input = S input L.empty [] 0
154+initState :: L.ByteString -> S
155+initState (L.Chunk sb lb) = S sb lb [] 0
156+initState _ = S S.empty L.empty [] 0
155157
156−mkState :: L.ByteString -> [S.ByteString] -> Int -> S
158+mkState :: L.ByteString -> [L.ByteString] -> Int -> S
157159mkState bs adds failDepth =
158160 case bs of
159161 L.Empty -> S S.empty L.empty adds failDepth
160162 L.Chunk sb lb -> S sb lb adds failDepth
161163
162−toLazy :: S.ByteString -> L.ByteString
163−toLazy s | S.null s = L.Empty
164− | otherwise = L.Chunk s L.Empty
165−
166−addX :: S.ByteString -> [S.ByteString] -> [S.ByteString]
167−addX s adds | S.null s = adds
164+addX :: L.ByteString -> [L.ByteString] -> [L.ByteString]
165+addX s adds | L.null s = adds
168166 | otherwise = s : adds
169167
170168yield :: Parser r ()
171169yield = Parser $ \(S sb lb adds failDepth) k ->
172− IPartial $ \s -> k () (S sb (lb `appL` toLazy s) (addX s adds) failDepth)
170+ IPartial $ \s -> k () (S sb (lb `appL` s) (addX s adds) failDepth)
173171
174172takeWith :: (L.ByteString -> (L.ByteString, L.ByteString))
175173 -> Parser r L.ByteString
@@ -178,7 +176,7 @@ takeWith splitf =
178176 let (left,rest) = splitf (sb +: lb)
179177 in case rest of
180178 L.Empty -> IPartial $ \s ->
181− let s' = S s L.empty (addX s adds) failDepth
179+ let s' = mkState s (addX s adds) failDepth
182180 k' a = k (appL left a)
183181 in unParser (takeWith splitf) s' k'
184182 L.Chunk h t -> k left (S h t adds failDepth)
@@ -197,7 +195,7 @@ takeCount = tc . fromIntegral where
197195 in if L.length h == n
198196 then k h (mkState t adds failDepth)
199197 else IPartial $ \s ->
200− let st = S s L.empty (addX s adds) failDepth
198+ let st = mkState s (addX s adds) failDepth
201199 k' a = k (appL h a)
202200 in unParser (tc (n - l)) st k'
203201
@@ -210,21 +208,28 @@ string s =
210208 (h,L.Empty)
211209 | h `L.isPrefixOf` s ->
212210 IPartial $ \s' ->
213− let st' = S s' L.empty (addX s' adds) failDepth
211+ let st' = mkState s' (addX s' adds) failDepth
214212 k' a = k (appL h a)
215213 r' = L.drop (L.length h) s
216214 in unParser (string r') st' k'
217215 _ -> IFailed st "string failed to match"
218216
217+emptyState = S S.empty L.empty
218+
219219satisfy :: (Word8 -> Bool) -> Parser r Word8
220220satisfy p =
221221 Parser $ \st@(S sb lb adds failDepth) k ->
222− case L.uncons (sb +: lb) of
223− Just (w, lb') | p w -> k w (mkState lb' adds failDepth)
222+ case S.uncons sb of
223+ Just (w, sb') | p w -> k w (S sb' lb adds failDepth)
224224 | otherwise -> IFailed st "failed to match"
225− Nothing -> IPartial $ \s ->
226− let st' = S s L.empty (addX s adds) failDepth
227− in unParser (satisfy p) st' k
225+ Nothing -> case L.uncons lb of
226+ Just (w, lb') | p w -> k w (mkState lb' adds failDepth)
227+ | otherwise -> IFailed st "failed to match"
228+ Nothing -> IPartial $ \s ->
229+ let st' = emptyState adds failDepth
230+ in if L.null s
231+ then IFailed st "barf"
232+ else unParser (satisfy p) st' k
228233
229234pushBack :: L.ByteString -> Parser r ()
230235pushBack bs =
@@ -239,9 +244,16 @@ toplevelTranslate (IPartial k) = Partial $ toplevelTranslate . k
239244terminalContinuation :: a -> S -> IResult a
240245terminalContinuation v s = IDone s v
241246
242−parse :: Parser r r -> S.ByteString -> Result r
247+parse :: Parser r r -> L.ByteString -> Result r
243248parse m input =
244249 toplevelTranslate $ unParser m (initState input) terminalContinuation
245250
251+parseWith :: Applicative f => f L.ByteString -> Parser r r -> L.ByteString
252+ -> f (Result r)
253+parseWith refill p s =
254+ case parse p s of
255+ Partial k -> k <$> refill
256+ ok -> pure ok
257+
246258#define PARSER Parser r
247259#include "Word8Boilerplate.h"