git.iko.soy/streamly
on 70fb992 help sign in
streamly/src/Streamly/Internal/Data/Parser/ParserD.hs
737 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 = Partial 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 Done 0 True
245 else
246 if predicate a
247 then Done 0 True
248 else Partial 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 Partial 0 True
263 else Done 0 False
264 else Done 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 $ Done 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 Done 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 $ Partial 0 s1
341 else Done 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 (Continue 0 s1) else Done 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 Continue 0 s1
393 else Partial 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 Partial 0 <$> fstep s a
424 else Done 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 $ Partial 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 $ Partial 0 (Just r)
451 else do
452 b <- fextract s
453 return $ Done 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 Partial 0 <$> fstep s a
473 else Done 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
509 | not (predicate a) = do
510 res <- fstep r a
511 let i1 = i + 1
512 s1 = Tuple' i1 res
513 if i1 < cnt
514 then return $ Partial 0 s1
515 else do
516 b <- fextract res
517 return $ Done 0 b
518 | otherwise = Done 0 <$> fextract r
519 extract (Tuple' _ r) = fextract r
521-- | See 'Streamly.Internal.Data.Parser.wordBy'.
522--
523-- /Unimplemented/
524--
525{-# INLINABLE wordBy #-}
526wordBy ::
527 -- Monad m =>
528 (a -> Bool) -> Fold m a b -> Parser m a b
529wordBy = undefined
531-- | See 'Streamly.Internal.Data.Parser.groupBy'.
532--
533-- /Unimplemented/
534--
535{-# INLINABLE groupBy #-}
536groupBy ::
537 -- Monad m =>
538 (a -> a -> Bool) -> Fold m a b -> Parser m a b
539groupBy = undefined
541-- XXX use an Unfold instead of a list?
542-- XXX custom combinators for matching list, array and stream?
543--
544-- | See 'Streamly.Internal.Data.Parser.eqBy'.
545--
546-- /Internal/
547--
548{-# INLINE eqBy #-}
549eqBy :: MonadThrow m => (a -> a -> Bool) -> [a] -> Parser m a ()
550eqBy cmp str = Parser step initial extract
552 where
554 initial = return str
556 step [] _ = return $ Done 0 ()
557 step [x] a = return $
558 if x `cmp` a
559 then Done 0 ()
560 else Error "eqBy: failed, yet to match the last element"
561 step (x:xs) a = return $
562 if x `cmp` a
563 then Continue 0 xs
564 else Error $
565 "eqBy: failed, yet to match " ++ show (length xs + 1) ++ " elements"
567 extract xs = throwM $ ParseError $
568 "eqBy: end of input, yet to match " ++ show (length xs) ++ " elements"
570-------------------------------------------------------------------------------
571-- nested parsers
572-------------------------------------------------------------------------------
574-- | See 'Streamly.Internal.Data.Parser.lookahead'.
575--
576-- /Internal/
577--
578{-# INLINE lookAhead #-}
579lookAhead :: MonadThrow m => Parser m a b -> Parser m a b
580lookAhead (Parser step1 initial1 _) =
581 Parser step initial extract
583 where
585 initial = Tuple' 0 <$> initial1
587 step (Tuple' cnt st) a = do
588 r <- step1 st a
589 let cnt1 = cnt + 1
590 return $ case r of
591 Partial n s -> Continue n (Tuple' (cnt1 - n) s)
592 Continue n s -> Continue n (Tuple' (cnt1 - n) s)
593 Done _ b -> Done cnt1 b
594 Error err -> Error err
596 -- XXX returning an error let's us backtrack. To implement it in a way so
597 -- that it terminates on eof without an error then we need a way to
598 -- backtrack on eof, that will require extract to return 'Step' type.
599 extract (Tuple' n _) = throwM $ ParseError $
600 "lookAhead: end of input after consuming " ++ show n ++ " elements"
602-------------------------------------------------------------------------------
603-- Interleaving
604-------------------------------------------------------------------------------
605--
606-- | See 'Streamly.Internal.Data.Parser.deintercalate'.
607--
608-- /Unimplemented/
609--
610{-# INLINE deintercalate #-}
611deintercalate ::
612 -- Monad m =>
613 Fold m a y -> Parser m x a
614 -> Fold m b z -> Parser m x b
615 -> Parser m x (y, z)
616deintercalate = undefined
618-------------------------------------------------------------------------------
619-- Sequential Collection
620-------------------------------------------------------------------------------
621--
622-- | See 'Streamly.Internal.Data.Parser.sequence'.
623--
624-- /Unimplemented/
625--
626{-# INLINE sequence #-}
627sequence ::
628 -- Foldable t =>
629 Fold m b c -> t (Parser m a b) -> Parser m a c
630sequence _f _p = undefined
632-------------------------------------------------------------------------------
633-- Alternative Collection
634-------------------------------------------------------------------------------
635--
636-- | See 'Streamly.Internal.Data.Parser.choice'.
637--
638-- /Unimplemented/
639--
640{-# INLINE choice #-}
641choice ::
642 -- Foldable t =>
643 t (Parser m a b) -> Parser m a b
644choice _ps = undefined
646-------------------------------------------------------------------------------
647-- Sequential Repetition
648-------------------------------------------------------------------------------
649--
650-- | See 'Streamly.Internal.Data.Parser.many'.
651--
652-- /Internal/
653--
654{-# INLINE many #-}
655many :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
656many = splitMany
657-- many = countBetween 0 maxBound
659-- | See 'Streamly.Internal.Data.Parser.some'.
660--
661-- /Internal/
662--
663{-# INLINE some #-}
664some :: MonadCatch m => Fold m b c -> Parser m a b -> Parser m a c
665some = splitSome
666-- some f p = many (takeGE 1 f) p
667-- many = countBetween 1 maxBound
669-- | See 'Streamly.Internal.Data.Parser.countBetween'.
670--
671-- /Unimplemented/
672--
673{-# INLINE countBetween #-}
674countBetween ::
675 -- MonadCatch m =>
676 Int -> Int -> Fold m b c -> Parser m a b -> Parser m a c
677countBetween _m _n _f = undefined
678-- countBetween m n f p = many (takeBetween m n f) p
680-- | See 'Streamly.Internal.Data.Parser.count'.
681--
682-- /Unimplemented/
683--
684{-# INLINE count #-}
685count ::
686 -- MonadCatch m =>
687 Int -> Fold m b c -> Parser m a b -> Parser m a c
688count n = countBetween n n
689-- count n f p = many (takeEQ n f) p
691data ManyTillState fs sr sl = ManyTillR Int fs sr | ManyTillL fs sl
693-- | See 'Streamly.Internal.Data.Parser.manyTill'.
694--
695-- /Internal/
696--
697{-# INLINE manyTill #-}
698manyTill :: MonadCatch m
699 => Fold m b c -> Parser m a b -> Parser m a x -> Parser m a c
700manyTill (Fold fstep finitial fextract)
701 (Parser stepL initialL extractL)
702 (Parser stepR initialR _) =
703 Parser step initial extract
705 where
707 initial = do
708 fs <- finitial
709 ManyTillR 0 fs <$> initialR
711 step (ManyTillR cnt fs st) a = do
712 r <- stepR st a
713 case r of
714 Partial n s -> return $ Partial n (ManyTillR 0 fs s)
715 Continue n s -> do
716 assert (cnt + 1 - n >= 0) (return ())
717 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)
718 Done n _ -> do
719 b <- fextract fs
720 return $ Done n b
721 Error _ -> do
722 rR <- initialL
723 return $ Continue (cnt + 1) (ManyTillL fs rR)
725 step (ManyTillL fs st) a = do
726 r <- stepL st a
727 case r of
728 Partial n s -> return $ Partial n (ManyTillL fs s)
729 Continue n s -> return $ Continue n (ManyTillL fs s)
730 Done n b -> do
731 fs1 <- fstep fs b
732 l <- initialR
733 return $ Partial n (ManyTillR 0 fs1 l)
734 Error err -> return $ Error err
736 extract (ManyTillL fs sR) = extractL sR >>= fstep fs >>= fextract
737 extract (ManyTillR _ fs _) = fextract fs