@@ -22,6 +22,7 @@ module Data.ParserCombinators.Attoparsec.Incremental
2222 , Result(..)
2323 , parse
2424 , parseWith
25+ , parseTest
2526
2627 , (<?>)
2728 , takeWhile
@@ -35,14 +36,7 @@ module Data.ParserCombinators.Attoparsec.Incremental
3536 , notWord8
3637 , anyWord8
3738
38− , many1
3939 , skipWhile
40− , skipMany
41− , skipMany1
42− , sepBy
43− , sepBy1
44− , manyTill
45− , count
4640
4741 , yield
4842 ) where
@@ -59,6 +53,7 @@ import Prelude hiding (takeWhile)
5953data S = S {-# UNPACK #-} !S.ByteString -- ^ first chunk of input
6054 L.ByteString -- ^ rest of input
6155 [L.ByteString] -- ^ input acquired during backtracks
56+ !Bool -- ^ have we hit EOF yet?
6257 {-# UNPACK #-} !Int -- ^ failure depth
6358
6459-- | The result of a partial parse
@@ -73,9 +68,10 @@ data Result a = Failed String
7368 -- parse pass more data to the given continuation
7469
7570instance (Show a) => Show (Result a) where
76− show (Failed err) = "Failed " ++ err
77− show (Done rest rs) = "Done " ++ show rest ++ " " ++ show rs
78− show (Partial _) = "Partial"
71+ show (Failed err) = "Failed " ++ show err
72+ show (Done L.Empty rs) = "Done Empty " ++ show rs
73+ show (Done rest rs) = "Done (" ++ show rest ++ ") " ++ show rs
74+ show (Partial _) = "Partial"
7975
8076-- | This is the internal version of the above. This is the type which is
8177-- actually used by the code, as it has the extra information needed
@@ -86,9 +82,9 @@ data IResult a = IFailed S String
8682 | IPartial (L.ByteString -> IResult a)
8783
8884instance Show (IResult a) where
89− show (IFailed _ err) = "IFailed " ++ err
90− show (IDone _ _) = "IDone"
91− show (IPartial _) = "IPartial"
85+ show (IFailed _ err) = "IFailed " ++ show err
86+ show (IDone _ _) = "IDone"
87+ show (IPartial _) = "IPartial"
9288
9389newtype Parser r a = Parser {
9490 unParser :: S -> (a -> S -> IResult r) -> IResult r
@@ -115,7 +111,7 @@ zero = fail ""
115111cutContinuation :: (a -> S -> IResult r) -> a -> S -> IResult r
116112cutContinuation k v s =
117113 case k v s of
118− IFailed (S lb i adds failDepth) err -> IFailed (S lb i adds (failDepth - 1)) err
114+ IFailed (S lb i adds eof failDepth) err -> IFailed (S lb i adds eof (failDepth - 1)) err
119115 x -> x
120116
121117appL :: L.ByteString -> L.ByteString -> L.ByteString
@@ -125,17 +121,17 @@ appL xs ys = xs `L.append` ys
125121
126122plus :: Parser r a -> Parser r a -> Parser r a
127123plus p1 p2 =
128− Parser $ \(S sb lb adds failDepth) k ->
124+ Parser $ \(S sb lb adds eof failDepth) k ->
129125 let
130− filt f@(IFailed (S _ _ adds' failDepth') _)
126+ filt f@(IFailed (S _ _ adds' eof' failDepth') _)
131127 | failDepth' == failDepth + 1 =
132128 let lb' = lb `appL` L.concat (reverse adds')
133− in unParser p2 (S sb lb' (adds' ++ adds) failDepth) k
129+ in unParser p2 (S sb lb' (adds' ++ adds) eof' failDepth) k
134130 | otherwise = f
135131 filt (IPartial cont) = IPartial (filt . cont)
136132 filt v@(IDone _ _) = v
137133 in
138− filt $ unParser p1 (S sb lb [] (failDepth + 1)) (cutContinuation k)
134+ filt $ unParser p1 (S sb lb [] eof (failDepth + 1)) (cutContinuation k)
139135
140136instance Functor (Parser r) where
141137 fmap f m = Parser $ \s cont -> unParser m s (cont . f)
@@ -152,34 +148,39 @@ p <?> msg =
152148 ok -> ok
153149
154150initState :: L.ByteString -> S
155−initState (L.Chunk sb lb) = S sb lb [] 0
156−initState _ = S S.empty L.empty [] 0
151+initState (L.Chunk sb lb) = S sb lb [] False 0
152+initState _ = S S.empty L.empty [] False 0
157153
158−mkState :: L.ByteString -> [L.ByteString] -> Int -> S
159−mkState bs adds failDepth =
154+mkState :: L.ByteString -> [L.ByteString] -> Bool -> Int -> S
155+mkState bs adds eof failDepth =
160156 case bs of
161− L.Empty -> S S.empty L.empty adds failDepth
162− L.Chunk sb lb -> S sb lb adds failDepth
157+ L.Empty -> S S.empty L.empty adds eof failDepth
158+ L.Chunk sb lb -> S sb lb adds eof failDepth
163159
164160addX :: L.ByteString -> [L.ByteString] -> [L.ByteString]
165161addX s adds | L.null s = adds
166162 | otherwise = s : adds
167163
168164yield :: Parser r ()
169−yield = Parser $ \(S sb lb adds failDepth) k ->
170− IPartial $ \s -> k () (S sb (lb `appL` s) (addX s adds) failDepth)
165+yield = Parser $ \(S sb lb adds eof failDepth) k ->
166+ IPartial $ \s -> k () (S sb (lb `appL` s) (addX s adds) eof failDepth)
167+
168+continue :: (S -> IResult r) -> Parser r a
169+ -> (a -> S -> IResult r) -> S -> IResult r
170+continue onEOF p k (S _sb _lb adds eof failDepth) =
171+ if eof
172+ then onEOF (S S.empty L.empty adds True failDepth)
173+ else IPartial $ \s -> let st = contState s adds failDepth
174+ in unParser p st k
171175
172176takeWith :: (L.ByteString -> (L.ByteString, L.ByteString))
173177 -> Parser r L.ByteString
174178takeWith splitf =
175− Parser $ \(S sb lb adds failDepth) k ->
179+ Parser $ \st@(S sb lb adds eof failDepth) k ->
176180 let (left,rest) = splitf (sb +: lb)
177− in case rest of
178− L.Empty -> IPartial $ \s ->
179− let s' = mkState s (addX s adds) failDepth
180− k' a = k (appL left a)
181− in unParser (takeWith splitf) s' k'
182− L.Chunk h t -> k left (S h t adds failDepth)
181+ in if L.null rest
182+ then continue (k left) (takeWith splitf) (k . appL left) st
183+ else k left (mkState rest adds eof failDepth)
183184
184185takeWhile :: (Word8 -> Bool) -> Parser r L.ByteString
185186takeWhile = takeWith . L.span
@@ -189,56 +190,53 @@ takeTill = takeWith . L.break
189190
190191takeCount :: Int -> Parser r L.ByteString
191192takeCount = tc . fromIntegral where
192− tc (!n) = Parser $ \(S sb lb adds failDepth) k ->
193− let (h,t) = L.splitAt n (sb +: lb)
194− l = L.length h
195− in if L.length h == n
196− then k h (mkState t adds failDepth)
197− else IPartial $ \s ->
198− let st = mkState s (addX s adds) failDepth
199− k' a = k (appL h a)
200− in unParser (tc (n - l)) st k'
193+ tc n = Parser $ \st@(S sb lb adds eof failDepth) k ->
194+ let (h,t) = L.splitAt n (sb +: lb)
195+ l = L.length h
196+ in if L.length h == n
197+ then k h (mkState t adds eof failDepth)
198+ else continue (`IFailed` "takeCount: EOF")
199+ (tc (n - l)) (k . appL h) st
201200
202201string :: L.ByteString -> Parser r L.ByteString
203202string s =
204− Parser $ \st@(S sb lb adds failDepth) k ->
203+ Parser $ \st@(S sb lb adds eof failDepth) k ->
205204 case L.splitAt (L.length s) (sb +: lb) of
206205 (h,t)
207− | h == s -> k s (mkState t adds failDepth)
206+ | h == s -> k s (mkState t adds eof failDepth)
208207 (h,L.Empty)
209208 | h `L.isPrefixOf` s ->
210− IPartial $ \s' ->
211− let st' = mkState s' (addX s' adds) failDepth
212− k' a = k (appL h a)
213− r' = L.drop (L.length h) s
214− in unParser (string r') st' k'
209+ continue (`IFailed` "string: EOF")
210+ (string (L.drop (L.length h) s))
211+ (k . appL h)
212+ st
215213 _ -> IFailed st "string failed to match"
216214
217−emptyState = S S.empty L.empty
215+contState :: L.ByteString -> [L.ByteString] -> Int -> S
216+contState s adds failDepth
217+ | L.null s = S S.empty L.empty [] True failDepth
218+ | otherwise = mkState s (addX s adds) False failDepth
218219
219220satisfy :: (Word8 -> Bool) -> Parser r Word8
220221satisfy p =
221− Parser $ \st@(S sb lb adds failDepth) k ->
222+ Parser $ \st@(S sb lb adds eof failDepth) k ->
222223 case S.uncons sb of
223− Just (w, sb') | p w -> k w (S sb' lb adds failDepth)
224+ Just (w, sb') | p w -> k w (S sb' lb adds eof failDepth)
224225 | otherwise -> IFailed st "failed to match"
225226 Nothing -> case L.uncons lb of
226− Just (w, lb') | p w -> k w (mkState lb' adds failDepth)
227+ Just (w, lb') | p w -> k w (mkState lb' adds eof failDepth)
227228 | 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
229+ Nothing -> continue (`IFailed` "satisfy: EOF")
230+ (satisfy p) k st
233231
234232pushBack :: L.ByteString -> Parser r ()
235233pushBack bs =
236− Parser $ \(S sb lb adds failDepth) k ->
237− k () (mkState (bs `appL` (sb +: lb)) adds failDepth)
234+ Parser $ \(S sb lb adds eof failDepth) k ->
235+ k () (mkState (bs `appL` (sb +: lb)) adds eof failDepth)
238236
239237toplevelTranslate :: IResult a -> Result a
240238toplevelTranslate (IFailed _ err) = Failed err
241−toplevelTranslate (IDone (S sb lb _ _) value) = Done (sb +: lb) value
239+toplevelTranslate (IDone (S sb lb _ _ _) value) = Done (sb +: lb) value
242240toplevelTranslate (IPartial k) = Partial $ toplevelTranslate . k
243241
244242terminalContinuation :: a -> S -> IResult a
@@ -255,5 +253,8 @@ parseWith refill p s =
255253 Partial k -> k <$> refill
256254 ok -> pure ok
257255
256+parseTest :: (Show r) => Parser r r -> L.ByteString -> IO ()
257+parseTest p s = print (parse p s)
258+
258259#define PARSER Parser r
259260#include "Word8Boilerplate.h"