git.iko.soy/streamly
on b52ed84 help sign in
streamly/src/Streamly/Internal/Data/Parser/ParserD.hs
738 lines 19 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE RankNTypes #-}
3{-# LANGUAGE ScopedTypeVariables #-}
5#include "inline.hs"
7-- |
8-- Module : Streamly.Internal.Data.Parser.ParserD
9-- Copyright : (c) 2020 Composewell Technologies
10-- License : BSD-3-Clause
11-- Maintainer : streamly@composewell.com
12-- Stability : experimental
13-- Portability : GHC
14--
15-- Direct style parser implementation with stream fusion.
17module Streamly.Internal.Data.Parser.ParserD
18 (
19 Parser (..)
20 , ParseError (..)
21 , Step (..)
23 -- First order parsers
24 -- * Accumulators
25 , fromFold
26 , toParserK
27 , fromParserK
28 , any
29 , all
30 , yield
31 , yieldM
32 , die
33 , dieM
35 -- * Element parsers
36 , peek
37 , eof
38 , satisfy
40 -- * Sequence parsers
41 --
42 -- Parsers chained in series, if one parser terminates the composition
43 -- terminates. Currently we are using folds to collect the output of the
44 -- parsers but we can use Parsers instead of folds to make the composition
45 -- more powerful. For example, we can do:
46 --
47 -- sliceSepByMax cond n p = sliceBy cond (take n p)
48 -- sliceSepByBetween cond m n p = sliceBy cond (takeBetween m n p)
49 -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)
50 --
51 -- Grab a sequence of input elements without inspecting them
52 , take
53 -- , takeBetween
54 -- , takeLE -- take -- takeBetween 0 n
55 -- , takeLE1 -- take1 -- takeBetween 1 n
56 , takeEQ -- takeBetween n n
57 , takeGE -- takeBetween n maxBound
59 -- Grab a sequence of input elements by inspecting them
60 , lookAhead
61 , takeWhile
62 , takeWhile1
63 , sliceSepBy
64 , sliceSepByMax
65 -- , sliceSepByBetween
66 , sliceEndWith
67 , sliceBeginWith
68 -- , sliceSepWith
69 --
70 -- , frameSepBy -- parse frames escaped by an escape char/sequence
71 -- , frameEndWith
72 --
73 , wordBy
74 , groupBy
75 , eqBy
76 -- , prefixOf -- match any prefix of a given string
77 -- , suffixOf -- match any suffix of a given string
78 -- , infixOf -- match any substring of a given string
80 -- Second order parsers (parsers using parsers)
81 -- * Binary Combinators
83 -- ** Sequential Applicative
84 , splitWith
85 , split_
87 -- ** Parallel Applicatives
88 , teeWith
89 , teeWithFst
90 , teeWithMin
91 -- , teeTill -- like manyTill but parallel
93 -- ** Sequential Interleaving
94 -- Use two folds, run a primary parser, its rejected values go to the
95 -- secondary parser.
96 , deintercalate
98 -- ** Sequential Alternative
99 , alt
101 -- ** Parallel Alternatives
102 , shortest
103 , longest
104 -- , fastest
106 -- * N-ary Combinators
107 -- ** Sequential Collection
108 , sequence
109 , concatMap
111 -- ** Sequential Repetition
112 , count
113 , countBetween
114 -- , countBetweenTill
116 , many
117 , some
118 , manyTill
120 -- -- ** Special cases
121 -- XXX traditional implmentations of these may be of limited use. For
122 -- example, consider parsing lines separated by "\r\n". The main parser
123 -- will have to detect and exclude the sequence "\r\n" anyway so that we
124 -- can apply the "sep" parser.
125 --
126 -- We can instead implement these as special cases of deintercalate.
127 --
128 -- , endBy
129 -- , sepBy
130 -- , sepEndBy
131 -- , beginBy
132 -- , sepBeginBy
133 -- , sepAroundBy
135 -- -- * Distribution
136 --
137 -- A simple and stupid impl would be to just convert the stream to an array
138 -- and give the array reference to all consumers. The array can be grown on
139 -- demand by any consumer and truncated when nonbody needs it.
140 --
141 -- -- ** Distribute to collection
142 -- -- ** Distribute to repetition
144 -- -- ** Interleaved collection
145 -- Round robin
146 -- Priority based
147 -- -- ** Interleaved repetition
148 -- repeat one parser and when it fails run an error recovery parser
149 -- e.g. to find a key frame in the stream after an error
151 -- ** Collection of Alternatives
152 -- , shortestN
153 -- , longestN
154 -- , fastestN -- first N successful in time
155 -- , choiceN -- first N successful in position
156 , choice -- first successful in position
158 -- -- ** Repeated Alternatives
159 -- , retryMax -- try N times
160 -- , retryUntil -- try until successful
161 -- , retryUntilN -- try until successful n times
162 )
163where
165import Control.Exception (assert)
166import Control.Monad.Catch (MonadCatch, MonadThrow(..))
167import Prelude
168 hiding (any, all, take, takeWhile, sequence, concatMap)
170import Streamly.Internal.Data.Fold.Types (Fold(..))
172import qualified Streamly.Internal.Data.Parser.ParserK.Types as K
173import qualified Streamly.Internal.Data.Zipper as Z
175import Streamly.Internal.Data.Parser.ParserD.Tee
176import Streamly.Internal.Data.Parser.ParserD.Types
177import Streamly.Internal.Data.Strict
179-------------------------------------------------------------------------------
180-- Upgrade folds to parses
181-------------------------------------------------------------------------------
182--
183-- | See 'Streamly.Internal.Data.Parser.fromFold'.
184--
185-- /Internal/
186--
187{-# INLINE fromFold #-}
188fromFold :: Monad m => Fold m a b -> Parser m a b
189fromFold (Fold fstep finitial fextract) = Parser step finitial fextract
191 where
193 step s a = Yield 0 <$> fstep s a
195-------------------------------------------------------------------------------
196-- Convert to and from CPS style parser representation
197-------------------------------------------------------------------------------
199-- | Convert a direct style 'Parser' to a CPS style 'K.Parser'.
200--
201-- /Internal/
202--
203{-# INLINE_LATE toParserK #-}
204toParserK :: MonadCatch m => Parser m a b -> K.Parser m a b
205toParserK (Parser step initial extract) =
206 K.MkParser $ \inp yieldk ->
207 Z.parse step initial extract inp >>= yieldk
209-- | Convert a CPS style 'K.Parser' to a direct style 'Parser'.
210--
211-- /Unimplemented/
212--
213{-# NOINLINE fromParserK #-}
214fromParserK :: Monad m => K.Parser m a b -> Parser m a b
215fromParserK _ = Parser step initial extract
217 where
219 initial = return ()
220 step () _ = error "fromParserK: unimplemented"
221 extract () = error "fromParserK: unimplemented"
223#ifndef DISABLE_FUSION
224{-# RULES "fromParserK/toParserK fusion" [2]
225 forall s. toParserK (fromParserK s) = s #-}
226{-# RULES "toParserK/fromParserK fusion" [2]
227 forall s. fromParserK (toParserK s) = s #-}
228#endif
230-------------------------------------------------------------------------------
231-- Terminating but not failing folds
232-------------------------------------------------------------------------------
233--
234{-# INLINE any #-}
235any :: Monad m => (a -> Bool) -> Parser m a Bool
236any predicate = Parser step initial return
238 where
240 initial = return False
242 step s a = return $
243 if s
244 then Stop 0 True
245 else
246 if predicate a
247 then Stop 0 True
248 else Yield 0 False
250{-# INLINABLE all #-}
251all :: Monad m => (a -> Bool) -> Parser m a Bool
252all predicate = Parser step initial return
254 where
256 initial = return True
258 step s a = return $
259 if s
260 then
261 if predicate a
262 then Yield 0 True
263 else Stop 0 False
264 else Stop 0 False
266-------------------------------------------------------------------------------
267-- Failing Parsers
268-------------------------------------------------------------------------------
270-- | See 'Streamly.Internal.Data.Parser.peek'.
271--
272-- /Internal/
273--
274{-# INLINABLE peek #-}
275peek :: MonadThrow m => Parser m a a
276peek = Parser step initial extract
278 where
280 initial = return ()
282 step () a = return $ Stop 1 a
284 extract () = throwM $ ParseError "peek: end of input"
286-- | See 'Streamly.Internal.Data.Parser.eof'.
287--
288-- /Internal/
289--
290{-# INLINABLE eof #-}
291eof :: Monad m => Parser m a ()
292eof = Parser step initial return
294 where
296 initial = return ()
298 step () _ = return $ Error "eof: not at end of input"
300-- | See 'Streamly.Internal.Data.Parser.satisfy'.
301--
302-- /Internal/
303--
304{-# INLINE satisfy #-}
305satisfy :: MonadThrow m => (a -> Bool) -> Parser m a a
306satisfy predicate = Parser step initial extract
308 where
310 initial = return ()
312 step () a = return $
313 if predicate a
314 then Stop 0 a
315 else Error "satisfy: predicate failed"
317 extract _ = throwM $ ParseError "satisfy: end of input"
319-------------------------------------------------------------------------------
320-- Taking elements
321-------------------------------------------------------------------------------
322--
323-- | See 'Streamly.Internal.Data.Parser.take'.
324--
325-- /Internal/
326--
327{-# INLINE take #-}
328take :: Monad m => Int -> Fold m a b -> Parser m a b
329take n (Fold fstep finitial fextract) = Parser step initial extract
331 where
333 initial = Tuple' 0 <$> finitial
335 step (Tuple' i r) a = do
336 res <- fstep r a
337 let i1 = i + 1
338 s1 = Tuple' i1 res
339 if i1 < n
340 then return $ Yield 0 s1
341 else Stop 0 <$> fextract res
343 extract (Tuple' _ r) = fextract r
345-- | See 'Streamly.Internal.Data.Parser.takeEQ'.
346--
347-- /Internal/
348--
349{-# INLINE takeEQ #-}
350takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b
351takeEQ n (Fold fstep finitial fextract) = Parser step initial extract
353 where
355 initial = Tuple' 0 <$> finitial
357 step (Tuple' i r) a = do
358 res <- fstep r a
359 let i1 = i + 1
360 s1 = Tuple' i1 res
361 if i1 < n then return (Skip 0 s1) else Stop 0 <$> fextract res
363 extract (Tuple' i r) =
364 if n == i
365 then fextract r
366 else throwM $ ParseError err
368 where
370 err =
371 "takeEQ: Expecting exactly " ++ show n
372 ++ " elements, got " ++ show i
374-- | See 'Streamly.Internal.Data.Parser.takeGE'.
375--
376-- /Internal/
377--
378{-# INLINE takeGE #-}
379takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b
380takeGE n (Fold fstep finitial fextract) = Parser step initial extract
382 where
384 initial = Tuple' 0 <$> finitial
386 step (Tuple' i r) a = do
387 res <- fstep r a
388 let i1 = i + 1
389 s1 = Tuple' i1 res
390 return $
391 if i1 < n
392 then Skip 0 s1
393 else Yield 0 s1
395 extract (Tuple' i r) = fextract r >>= f
397 where
399 err =
400 "takeGE: Expecting at least " ++ show n
401 ++ " elements, got only " ++ show i
403 f x =
404 if i >= n
405 then return x
406 else throwM $ ParseError err
408-- | See 'Streamly.Internal.Data.Parser.takeWhile'.
409--
410-- /Internal/
411--
412{-# INLINE takeWhile #-}
413takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
414takeWhile predicate (Fold fstep finitial fextract) =
415 Parser step initial fextract
417 where
419 initial = finitial
421 step s a =
422 if predicate a
423 then Yield 0 <$> fstep s a
424 else Stop 1 <$> fextract s
426-- | See 'Streamly.Internal.Data.Parser.takeWhile1'.
427--
428-- /Internal/
429--
430{-# INLINE takeWhile1 #-}
431takeWhile1 :: MonadThrow m => (a -> Bool) -> Fold m a b -> Parser m a b
432takeWhile1 predicate (Fold fstep finitial fextract) =
433 Parser step initial extract
435 where
437 initial = return Nothing
439 step Nothing a =
440 if predicate a
441 then do
442 s <- finitial
443 r <- fstep s a
444 return $ Yield 0 (Just r)
445 else return $ Error "takeWhile1: empty"
446 step (Just s) a =
447 if predicate a
448 then do
449 r <- fstep s a
450 return $ Yield 0 (Just r)
451 else do
452 b <- fextract s
453 return $ Stop 1 b
455 extract Nothing = throwM $ ParseError "takeWhile1: end of input"
456 extract (Just s) = fextract s
458-- | See 'Streamly.Internal.Data.Parser.sliceSepBy'.
459--
460-- /Internal/
461--
462{-# INLINABLE sliceSepBy #-}
463sliceSepBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser m a b
464sliceSepBy predicate (Fold fstep finitial fextract) =
465 Parser step initial fextract
467 where
469 initial = finitial
470 step s a =
471 if not (predicate a)
472 then Yield 0 <$> fstep s a
473 else Stop 0 <$> fextract s
475-- | See 'Streamly.Internal.Data.Parser.sliceEndWith'.
476--
477-- /Unimplemented/
478--
479{-# INLINABLE sliceEndWith #-}
480sliceEndWith ::
481 -- Monad m =>
482 (a -> Bool) -> Fold m a b -> Parser m a b
483sliceEndWith = undefined
485-- | See 'Streamly.Internal.Data.Parser.sliceBeginWith'.
486--
487-- /Unimplemented/
488--
489{-# INLINABLE sliceBeginWith #-}
490sliceBeginWith ::
491 -- Monad m =>
492 (a -> Bool) -> Fold m a b -> Parser m a b
493sliceBeginWith = undefined
495-- | See 'Streamly.Internal.Data.Parser.sliceSepByMax'.
496--
497-- /Internal/
498--
499{-# INLINABLE sliceSepByMax #-}
500sliceSepByMax :: Monad m
501 => (a -> Bool) -> Int -> Fold m a b -> Parser m a b
502sliceSepByMax predicate cnt (Fold fstep finitial fextract) =
503 Parser step initial extract
505 where
507 initial = Tuple' 0 <$> finitial
508 step (Tuple' i r) a = do
509 res <- fstep r a
510 let i1 = i + 1
511 s1 = Tuple' i1 res
512 if not (predicate a) && i1 < cnt
513 then return $ Yield 0 s1
514 else do
515 b <- fextract res
516 return $ Stop 0 b
517 extract (Tuple' _ r) = fextract r
519-- | See 'Streamly.Internal.Data.Parser.wordBy'.
520--
521-- /Unimplemented/
522--
523{-# INLINABLE wordBy #-}
524wordBy ::
525 -- Monad m =>
526 (a -> Bool) -> Fold m a b -> Parser m a b
527wordBy = undefined
529-- | See 'Streamly.Internal.Data.Parser.groupBy'.
530--
531-- /Unimplemented/
532--
533{-# INLINABLE groupBy #-}
534groupBy ::
535 -- Monad m =>
536 (a -> a -> Bool) -> Fold m a b -> Parser m a b
537groupBy = undefined
539-- XXX use an Unfold instead of a list?
540-- XXX custom combinators for matching list, array and stream?
541--
542-- | See 'Streamly.Internal.Data.Parser.eqBy'.
543--
544-- /Internal/
545--
546{-# INLINE eqBy #-}
547eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
548eqBy cmp str = Parser step initial extract
550 where
552 initial = return str
554 step [] _ = error "Bug: unreachable"
555 step [x] a = return $
556 if x `cmp` a
557 then Stop 0 ()
558 else Error "eqBy: failed, at the last element"
559 step (x:xs) a = return $
560 if x `cmp` a
561 then Skip 0 xs
562 else Error $
563 "eqBy: failed, yet to match " ++ show (length xs) ++ " elements"
565 extract xs = throwM $ ParseError $
566 "eqBy: end of input, yet to match " ++ show (length xs) ++ " elements"
568-------------------------------------------------------------------------------
569-- nested parsers
570-------------------------------------------------------------------------------
572-- | See 'Streamly.Internal.Data.Parser.lookahead'.
573--
574-- /Internal/
575--
576{-# INLINE lookAhead #-}
577lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
578lookAhead (Parser step1 initial1 _) =
579 Parser step initial extract
581 where
583 initial = Tuple' 0 <$> initial1
585 step (Tuple' cnt st) a = do
586 r <- step1 st a
587 let cnt1 = cnt + 1
588 return $ case r of
589 Yield _ s -> Skip 0 (Tuple' cnt1 s)
590 YieldB n s -> Skip n (Tuple' (cnt1 - n) s)
591 Skip n s -> Skip n (Tuple' (cnt1 - n) s)
592 Stop _ b -> Stop cnt1 b
593 Error err -> Error err
595 -- XXX returning an error let's us backtrack. To implement it in a way so
596 -- that it terminates on eof without an error then we need a way to
597 -- backtrack on eof, that will require extract to return 'Step' type.
598 extract (Tuple' n _) = throwM $ ParseError $
599 "lookAhead: end of input after consuming " ++ show n ++ " elements"
601-------------------------------------------------------------------------------
602-- Interleaving
603-------------------------------------------------------------------------------
604--
605-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
606--
607-- /Unimplemented/
608--
609{-# INLINE deintercalate #-}
610deintercalate ::
611 -- Monad m =>
612 Fold m a y -> Parser m x a
613 -> Fold m b z -> Parser m x b
614 -> Parser m x (y, z)
615deintercalate = undefined
617-------------------------------------------------------------------------------
618-- Sequential Collection
619-------------------------------------------------------------------------------
620--
621-- | See 'Streamly.Internal.Data.Parser.sequence'.
622--
623-- /Unimplemented/
624--
625{-# INLINE sequence #-}
626sequence ::
627 -- Foldable t =>
628 Fold m b c -> t (Parser m a b) -> Parser m a c
629sequence _f _p = undefined
631-------------------------------------------------------------------------------
632-- Alternative Collection
633-------------------------------------------------------------------------------
634--
635-- | See 'Streamly.Internal.Data.Parser.choice'.
636--
637-- /Unimplemented/
638--
639{-# INLINE choice #-}
640choice ::
641 -- Foldable t =>
642 t (Parser m a b) -> Parser m a b
643choice _ps = undefined
645-------------------------------------------------------------------------------
646-- Sequential Repetition
647-------------------------------------------------------------------------------
648--
649-- | See 'Streamly.Internal.Data.Parser.many'.
650--
651-- /Internal/
652--
653{-# INLINE many #-}
654many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
655many = splitMany
656-- many = countBetween 0 maxBound
658-- | See 'Streamly.Internal.Data.Parser.some'.
659--
660-- /Internal/
661--
662{-# INLINE some #-}
663some :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
664some = splitSome
665-- some f p = many (takeGE 1 f) p
666-- many = countBetween 1 maxBound
668-- | See 'Streamly.Internal.Data.Parser.countBetween'.
669--
670-- /Unimplemented/
671--
672{-# INLINE countBetween #-}
673countBetween ::
674 -- MonadCatch m =>
675 Int -> Int -> Fold m b c -> Parser m a b -> Parser m a c
676countBetween _m _n _f = undefined
677-- countBetween m n f p = many (takeBetween m n f) p
679-- | See 'Streamly.Internal.Data.Parser.count'.
680--
681-- /Unimplemented/
682--
683{-# INLINE count #-}
684count ::
685 -- MonadCatch m =>
686 Int -> Fold m b c -> Parser m a b -> Parser m a c
687count n = countBetween n n
688-- count n f p = many (takeEQ n f) p
690data ManyTillState fs sr sl = ManyTillR Int fs sr | ManyTillL fs sl
692-- | See 'Streamly.Internal.Data.Parser.manyTill'.
693--
694-- /Internal/
695--
696{-# INLINE manyTill #-}
697manyTill :: MonadCatch m
698 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
699manyTill (Fold fstep finitial fextract)
700 (Parser stepL initialL extractL)
701 (Parser stepR initialR _) =
702 Parser step initial extract
704 where
706 initial = do
707 fs <- finitial
708 ManyTillR 0 fs <$> initialR
710 step (ManyTillR cnt fs st) a = do
711 r <- stepR st a
712 case r of
713 Yield n s -> return $ Yield n (ManyTillR 0 fs s)
714 YieldB n s -> return $ YieldB n (ManyTillR 0 fs s)
715 Skip n s -> do
716 assert (cnt + 1 - n >= 0) (return ())
717 return $ Skip n (ManyTillR (cnt + 1 - n) fs s)
718 Stop n _ -> do
719 b <- fextract fs
720 return $ Stop n b
721 Error _ -> do
722 rR <- initialL
723 return $ Skip (cnt + 1) (ManyTillL fs rR)
725 step (ManyTillL fs st) a = do
726 r <- stepL st a
727 case r of
728 Yield n s -> return $ Yield n (ManyTillL fs s)
729 YieldB n s -> return $ YieldB n (ManyTillL fs s)
730 Skip n s -> return $ Skip n (ManyTillL fs s)
731 Stop n b -> do
732 fs1 <- fstep fs b
733 l <- initialR
734 return $ YieldB n (ManyTillR 0 fs1 l)
735 Error err -> return $ Error err
737 extract (ManyTillL fs sR) = extractL sR >>= fstep fs >>= fextract
738 extract (ManyTillR _ fs _) = fextract fs