git.iko.soy/streamly
on 8a37cd8 help sign in
streamly/src/Streamly/Internal/Data/Parser/ParserD.hs
765 lines 21 kB history raw
1#include "inline.hs"
3-- |
4-- Module : Streamly.Internal.Data.Parser.ParserD
5-- Copyright : (c) 2020 Composewell Technologies
6-- License : BSD-3-Clause
7-- Maintainer : streamly@composewell.com
8-- Stability : experimental
9-- Portability : GHC
10--
11-- Direct style parser implementation with stream fusion.
13module Streamly.Internal.Data.Parser.ParserD
14 (
15 Parser (..)
16 , ParseError (..)
17 , Step (..)
19 -- First order parsers
20 -- * Accumulators
21 , fromFold
22 , toParserK
23 , fromParserK
24 , any
25 , all
26 , yield
27 , yieldM
28 , die
29 , dieM
31 -- * Element parsers
32 , peek
33 , eof
34 , satisfy
36 -- * Sequence parsers
37 --
38 -- Parsers chained in series, if one parser terminates the composition
39 -- terminates. Currently we are using folds to collect the output of the
40 -- parsers but we can use Parsers instead of folds to make the composition
41 -- more powerful. For example, we can do:
42 --
43 -- sliceSepByMax cond n p = sliceBy cond (take n p)
44 -- sliceSepByBetween cond m n p = sliceBy cond (takeBetween m n p)
45 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
46 --
47 -- Grab a sequence of input elements without inspecting them
48 , take
49 -- , takeBetween
50 -- , takeLE -- take -- takeBetween 0 n
51 -- , takeLE1 -- take1 -- takeBetween 1 n
52 , takeEQ -- takeBetween n n
53 , takeGE -- takeBetween n maxBound
55 -- Grab a sequence of input elements by inspecting them
56 , lookAhead
57 , takeWhile
58 , takeWhile1
59 , sliceSepBy
60 , sliceSepByMax
61 -- , sliceSepByBetween
62 , sliceEndWith
63 , sliceBeginWith
64 -- , sliceSepWith
65 --
66 -- , frameSepBy -- parse frames escaped by an escape char/sequence
67 -- , frameEndWith
68 --
69 , wordBy
70 , groupBy
71 , eqBy
72 -- , prefixOf -- match any prefix of a given string
73 -- , suffixOf -- match any suffix of a given string
74 -- , infixOf -- match any substring of a given string
76 -- Second order parsers (parsers using parsers)
77 -- * Binary Combinators
79 -- ** Sequential Applicative
80 , splitWith
81 , split_
83 -- ** Parallel Applicatives
84 , teeWith
85 , teeWithFst
86 , teeWithMin
87 -- , teeTill -- like manyTill but parallel
89 -- ** Sequential Interleaving
90 -- Use two folds, run a primary parser, its rejected values go to the
91 -- secondary parser.
92 , deintercalate
94 -- ** Sequential Alternative
95 , alt
97 -- ** Parallel Alternatives
98 , shortest
99 , longest
100 -- , fastest
102 -- * N-ary Combinators
103 -- ** Sequential Collection
104 , sequence
105 , concatMap
107 -- ** Sequential Repetition
108 , count
109 , countBetween
110 -- , countBetweenTill
112 , many
113 , some
114 , manyTill
116 -- -- ** Special cases
117 -- XXX traditional implmentations of these may be of limited use. For
118 -- example, consider parsing lines separated by "\r\n". The main parser
119 -- will have to detect and exclude the sequence "\r\n" anyway so that we
120 -- can apply the "sep" parser.
121 --
122 -- We can instead implement these as special cases of deintercalate.
123 --
124 -- , endBy
125 -- , sepBy
126 -- , sepEndBy
127 -- , beginBy
128 -- , sepBeginBy
129 -- , sepAroundBy
131 -- -- * Distribution
132 --
133 -- A simple and stupid impl would be to just convert the stream to an array
134 -- and give the array reference to all consumers. The array can be grown on
135 -- demand by any consumer and truncated when nonbody needs it.
136 --
137 -- -- ** Distribute to collection
138 -- -- ** Distribute to repetition
140 -- -- ** Interleaved collection
141 -- Round robin
142 -- Priority based
143 -- -- ** Interleaved repetition
144 -- repeat one parser and when it fails run an error recovery parser
145 -- e.g. to find a key frame in the stream after an error
147 -- ** Collection of Alternatives
148 -- , shortestN
149 -- , longestN
150 -- , fastestN -- first N successful in time
151 -- , choiceN -- first N successful in position
152 , choice -- first successful in position
154 -- -- ** Repeated Alternatives
155 -- , retryMax -- try N times
156 -- , retryUntil -- try until successful
157 -- , retryUntilN -- try until successful n times
158 )
159where
161import Control.Exception (assert)
162import Control.Monad.Catch (MonadCatch, MonadThrow(..))
163import Prelude
164 hiding (any, all, take, takeWhile, sequence, concatMap)
166import Streamly.Internal.Data.Fold.Types (Fold(..))
168import qualified Streamly.Internal.Data.Parser.ParserK.Types as K
169import qualified Streamly.Internal.Data.Zipper as Z
171import Streamly.Internal.Data.Parser.ParserD.Tee
172import Streamly.Internal.Data.Parser.ParserD.Types
173import Streamly.Internal.Data.Strict
175-------------------------------------------------------------------------------
176-- Upgrade folds to parses
177-------------------------------------------------------------------------------
178--
179-- | See 'Streamly.Internal.Data.Parser.fromFold'.
180--
181-- /Internal/
182--
183{-# INLINE fromFold #-}
184fromFold :: Monad m => Fold m a b -> Parser m a b
185fromFold (Fold fstep finitial fextract) = Parser step finitial fextract
187 where
189 step s a = Partial 0 <$> fstep s a
191-------------------------------------------------------------------------------
192-- Convert to and from CPS style parser representation
193-------------------------------------------------------------------------------
195-- | Convert a direct style 'Parser' to a CPS style 'K.Parser'.
196--
197-- /Internal/
198--
199{-# INLINE_LATE toParserK #-}
200toParserK :: MonadCatch m => Parser m a b -> K.Parser m a b
201toParserK (Parser step initial extract) =
202 K.MkParser $ K.parse step initial extract
204-- XXX The CPS style parsers use a zipper buffering the data, if a parserD is
205-- driving the parserK then it would also be buffering the same data. For
206-- ParserD, instead of maintaining the buffer in the common driver, each parser
207-- can have its own buffering and we can return the unconsumed buffer in the
208-- end. That way the zipper is maintained by the parser. If the parser fails
209-- then it has to return all of the input. It is anyway maintained by
210-- intermediate level parsers in a composition, so the only difference would be
211-- that even the leaf levels parsers would do it. If we abstract the zipper
212-- maintainance then it may not be too unwieldy.
213--
214-- | Convert a CPS style 'K.Parser' to a direct style 'Parser'.
215--
216-- /Unimplemented/
217--
218{-# INLINE_LATE fromParserK #-}
219fromParserK :: MonadThrow m => K.Parser m a b -> Parser m a b
220fromParserK parser = Parser step initial extract
222 where
224 initial = return Nothing
226 step Nothing a = do
227 let yieldk _ (K.Done b) = return $ K.Stop b
228 yieldk _ (K.Error e) = return $ K.Failed e
229 r <- K.runParser parser (Z.Zipper [] [] [a]) yieldk
230 case r of
231 -- XXX it should return the leftover count
232 K.Stop b -> return $ Done 0 b
233 K.Failed e -> return $ Error e
234 -- XXX when it pauses it may not have the result available, so it
235 -- is not necessarily Partial. It could be Skip instead.
236 -- Always returning Skip may lead to buffer accumulation.
237 -- XXX In case of Partial the backtrack count is always 0 because
238 -- ParserK would never ask to backtrack. Even for Skip it would
239 -- always be zero. The only place where it may need the ParserD
240 -- buffer is the final "Done" event where it can say there is a
241 -- leftover.
242 K.Partial cont -> return $ Partial 0 $ Just cont
243 step (Just cont) a = do
244 r <- cont (Just a)
245 case r of
246 K.Stop b -> return $ Done 0 b
247 K.Failed e -> return $ Error e
248 K.Partial cont1 -> return $ Partial 0 $ Just cont1
250 extract Nothing = throwM $ ParseError "end of input"
251 extract (Just cont) = K.extractParse cont
253#ifndef DISABLE_FUSION
254{-# RULES "fromParserK/toParserK fusion" [2]
255 forall s. toParserK (fromParserK s) = s #-}
256{-# RULES "toParserK/fromParserK fusion" [2]
257 forall s. fromParserK (toParserK s) = s #-}
258#endif
260-------------------------------------------------------------------------------
261-- Terminating but not failing folds
262-------------------------------------------------------------------------------
263--
264{-# INLINE any #-}
265any :: Monad m => (a -> Bool) -> Parser m a Bool
266any predicate = Parser step initial return
268 where
270 initial = return False
272 step s a = return (if s || predicate a then Done 0 True else Partial 0 False)
274{-# INLINABLE all #-}
275all :: Monad m => (a -> Bool) -> Parser m a Bool
276all predicate = Parser step initial return
278 where
280 initial = return True
282 step s a = return (if s && predicate a then Partial 0 True else Done 0 False)
284-------------------------------------------------------------------------------
285-- Failing Parsers
286-------------------------------------------------------------------------------
288-- | See 'Streamly.Internal.Data.Parser.peek'.
289--
290-- /Internal/
291--
292{-# INLINABLE peek #-}
293peek :: MonadThrow m => Parser m a a
294peek = Parser step initial extract
296 where
298 initial = return ()
300 step () a = return $ Done 1 a
302 extract () = throwM $ ParseError "peek: end of input"
304-- | See 'Streamly.Internal.Data.Parser.eof'.
305--
306-- /Internal/
307--
308{-# INLINABLE eof #-}
309eof :: Monad m => Parser m a ()
310eof = Parser step initial return
312 where
314 initial = return ()
316 step () _ = return $ Error "eof: not at end of input"
318-- | See 'Streamly.Internal.Data.Parser.satisfy'.
319--
320-- /Internal/
321--
322{-# INLINE satisfy #-}
323satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
324satisfy predicate = Parser step initial extract
326 where
328 initial = return ()
330 step () a = return $
331 if predicate a
332 then Done 0 a
333 else Error "satisfy: predicate failed"
335 extract _ = throwM $ ParseError "satisfy: end of input"
337-------------------------------------------------------------------------------
338-- Taking elements
339-------------------------------------------------------------------------------
340--
341-- | See 'Streamly.Internal.Data.Parser.take'.
342--
343-- /Internal/
344--
345{-# INLINE take #-}
346take :: Monad m => Int -> Fold m a b -> Parser m a b
347take n (Fold fstep finitial fextract) = Parser step initial extract
349 where
351 initial = Tuple' 0 <$> finitial
353 step (Tuple' i r) a
354 | i < n = do
355 res <- fstep r a
356 let i1 = i + 1
357 s1 = Tuple' i1 res
358 if i1 < n
359 then return $ Partial 0 s1
360 else Done 0 <$> fextract res
361 | otherwise = Done 1 <$> fextract r
363 extract (Tuple' _ r) = fextract r
365-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
366--
367-- /Internal/
368--
369{-# INLINE takeEQ #-}
370takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
371takeEQ cnt (Fold fstep finitial fextract) = Parser step initial extract
373 where
375 n = max cnt 0
377 initial = Tuple' 0 <$> finitial
379 step (Tuple' i r) a
380 | i < n = do
381 res <- fstep r a
382 let i1 = i + 1
383 s1 = Tuple' i1 res
384 if i1 < n
385 then return (Continue 0 s1)
386 else Done 0 <$> fextract res
387 | otherwise = Done 1 <$> fextract r
389 extract (Tuple' i r) =
390 if n == i
391 then fextract r
392 else throwM $ ParseError err
394 where
396 err =
397 "takeEQ: Expecting exactly " ++ show n
398 ++ " elements, got " ++ show i
400-- | See 'Streamly.Internal.Data.Parser.takeGE'.
401--
402-- /Internal/
403--
404{-# INLINE takeGE #-}
405takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
406takeGE cnt (Fold fstep finitial fextract) = Parser step initial extract
407 where
409 n = max cnt 0
411 initial = Tuple' 0 <$> finitial
413 step (Tuple' i r) a = do
414 res <- fstep r a
415 let i1 = i + 1
416 s1 = Tuple' i1 res
417 return $
418 if i1 < n
419 then Continue 0 s1
420 else Partial 0 s1
422 extract (Tuple' i r) = fextract r >>= f
424 where
426 err =
427 "takeGE: Expecting at least " ++ show n
428 ++ " elements, got only " ++ show i
430 f x =
431 if i >= n
432 then return x
433 else throwM $ ParseError err
435-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
436--
437-- /Internal/
438--
439{-# INLINE takeWhile #-}
440takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
441takeWhile predicate (Fold fstep finitial fextract) =
442 Parser step initial fextract
444 where
446 initial = finitial
448 step s a =
449 if predicate a
450 then Partial 0 <$> fstep s a
451 else Done 1 <$> fextract s
453-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
454--
455-- /Internal/
456--
457{-# INLINE takeWhile1 #-}
458takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
459takeWhile1 predicate (Fold fstep finitial fextract) =
460 Parser step initial extract
462 where
464 initial = return Nothing
466 step Nothing a =
467 if predicate a
468 then do
469 s <- finitial
470 r <- fstep s a
471 return $ Partial 0 (Just r)
472 else return $ Error "takeWhile1: empty"
473 step (Just s) a =
474 if predicate a
475 then do
476 r <- fstep s a
477 return $ Partial 0 (Just r)
478 else do
479 b <- fextract s
480 return $ Done 1 b
482 extract Nothing = throwM $ ParseError "takeWhile1: end of input"
483 extract (Just s) = fextract s
485-- | See 'Streamly.Internal.Data.Parser.sliceSepBy'.
486--
487-- /Internal/
488--
489{-# INLINABLE sliceSepBy #-}
490sliceSepBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
491sliceSepBy predicate (Fold fstep finitial fextract) =
492 Parser step initial fextract
494 where
496 initial = finitial
497 step s a =
498 if not (predicate a)
499 then Partial 0 <$> fstep s a
500 else Done 0 <$> fextract s
502-- | See 'Streamly.Internal.Data.Parser.sliceEndWith'.
503--
504-- /Unimplemented/
505--
506{-# INLINABLE sliceEndWith #-}
507sliceEndWith ::
508 -- Monad m =>
509 (a -> Bool) -> Fold m a b -> Parser m a b
510sliceEndWith = undefined
512-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
513--
514-- /Unimplemented/
515--
516{-# INLINABLE sliceBeginWith #-}
517sliceBeginWith ::
518 -- Monad m =>
519 (a -> Bool) -> Fold m a b -> Parser m a b
520sliceBeginWith = undefined
522-- | See 'Streamly.Internal.Data.Parser.sliceSepByMax'.
523--
524-- /Internal/
525--
526{-# INLINABLE sliceSepByMax #-}
527sliceSepByMax :: Monad m
528 => (a -> Bool) -> Int -> Fold m a b -> Parser m a b
529sliceSepByMax predicate cnt (Fold fstep finitial fextract) =
530 Parser step initial extract
532 where
534 initial = Tuple' 0 <$> finitial
536 step (Tuple' i r) a
537 | not (predicate a) =
538 if i < cnt
539 then do
540 res <- fstep r a
541 let i1 = i + 1
542 s1 = Tuple' i1 res
543 return $ Partial 0 s1
544 else Done 1 <$> fextract r
545 | otherwise = Done 0 <$> fextract r
547 extract (Tuple' _ r) = fextract r
549-- | See 'Streamly.Internal.Data.Parser.wordBy'.
550--
551-- /Unimplemented/
552--
553{-# INLINABLE wordBy #-}
554wordBy ::
555 -- Monad m =>
556 (a -> Bool) -> Fold m a b -> Parser m a b
557wordBy = undefined
559-- | See 'Streamly.Internal.Data.Parser.groupBy'.
560--
561-- /Unimplemented/
562--
563{-# INLINABLE groupBy #-}
564groupBy ::
565 -- Monad m =>
566 (a -> a -> Bool) -> Fold m a b -> Parser m a b
567groupBy = undefined
569-- XXX use an Unfold instead of a list?
570-- XXX custom combinators for matching list, array and stream?
571--
572-- | See 'Streamly.Internal.Data.Parser.eqBy'.
573--
574-- /Internal/
575--
576{-# INLINE eqBy #-}
577eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
578eqBy cmp str = Parser step initial extract
580 where
582 initial = return str
584 step [] _ = return $ Done 0 ()
585 step [x] a = return $
586 if x `cmp` a
587 then Done 0 ()
588 else Error "eqBy: failed, yet to match the last element"
589 step (x:xs) a = return $
590 if x `cmp` a
591 then Continue 0 xs
592 else Error $
593 "eqBy: failed, yet to match " ++ show (length xs + 1) ++ " elements"
595 extract xs = throwM $ ParseError $
596 "eqBy: end of input, yet to match " ++ show (length xs) ++ " elements"
598-------------------------------------------------------------------------------
599-- nested parsers
600-------------------------------------------------------------------------------
602-- | See 'Streamly.Internal.Data.Parser.lookahead'.
603--
604-- /Internal/
605--
606{-# INLINE lookAhead #-}
607lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
608lookAhead (Parser step1 initial1 _) =
609 Parser step initial extract
611 where
613 initial = Tuple' 0 <$> initial1
615 step (Tuple' cnt st) a = do
616 r <- step1 st a
617 let cnt1 = cnt + 1
618 return $ case r of
619 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
620 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
621 Done _ b -> Done cnt1 b
622 Error err -> Error err
624 -- XXX returning an error let's us backtrack. To implement it in a way so
625 -- that it terminates on eof without an error then we need a way to
626 -- backtrack on eof, that will require extract to return 'Step' type.
627 extract (Tuple' n _) = throwM $ ParseError $
628 "lookAhead: end of input after consuming " ++ show n ++ " elements"
630-------------------------------------------------------------------------------
631-- Interleaving
632-------------------------------------------------------------------------------
633--
634-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
635--
636-- /Unimplemented/
637--
638{-# INLINE deintercalate #-}
639deintercalate ::
640 -- Monad m =>
641 Fold m a y -> Parser m x a
642 -> Fold m b z -> Parser m x b
643 -> Parser m x (y, z)
644deintercalate = undefined
646-------------------------------------------------------------------------------
647-- Sequential Collection
648-------------------------------------------------------------------------------
649--
650-- | See 'Streamly.Internal.Data.Parser.sequence'.
651--
652-- /Unimplemented/
653--
654{-# INLINE sequence #-}
655sequence ::
656 -- Foldable t =>
657 Fold m b c -> t (Parser m a b) -> Parser m a c
658sequence _f _p = undefined
660-------------------------------------------------------------------------------
661-- Alternative Collection
662-------------------------------------------------------------------------------
663--
664-- | See 'Streamly.Internal.Data.Parser.choice'.
665--
666-- /Unimplemented/
667--
668{-# INLINE choice #-}
669choice ::
670 -- Foldable t =>
671 t (Parser m a b) -> Parser m a b
672choice _ps = undefined
674-------------------------------------------------------------------------------
675-- Sequential Repetition
676-------------------------------------------------------------------------------
677--
678-- | See 'Streamly.Internal.Data.Parser.many'.
679--
680-- /Internal/
681--
682{-# INLINE many #-}
683many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
684many = splitMany
685-- many = countBetween 0 maxBound
687-- | See 'Streamly.Internal.Data.Parser.some'.
688--
689-- /Internal/
690--
691{-# INLINE some #-}
692some :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
693some = splitSome
694-- some f p = many (takeGE 1 f) p
695-- many = countBetween 1 maxBound
697-- | See 'Streamly.Internal.Data.Parser.countBetween'.
698--
699-- /Unimplemented/
700--
701{-# INLINE countBetween #-}
702countBetween ::
703 -- MonadCatch m =>
704 Int -> Int -> Fold m b c -> Parser m a b -> Parser m a c
705countBetween _m _n _f = undefined
706-- countBetween m n f p = many (takeBetween m n f) p
708-- | See 'Streamly.Internal.Data.Parser.count'.
709--
710-- /Unimplemented/
711--
712{-# INLINE count #-}
713count ::
714 -- MonadCatch m =>
715 Int -> Fold m b c -> Parser m a b -> Parser m a c
716count n = countBetween n n
717-- count n f p = many (takeEQ n f) p
719data ManyTillState fs sr sl = ManyTillR Int fs sr | ManyTillL fs sl
721-- | See 'Streamly.Internal.Data.Parser.manyTill'.
722--
723-- /Internal/
724--
725{-# INLINE manyTill #-}
726manyTill :: MonadCatch m
727 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
728manyTill (Fold fstep finitial fextract)
729 (Parser stepL initialL extractL)
730 (Parser stepR initialR _) =
731 Parser step initial extract
733 where
735 initial = do
736 fs <- finitial
737 ManyTillR 0 fs <$> initialR
739 step (ManyTillR cnt fs st) a = do
740 r <- stepR st a
741 case r of
742 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
743 Continue n s -> do
744 assert (cnt + 1 - n >= 0) (return ())
745 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
746 Done n _ -> do
747 b <- fextract fs
748 return $ Done n b
749 Error _ -> do
750 rR <- initialL
751 return $ Continue (cnt + 1) (ManyTillL fs rR)
753 step (ManyTillL fs st) a = do
754 r <- stepL st a
755 case r of
756 Partial n s -> return $ Partial n (ManyTillL fs s)
757 Continue n s -> return $ Continue n (ManyTillL fs s)
758 Done n b -> do
759 fs1 <- fstep fs b
760 l <- initialR
761 return $ Partial n (ManyTillR 0 fs1 l)
762 Error err -> return $ Error err
764 extract (ManyTillL fs sR) = extractL sR >>= fstep fs >>= fextract
765 extract (ManyTillR _ fs _) = fextract fs