git.iko.soy/streamly
on cff0369 help sign in
streamly/src/Streamly/Internal/Data/Parser/ParserD.hs
730 lines 19 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 , any
23 , all
24 , yield
25 , yieldM
26 , die
27 , dieM
29 -- * Element parsers
30 , peek
31 , eof
32 , satisfy
33 , maybe
34 , either
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 Streamly.Internal.Data.Fold.Types (Fold(..))
164import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
166import Prelude hiding
167 (any, all, take, takeWhile, sequence, concatMap, maybe, either)
168import Streamly.Internal.Data.Parser.ParserD.Tee
169import Streamly.Internal.Data.Parser.ParserD.Types
171-------------------------------------------------------------------------------
172-- Upgrade folds to parses
173-------------------------------------------------------------------------------
174--
175-- | See 'Streamly.Internal.Data.Parser.fromFold'.
176--
177-- /Internal/
178--
179{-# INLINE fromFold #-}
180fromFold :: Monad m => Fold m a b -> Parser m a b
181fromFold (Fold fstep finitial fextract) = Parser step finitial fextract
183 where
185 step s a = Partial 0 <$> fstep s a
187-------------------------------------------------------------------------------
188-- Terminating but not failing folds
189-------------------------------------------------------------------------------
190--
191{-# INLINE any #-}
192any :: Monad m => (a -> Bool) -> Parser m a Bool
193any predicate = Parser step initial return
195 where
197 initial = return False
199 step s a = return (if s || predicate a then Done 0 True else Partial 0 False)
201{-# INLINABLE all #-}
202all :: Monad m => (a -> Bool) -> Parser m a Bool
203all predicate = Parser step initial return
205 where
207 initial = return True
209 step s a = return (if s && predicate a then Partial 0 True else Done 0 False)
211-------------------------------------------------------------------------------
212-- Failing Parsers
213-------------------------------------------------------------------------------
215-- | See 'Streamly.Internal.Data.Parser.peek'.
216--
217-- /Internal/
218--
219{-# INLINABLE peek #-}
220peek :: MonadThrow m => Parser m a a
221peek = Parser step initial extract
223 where
225 initial = return ()
227 step () a = return $ Done 1 a
229 extract () = throwM $ ParseError "peek: end of input"
231-- | See 'Streamly.Internal.Data.Parser.eof'.
232--
233-- /Internal/
234--
235{-# INLINABLE eof #-}
236eof :: Monad m => Parser m a ()
237eof = Parser step initial return
239 where
241 initial = return ()
243 step () _ = return $ Error "eof: not at end of input"
245-- | See 'Streamly.Internal.Data.Parser.satisfy'.
246--
247-- /Internal/
248--
249{-# INLINE satisfy #-}
250satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
251satisfy predicate = Parser step initial extract
253 where
255 initial = return ()
257 step () a = return $
258 if predicate a
259 then Done 0 a
260 else Error "satisfy: predicate failed"
262 extract _ = throwM $ ParseError "satisfy: end of input"
264-- | See 'Streamly.Internal.Data.Parser.maybe'.
265--
266-- /Internal/
267--
268{-# INLINE maybe #-}
269maybe :: MonadThrow m => (a -> Maybe b) -> Parser m a b
270maybe parser = Parser step initial extract
272 where
274 initial = return ()
276 step () a = return $
277 case parser a of
278 Just b -> Done 0 b
279 Nothing -> Error "maybe: predicate failed"
281 extract _ = throwM $ ParseError "maybe: end of input"
283-- | See 'Streamly.Internal.Data.Parser.either'.
284--
285-- /Internal/
286--
287{-# INLINE either #-}
288either :: MonadThrow m => (a -> Either String b) -> Parser m a b
289either parser = Parser step initial extract
291 where
293 initial = return ()
295 step () a = return $
296 case parser a of
297 Right b -> Done 0 b
298 Left err -> Error $ "either: " ++ err
300 extract _ = throwM $ ParseError "either: end of input"
302-------------------------------------------------------------------------------
303-- Taking elements
304-------------------------------------------------------------------------------
305--
306-- | See 'Streamly.Internal.Data.Parser.take'.
307--
308-- /Internal/
309--
310{-# INLINE take #-}
311take :: Monad m => Int -> Fold m a b -> Parser m a b
312take n (Fold fstep finitial fextract) = Parser step initial extract
314 where
316 initial = Tuple' 0 <$> finitial
318 step (Tuple' i r) a
319 | i < n = do
320 res <- fstep r a
321 let i1 = i + 1
322 s1 = Tuple' i1 res
323 if i1 < n
324 then return $ Partial 0 s1
325 else Done 0 <$> fextract res
326 | otherwise = Done 1 <$> fextract r
328 extract (Tuple' _ r) = fextract r
330-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
331--
332-- /Internal/
333--
334{-# INLINE takeEQ #-}
335takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
336takeEQ cnt (Fold fstep finitial fextract) = Parser step initial extract
338 where
340 n = max cnt 0
342 initial = Tuple' 0 <$> finitial
344 step (Tuple' i r) a
345 | i < n = do
346 res <- fstep r a
347 let i1 = i + 1
348 s1 = Tuple' i1 res
349 if i1 < n
350 then return (Continue 0 s1)
351 else Done 0 <$> fextract res
352 | otherwise = Done 1 <$> fextract r
354 extract (Tuple' i r) =
355 if n == i
356 then fextract r
357 else throwM $ ParseError err
359 where
361 err =
362 "takeEQ: Expecting exactly " ++ show n
363 ++ " elements, got " ++ show i
365-- | See 'Streamly.Internal.Data.Parser.takeGE'.
366--
367-- /Internal/
368--
369{-# INLINE takeGE #-}
370takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
371takeGE cnt (Fold fstep finitial fextract) = Parser step initial extract
372 where
374 n = max cnt 0
376 initial = Tuple' 0 <$> finitial
378 step (Tuple' i r) a = do
379 res <- fstep r a
380 let i1 = i + 1
381 s1 = Tuple' i1 res
382 return $
383 if i1 < n
384 then Continue 0 s1
385 else Partial 0 s1
387 extract (Tuple' i r) = fextract r >>= f
389 where
391 err =
392 "takeGE: Expecting at least " ++ show n
393 ++ " elements, got only " ++ show i
395 f x =
396 if i >= n
397 then return x
398 else throwM $ ParseError err
400-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
401--
402-- /Internal/
403--
404{-# INLINE takeWhile #-}
405takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
406takeWhile predicate (Fold fstep finitial fextract) =
407 Parser step initial fextract
409 where
411 initial = finitial
413 step s a =
414 if predicate a
415 then Partial 0 <$> fstep s a
416 else Done 1 <$> fextract s
418-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
419--
420-- /Internal/
421--
422{-# INLINE takeWhile1 #-}
423takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
424takeWhile1 predicate (Fold fstep finitial fextract) =
425 Parser step initial extract
427 where
429 initial = return Nothing
431 step Nothing a =
432 if predicate a
433 then do
434 s <- finitial
435 r <- fstep s a
436 return $ Partial 0 (Just r)
437 else return $ Error "takeWhile1: empty"
438 step (Just s) a =
439 if predicate a
440 then do
441 r <- fstep s a
442 return $ Partial 0 (Just r)
443 else do
444 b <- fextract s
445 return $ Done 1 b
447 extract Nothing = throwM $ ParseError "takeWhile1: end of input"
448 extract (Just s) = fextract s
450-- | See 'Streamly.Internal.Data.Parser.sliceSepBy'.
451--
452-- /Internal/
453--
454{-# INLINABLE sliceSepBy #-}
455sliceSepBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
456sliceSepBy predicate (Fold fstep finitial fextract) =
457 Parser step initial fextract
459 where
461 initial = finitial
462 step s a =
463 if not (predicate a)
464 then Partial 0 <$> fstep s a
465 else Done 0 <$> fextract s
467-- | See 'Streamly.Internal.Data.Parser.sliceEndWith'.
468--
469-- /Unimplemented/
470--
471{-# INLINABLE sliceEndWith #-}
472sliceEndWith ::
473 -- Monad m =>
474 (a -> Bool) -> Fold m a b -> Parser m a b
475sliceEndWith = undefined
477-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
478--
479-- /Unimplemented/
480--
481{-# INLINABLE sliceBeginWith #-}
482sliceBeginWith ::
483 -- Monad m =>
484 (a -> Bool) -> Fold m a b -> Parser m a b
485sliceBeginWith = undefined
487-- | See 'Streamly.Internal.Data.Parser.sliceSepByMax'.
488--
489-- /Internal/
490--
491{-# INLINABLE sliceSepByMax #-}
492sliceSepByMax :: Monad m
493 => (a -> Bool) -> Int -> Fold m a b -> Parser m a b
494sliceSepByMax predicate cnt (Fold fstep finitial fextract) =
495 Parser step initial extract
497 where
499 initial = Tuple' 0 <$> finitial
501 step (Tuple' i r) a
502 | not (predicate a) =
503 if i < cnt
504 then do
505 res <- fstep r a
506 let i1 = i + 1
507 s1 = Tuple' i1 res
508 return $ Partial 0 s1
509 else Done 1 <$> fextract r
510 | otherwise = Done 0 <$> fextract r
512 extract (Tuple' _ r) = fextract r
514-- | See 'Streamly.Internal.Data.Parser.wordBy'.
515--
516-- /Unimplemented/
517--
518{-# INLINABLE wordBy #-}
519wordBy ::
520 -- Monad m =>
521 (a -> Bool) -> Fold m a b -> Parser m a b
522wordBy = undefined
524-- | See 'Streamly.Internal.Data.Parser.groupBy'.
525--
526-- /Unimplemented/
527--
528{-# INLINABLE groupBy #-}
529groupBy ::
530 -- Monad m =>
531 (a -> a -> Bool) -> Fold m a b -> Parser m a b
532groupBy = undefined
534-- XXX use an Unfold instead of a list?
535-- XXX custom combinators for matching list, array and stream?
536--
537-- | See 'Streamly.Internal.Data.Parser.eqBy'.
538--
539-- /Internal/
540--
541{-# INLINE eqBy #-}
542eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
543eqBy cmp str = Parser step initial extract
545 where
547 initial = return str
549 step [] _ = return $ Done 0 ()
550 step [x] a = return $
551 if x `cmp` a
552 then Done 0 ()
553 else Error "eqBy: failed, yet to match the last element"
554 step (x:xs) a = return $
555 if x `cmp` a
556 then Continue 0 xs
557 else Error $
558 "eqBy: failed, yet to match " ++ show (length xs + 1) ++ " elements"
560 extract xs = throwM $ ParseError $
561 "eqBy: end of input, yet to match " ++ show (length xs) ++ " elements"
563-------------------------------------------------------------------------------
564-- nested parsers
565-------------------------------------------------------------------------------
567-- | See 'Streamly.Internal.Data.Parser.lookahead'.
568--
569-- /Internal/
570--
571{-# INLINE lookAhead #-}
572lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
573lookAhead (Parser step1 initial1 _) =
574 Parser step initial extract
576 where
578 initial = Tuple' 0 <$> initial1
580 step (Tuple' cnt st) a = do
581 r <- step1 st a
582 let cnt1 = cnt + 1
583 return $ case r of
584 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
585 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
586 Done _ b -> Done cnt1 b
587 Error err -> Error err
589 -- XXX returning an error let's us backtrack. To implement it in a way so
590 -- that it terminates on eof without an error then we need a way to
591 -- backtrack on eof, that will require extract to return 'Step' type.
592 extract (Tuple' n _) = throwM $ ParseError $
593 "lookAhead: end of input after consuming " ++ show n ++ " elements"
595-------------------------------------------------------------------------------
596-- Interleaving
597-------------------------------------------------------------------------------
598--
599-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
600--
601-- /Unimplemented/
602--
603{-# INLINE deintercalate #-}
604deintercalate ::
605 -- Monad m =>
606 Fold m a y -> Parser m x a
607 -> Fold m b z -> Parser m x b
608 -> Parser m x (y, z)
609deintercalate = undefined
611-------------------------------------------------------------------------------
612-- Sequential Collection
613-------------------------------------------------------------------------------
614--
615-- | See 'Streamly.Internal.Data.Parser.sequence'.
616--
617-- /Unimplemented/
618--
619{-# INLINE sequence #-}
620sequence ::
621 -- Foldable t =>
622 Fold m b c -> t (Parser m a b) -> Parser m a c
623sequence _f _p = undefined
625-------------------------------------------------------------------------------
626-- Alternative Collection
627-------------------------------------------------------------------------------
628--
629-- | See 'Streamly.Internal.Data.Parser.choice'.
630--
631-- /Unimplemented/
632--
633{-# INLINE choice #-}
634choice ::
635 -- Foldable t =>
636 t (Parser m a b) -> Parser m a b
637choice _ps = undefined
639-------------------------------------------------------------------------------
640-- Sequential Repetition
641-------------------------------------------------------------------------------
642--
643-- | See 'Streamly.Internal.Data.Parser.many'.
644--
645-- /Internal/
646--
647{-# INLINE many #-}
648many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
649many = splitMany
650-- many = countBetween 0 maxBound
652-- | See 'Streamly.Internal.Data.Parser.some'.
653--
654-- /Internal/
655--
656{-# INLINE some #-}
657some :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
658some = splitSome
659-- some f p = many (takeGE 1 f) p
660-- many = countBetween 1 maxBound
662-- | See 'Streamly.Internal.Data.Parser.countBetween'.
663--
664-- /Unimplemented/
665--
666{-# INLINE countBetween #-}
667countBetween ::
668 -- MonadCatch m =>
669 Int -> Int -> Fold m b c -> Parser m a b -> Parser m a c
670countBetween _m _n _f = undefined
671-- countBetween m n f p = many (takeBetween m n f) p
673-- | See 'Streamly.Internal.Data.Parser.count'.
674--
675-- /Unimplemented/
676--
677{-# INLINE count #-}
678count ::
679 -- MonadCatch m =>
680 Int -> Fold m b c -> Parser m a b -> Parser m a c
681count n = countBetween n n
682-- count n f p = many (takeEQ n f) p
684data ManyTillState fs sr sl = ManyTillR Int fs sr | ManyTillL fs sl
686-- | See 'Streamly.Internal.Data.Parser.manyTill'.
687--
688-- /Internal/
689--
690{-# INLINE manyTill #-}
691manyTill :: MonadCatch m
692 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
693manyTill (Fold fstep finitial fextract)
694 (Parser stepL initialL extractL)
695 (Parser stepR initialR _) =
696 Parser step initial extract
698 where
700 initial = do
701 fs <- finitial
702 ManyTillR 0 fs <$> initialR
704 step (ManyTillR cnt fs st) a = do
705 r <- stepR st a
706 case r of
707 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
708 Continue n s -> do
709 assert (cnt + 1 - n >= 0) (return ())
710 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
711 Done n _ -> do
712 b <- fextract fs
713 return $ Done n b
714 Error _ -> do
715 rR <- initialL
716 return $ Continue (cnt + 1) (ManyTillL fs rR)
718 step (ManyTillL fs st) a = do
719 r <- stepL st a
720 case r of
721 Partial n s -> return $ Partial n (ManyTillL fs s)
722 Continue n s -> return $ Continue n (ManyTillL fs s)
723 Done n b -> do
724 fs1 <- fstep fs b
725 l <- initialR
726 return $ Partial n (ManyTillR 0 fs1 l)
727 Error err -> return $ Error err
729 extract (ManyTillL fs sR) = extractL sR >>= fstep fs >>= fextract
730 extract (ManyTillR _ fs _) = fextract fs