@@ -13,6 +13,7 @@ module Network.Wai.Parse
1313#if TEST
1414 , Bound (..)
1515 , findBound
16+ , sinkTillBound
1617#endif
1718 ) where
1819
@@ -281,3 +282,39 @@ findBound b bs = go [0..S.length bs - 1]
281282 mismatch (x:xs) (y:ys)
282283 | S.index b x == S.index bs y = mismatch xs ys
283284 | otherwise = True
285+
286+sinkTillBound :: S.ByteString
287+ -> Source'
288+ -> (x -> S.ByteString -> IO x)
289+ -> x
290+ -> IO (x, Bool, Source')
291+sinkTillBound bound (bs, msrc) iter seed = do
292+ case findBound bound bs of
293+ NoBound -> do
294+ seed' <- iter seed bs
295+ case msrc of
296+ Nothing -> return (seed', False, (S.empty, Nothing))
297+ Just (Source src) -> do
298+ res <- src
299+ case res of
300+ Nothing -> return (seed', False, (S.empty, Nothing))
301+ Just (bs', src') ->
302+ sinkTillBound bound (bs', Just src') iter seed'
303+ FoundBound before after -> do
304+ seed' <- iter seed before
305+ return (seed', True, (after, msrc))
306+ PartialBound -> do
307+ -- not so efficient, but hopefully the unusual case
308+ case msrc of
309+ Nothing -> do
310+ seed' <- iter seed bs
311+ return (seed', False, (S.empty, Nothing))
312+ Just (Source src) -> do
313+ res <- src
314+ case res of
315+ Nothing -> do
316+ seed' <- iter seed bs
317+ return (seed', False, (S.empty, Nothing))
318+ Just (bs', src') -> do
319+ let bs'' = bs `S.append` bs'
320+ sinkTillBound bound (bs'', Just src') iter seed