3-- Module : Streamly.Internal.Data.Stream.StreamD.Nesting
4-- Copyright : (c) 2018 Composewell Technologies
5-- (c) Roman Leshchinskiy 2008-2010
6-- License : BSD-3-Clause
7-- Maintainer : streamly@composewell.com
8-- Stability : experimental
11-- This module contains transformations involving multiple streams, unfolds or
12-- folds. There are two types of transformations generational or eliminational.
13-- Generational transformations are like the "Generate" module but they
14-- generate a stream by combining streams instead of elements. Eliminational
15-- transformations are like the "Eliminate" module but they transform a stream
16-- by eliminating parts of the stream instead of eliminating the whole stream.
18-- These combinators involve transformation, generation, elimination so can be
19-- classified under any of those.
21-- Ultimately these operations should be supported by Unfolds, Pipes and Folds,
22-- and this module may become redundant.
24-- The zipWithM combinator in this module has been adapted from the vector
25-- package (c) Roman Leshchinskiy.
27module Streamly.Internal.Data.Stream.StreamD.Nesting
30 -- | Combining streams to generate streams.
32 -- ** Combine Two Streams
33 -- | Functions ending in the shape:
35 -- @t m a -> t m a -> t m a@.
38 -- | Append a stream after another. A special case of concatMap or
44 -- | Interleave elements from two streams alternately. A special case of
53 -- | Execute streams alternately irrespective of whether they generate
54 -- elements or not. Note 'interleave' would execute a stream until it
55 -- yields an element. A special case of unfoldRoundRobin.
56 , roundRobin -- interleaveFair?/ParallelFair
59 -- | Zip corresponding elements of two streams.
64 -- | Interleave elements from two streams based on a condition.
70 -- ** Combine N Streams
71 -- | Functions generally ending in these shapes:
74 -- concat: f (t m a) -> t m a
75 -- concatMap: (a -> t m b) -> t m a -> t m b
76 -- unfoldMany: Unfold m a b -> t m a -> t m b
80 -- | Generate streams by mapping a stream generator on each element of an
81 -- input stream, append the resulting streams and flatten.
86 -- | Generate streams by using an unfold on each element of an input
87 -- stream, append the resulting streams and flatten. A special case of
90 , ConcatUnfoldInterleaveState (..)
95 -- | Like unfoldMany but intersperses an effect between the streams. A
96 -- special case of gintercalate.
103 -- | Like unfoldMany but intersperses streams from another source between
104 -- the streams from the first source.
111 -- | Folding and Parsing chunks of streams to eliminate nested streams.
112 -- Functions generally ending in these shapes:
115 -- f (Fold m a b) -> t m a -> t m b
116 -- f (Parser a m b) -> t m a -> t m b
120 -- | Apply folds on a stream.
128 -- | Parsing is opposite to flattening. 'parseMany' is dual to concatMap or
129 -- unfoldMany. concatMap generates a stream from single values in a
130 -- stream and flattens, parseMany does the opposite of flattening by
131 -- splitting the stream and then folds each such split to single value in
132 -- the output stream.
141 -- | Group segments of a stream and fold. Special case of parsing.
148 -- | A special case of parsing.
154 -- XXX Implement these as folds or parsers instead.
155 , splitOnSuffixSeqAny
159 -- * Transform (Nested Containers)
160 -- | Opposite to compact in ArrayStream
165 -- * Reduce By Streams
173#include "ArrayMacros.h"
175import Control.Exception (assert)
176import Control.Monad.IO.Class (MonadIO(..))
177import Data.Bits (shiftR, shiftL, (.|.), (.&.))
178import Data.Proxy (Proxy(..))
179import Data.Word (Word32)
180import Foreign.Storable (Storable, peek)
181import Fusion.Plugin.Types (Fuse(..))
182import GHC.Types (SPEC(..))
184import Streamly.Internal.Data.Array.Type (Array(..))
185import Streamly.Internal.Data.Fold.Step (Step(..))
186import Streamly.Internal.Data.Fold.Type (Fold(..))
187import Streamly.Internal.Data.Parser (ParseError(..))
188import Streamly.Internal.Data.Refold.Type (Refold(..))
189import Streamly.Internal.Data.SVar.Type (adaptState)
190import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
191import Streamly.Internal.Data.Unbox (Unbox, sizeOf)
192import Streamly.Internal.Data.Unfold.Type (Unfold(..))
194import qualified Streamly.Internal.Data.Array.Type as A
195import qualified Streamly.Internal.Data.Fold as FL
196import qualified Streamly.Internal.Data.Parser as PR
197import qualified Streamly.Internal.Data.Parser as PRD
198import qualified Streamly.Internal.Data.Ring.Unboxed as RB
200import Streamly.Internal.Data.Stream.StreamD.Transform
201 (intersperse, intersperseMSuffix)
202import Streamly.Internal.Data.Stream.StreamD.Type
204import Prelude hiding (concatMap, mapM, zipWith)
206#include "DocTestDataStream.hs"
208------------------------------------------------------------------------------
210------------------------------------------------------------------------------
212data AppendState s1 s2 = AppendFirst s1 | AppendSecond s2
214-- | Fuses two streams sequentially, yielding all elements from the first
215-- stream, and then all elements from the second stream.
217-- >>> s1 = Stream.fromList [1,2]
218-- >>> s2 = Stream.fromList [3,4]
219-- >>> Stream.fold Fold.toList $ s1 `Stream.append` s2
222-- From an implementation perspective, StreamK.'Streamly.Data.StreamK.append'
223-- translates into a function call whereas Stream.'append' translates into a
224-- conditional branch (jump). However, the overhead of the function call in
225-- StreamK.append is incurred only once, while the overhead of the conditional
226-- branch in fused append is incurred for each element in the stream. As a
227-- result, StreamK.append has a linear time complexity of O(n), while fused
228-- append has a quadratic time complexity of O(n^2), where @n@ represents the
229-- number of 'append's used.
231-- This function should only be used to statically fuse a stream with another
232-- stream. Do not use it recursively or where it cannot be inlined. Use
233-- StreamK.'Streamly.Data.StreamK.append' for those cases.
235{-# INLINE_NORMAL append #-}
236append :: Monad m => Stream m a -> Stream m a -> Stream m a
237append (Stream step1 state1) (Stream step2 state2) =
238 Stream step (AppendFirst state1)
242 {-# INLINE_LATE step #-}
243 step gst (AppendFirst st) = do
246 Yield a s -> Yield a (AppendFirst s)
247 Skip s -> Skip (AppendFirst s)
248 Stop -> Skip (AppendSecond state2)
250 step gst (AppendSecond st) = do
253 Yield a s -> Yield a (AppendSecond s)
254 Skip s -> Skip (AppendSecond s)
257------------------------------------------------------------------------------
259------------------------------------------------------------------------------
261data InterleaveState s1 s2 = InterleaveFirst s1 s2 | InterleaveSecond s1 s2
262 | InterleaveSecondOnly s2 | InterleaveFirstOnly s1
264-- | Interleaves two streams, yielding one element from each stream
265-- alternately. When one stream stops the rest of the other stream is used in
268-- When joining many streams in a left associative manner earlier streams will
269-- get exponential priority than the ones joining later. Because of exponential
270-- weighting it can be used with 'concatMapWith' even on a large number of
273{-# INLINE_NORMAL interleave #-}
274interleave :: Monad m => Stream m a -> Stream m a -> Stream m a
275interleave (Stream step1 state1) (Stream step2 state2) =
276 Stream step (InterleaveFirst state1 state2)
280 {-# INLINE_LATE step #-}
281 step gst (InterleaveFirst st1 st2) = do
284 Yield a s -> Yield a (InterleaveSecond s st2)
285 Skip s -> Skip (InterleaveFirst s st2)
286 Stop -> Skip (InterleaveSecondOnly st2)
288 step gst (InterleaveSecond st1 st2) = do
291 Yield a s -> Yield a (InterleaveFirst st1 s)
292 Skip s -> Skip (InterleaveSecond st1 s)
293 Stop -> Skip (InterleaveFirstOnly st1)
295 step gst (InterleaveFirstOnly st1) = do
298 Yield a s -> Yield a (InterleaveFirstOnly s)
299 Skip s -> Skip (InterleaveFirstOnly s)
302 step gst (InterleaveSecondOnly st2) = do
305 Yield a s -> Yield a (InterleaveSecondOnly s)
306 Skip s -> Skip (InterleaveSecondOnly s)
309-- | Like `interleave` but stops interleaving as soon as any of the two streams
312{-# INLINE_NORMAL interleaveMin #-}
313interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a
314interleaveMin (Stream step1 state1) (Stream step2 state2) =
315 Stream step (InterleaveFirst state1 state2)
319 {-# INLINE_LATE step #-}
320 step gst (InterleaveFirst st1 st2) = do
323 Yield a s -> Yield a (InterleaveSecond s st2)
324 Skip s -> Skip (InterleaveFirst s st2)
327 step gst (InterleaveSecond st1 st2) = do
330 Yield a s -> Yield a (InterleaveFirst st1 s)
331 Skip s -> Skip (InterleaveSecond st1 s)
334 step _ (InterleaveFirstOnly _) = undefined
335 step _ (InterleaveSecondOnly _) = undefined
337-- | Interleaves the outputs of two streams, yielding elements from each stream
338-- alternately, starting from the first stream. As soon as the first stream
339-- finishes, the output stops, discarding the remaining part of the second
340-- stream. In this case, the last element in the resulting stream would be from
341-- the second stream. If the second stream finishes early then the first stream
342-- still continues to yield elements until it finishes.
344-- >>> :set -XOverloadedStrings
345-- >>> import Data.Functor.Identity (Identity)
346-- >>> Stream.interleaveFstSuffix "abc" ",,,," :: Stream Identity Char
348-- >>> Stream.interleaveFstSuffix "abc" "," :: Stream Identity Char
351-- 'interleaveFstSuffix' is a dual of 'interleaveFst'.
353-- Do not use dynamically.
356{-# INLINE_NORMAL interleaveFstSuffix #-}
357interleaveFstSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a
358interleaveFstSuffix (Stream step1 state1) (Stream step2 state2) =
359 Stream step (InterleaveFirst state1 state2)
363 {-# INLINE_LATE step #-}
364 step gst (InterleaveFirst st1 st2) = do
367 Yield a s -> Yield a (InterleaveSecond s st2)
368 Skip s -> Skip (InterleaveFirst s st2)
371 step gst (InterleaveSecond st1 st2) = do
374 Yield a s -> Yield a (InterleaveFirst st1 s)
375 Skip s -> Skip (InterleaveSecond st1 s)
376 Stop -> Skip (InterleaveFirstOnly st1)
378 step gst (InterleaveFirstOnly st1) = do
381 Yield a s -> Yield a (InterleaveFirstOnly s)
382 Skip s -> Skip (InterleaveFirstOnly s)
385 step _ (InterleaveSecondOnly _) = undefined
387data InterleaveInfixState s1 s2 a
388 = InterleaveInfixFirst s1 s2
389 | InterleaveInfixSecondBuf s1 s2
390 | InterleaveInfixSecondYield s1 s2 a
391 | InterleaveInfixFirstYield s1 s2 a
392 | InterleaveInfixFirstOnly s1
394-- | Interleaves the outputs of two streams, yielding elements from each stream
395-- alternately, starting from the first stream and ending at the first stream.
396-- If the second stream is longer than the first, elements from the second
397-- stream are infixed with elements from the first stream. If the first stream
398-- is longer then it continues yielding elements even after the second stream
401-- >>> :set -XOverloadedStrings
402-- >>> import Data.Functor.Identity (Identity)
403-- >>> Stream.interleaveFst "abc" ",,,," :: Stream Identity Char
405-- >>> Stream.interleaveFst "abc" "," :: Stream Identity Char
408-- 'interleaveFst' is a dual of 'interleaveFstSuffix'.
410-- Do not use dynamically.
413{-# INLINE_NORMAL interleaveFst #-}
414interleaveFst :: Monad m => Stream m a -> Stream m a -> Stream m a
415interleaveFst (Stream step1 state1) (Stream step2 state2) =
416 Stream step (InterleaveInfixFirst state1 state2)
420 {-# INLINE_LATE step #-}
421 step gst (InterleaveInfixFirst st1 st2) = do
424 Yield a s -> Yield a (InterleaveInfixSecondBuf s st2)
425 Skip s -> Skip (InterleaveInfixFirst s st2)
428 step gst (InterleaveInfixSecondBuf st1 st2) = do
431 Yield a s -> Skip (InterleaveInfixSecondYield st1 s a)
432 Skip s -> Skip (InterleaveInfixSecondBuf st1 s)
433 Stop -> Skip (InterleaveInfixFirstOnly st1)
435 step gst (InterleaveInfixSecondYield st1 st2 x) = do
438 Yield a s -> Yield x (InterleaveInfixFirstYield s st2 a)
439 Skip s -> Skip (InterleaveInfixSecondYield s st2 x)
442 step _ (InterleaveInfixFirstYield st1 st2 x) = do
443 return $ Yield x (InterleaveInfixSecondBuf st1 st2)
445 step gst (InterleaveInfixFirstOnly st1) = do
448 Yield a s -> Yield a (InterleaveInfixFirstOnly s)
449 Skip s -> Skip (InterleaveInfixFirstOnly s)
452------------------------------------------------------------------------------
454------------------------------------------------------------------------------
456-- | Schedule the execution of two streams in a fair round-robin manner,
457-- executing each stream once, alternately. Execution of a stream may not
458-- necessarily result in an output, a stream may choose to @Skip@ producing an
459-- element until later giving the other stream a chance to run. Therefore, this
460-- combinator fairly interleaves the execution of two streams rather than
461-- fairly interleaving the output of the two streams. This can be useful in
462-- co-operative multitasking without using explicit threads. This can be used
463-- as an alternative to `async`.
465-- Do not use dynamically.
468{-# INLINE_NORMAL roundRobin #-}
469roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a
470roundRobin (Stream step1 state1) (Stream step2 state2) =
471 Stream step (InterleaveFirst state1 state2)
475 {-# INLINE_LATE step #-}
476 step gst (InterleaveFirst st1 st2) = do
479 Yield a s -> Yield a (InterleaveSecond s st2)
480 Skip s -> Skip (InterleaveSecond s st2)
481 Stop -> Skip (InterleaveSecondOnly st2)
483 step gst (InterleaveSecond st1 st2) = do
486 Yield a s -> Yield a (InterleaveFirst st1 s)
487 Skip s -> Skip (InterleaveFirst st1 s)
488 Stop -> Skip (InterleaveFirstOnly st1)
490 step gst (InterleaveSecondOnly st2) = do
493 Yield a s -> Yield a (InterleaveSecondOnly s)
494 Skip s -> Skip (InterleaveSecondOnly s)
497 step gst (InterleaveFirstOnly st1) = do
500 Yield a s -> Yield a (InterleaveFirstOnly s)
501 Skip s -> Skip (InterleaveFirstOnly s)
504------------------------------------------------------------------------------
506------------------------------------------------------------------------------
508-- | Like 'mergeBy' but with a monadic comparison function.
510-- Merge two streams randomly:
513-- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT
514-- > Stream.toList $ Stream.mergeByM randomly (Stream.fromList [1,1,1,1]) (Stream.fromList [2,2,2,2])
518-- Merge two streams in a proportion of 2:1:
522-- let s1 = Stream.fromList [1,1,1,1,1,1]
523-- s2 = Stream.fromList [2,2,2]
524-- let proportionately m n = do
525-- ref <- newIORef $ cycle $ Prelude.concat [Prelude.replicate m LT, Prelude.replicate n GT]
526-- return $ \_ _ -> do
528-- writeIORef ref $ Prelude.tail r
529-- return $ Prelude.head r
530-- f <- proportionately 2 1
531-- xs <- Stream.fold Fold.toList $ Stream.mergeByM f s1 s2
534-- [1,1,2,1,1,2,1,1,2]
536{-# INLINE_NORMAL mergeByM #-}
539 => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
540mergeByM cmp (Stream stepa ta) (Stream stepb tb) =
541 Stream step (Just ta, Just tb, Nothing, Nothing)
543 {-# INLINE_LATE step #-}
545 -- one of the values is missing, and the corresponding stream is running
546 step gst (Just sa, sb, Nothing, b) = do
549 Yield a sa' -> Skip (Just sa', sb, Just a, b)
550 Skip sa' -> Skip (Just sa', sb, Nothing, b)
551 Stop -> Skip (Nothing, sb, Nothing, b)
553 step gst (sa, Just sb, a, Nothing) = do
556 Yield b sb' -> Skip (sa, Just sb', a, Just b)
557 Skip sb' -> Skip (sa, Just sb', a, Nothing)
558 Stop -> Skip (sa, Nothing, a, Nothing)
560 -- both the values are available
561 step _ (sa, sb, Just a, Just b) = do
564 GT -> Yield b (sa, sb, Just a, Nothing)
565 _ -> Yield a (sa, sb, Nothing, Just b)
567 -- one of the values is missing, corresponding stream is done
568 step _ (Nothing, sb, Nothing, Just b) =
569 return $ Yield b (Nothing, sb, Nothing, Nothing)
571 step _ (sa, Nothing, Just a, Nothing) =
572 return $ Yield a (sa, Nothing, Nothing, Nothing)
574 step _ (Nothing, Nothing, Nothing, Nothing) = return Stop
576-- | Merge two streams using a comparison function. The head elements of both
577-- the streams are compared and the smaller of the two elements is emitted, if
578-- both elements are equal then the element from the first stream is used
581-- If the streams are sorted in ascending order, the resulting stream would
582-- also remain sorted in ascending order.
584-- >>> s1 = Stream.fromList [1,3,5]
585-- >>> s2 = Stream.fromList [2,4,6,8]
586-- >>> Stream.fold Fold.toList $ Stream.mergeBy compare s1 s2
589{-# INLINE mergeBy #-}
592 => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a
593mergeBy cmp = mergeByM (\a b -> return $ cmp a b)
595-- | Like 'mergeByM' but stops merging as soon as any of the two streams stops.
598{-# INLINABLE mergeMinBy #-}
599mergeMinBy :: -- Monad m =>
600 (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
601mergeMinBy _f _m1 _m2 = undefined
602 -- fromStreamD $ D.mergeMinBy f (toStreamD m1) (toStreamD m2)
604-- | Like 'mergeByM' but stops merging as soon as the first stream stops.
607{-# INLINABLE mergeFstBy #-}
608mergeFstBy :: -- Monad m =>
609 (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
610mergeFstBy _f _m1 _m2 = undefined
611 -- fromStreamK $ D.mergeFstBy f (toStreamD m1) (toStreamD m2)
613-------------------------------------------------------------------------------
614-- Intersection of sorted streams
615-------------------------------------------------------------------------------
617-- Assuming the streams are sorted in ascending order
618{-# INLINE_NORMAL intersectBySorted #-}
619intersectBySorted :: Monad m
620 => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a
621intersectBySorted cmp (Stream stepa ta) (Stream stepb tb) =
623 ( ta -- left stream state
624 , tb -- right stream state
625 , Nothing -- left value
626 , Nothing -- right value
631 {-# INLINE_LATE step #-}
632 -- step 1, fetch the first value
633 step gst (sa, sb, Nothing, b) = do
636 Yield a sa' -> Skip (sa', sb, Just a, b) -- step 2/3
637 Skip sa' -> Skip (sa', sb, Nothing, b)
640 -- step 2, fetch the second value
641 step gst (sa, sb, a@(Just _), Nothing) = do
644 Yield b sb' -> Skip (sa, sb', a, Just b) -- step 3
645 Skip sb' -> Skip (sa, sb', a, Nothing)
648 -- step 3, compare the two values
649 step _ (sa, sb, Just a, Just b) = do
652 GT -> Skip (sa, sb, Just a, Nothing) -- step 2
653 LT -> Skip (sa, sb, Nothing, Just b) -- step 1
654 EQ -> Yield a (sa, sb, Nothing, Just b) -- step 1
656------------------------------------------------------------------------------
657-- Combine N Streams - unfoldMany
658------------------------------------------------------------------------------
660data ConcatUnfoldInterleaveState o i =
661 ConcatUnfoldInterleaveOuter o [i]
662 | ConcatUnfoldInterleaveInner o [i]
663 | ConcatUnfoldInterleaveInnerL [i] [i]
664 | ConcatUnfoldInterleaveInnerR [i] [i]
666-- XXX use arrays to store state instead of lists?
668-- XXX In general we can use different scheduling strategies e.g. how to
669-- schedule the outer vs inner loop or assigning weights to different streams
670-- or outer and inner loops.
672-- After a yield, switch to the next stream. Do not switch streams on Skip.
673-- Yield from outer stream switches to the inner stream.
675-- There are two choices here, (1) exhaust the outer stream first and then
676-- start yielding from the inner streams, this is much simpler to implement,
677-- (2) yield at least one element from an inner stream before going back to
678-- outer stream and opening the next stream from it.
680-- Ideally, we need some scheduling bias to inner streams vs outer stream.
681-- Maybe we can configure the behavior.
683-- XXX Instead of using "concatPairsWith wSerial" we can implement an N-way
684-- interleaving CPS combinator which behaves like unfoldInterleave. Instead
685-- of pairing up the streams we just need to go yielding one element from each
686-- stream and storing the remaining streams and then keep doing rounds through
687-- those in a round robin fashion. This would be much like wAsync.
689-- | This does not pair streams like mergeMapWith, instead, it goes through
690-- each stream one by one and yields one element from each stream. After it
691-- goes to the last stream it reverses the traversal to come back to the first
692-- stream yielding elements from each stream on its way back to the first
695-- >>> lists = Stream.fromList [[1,1],[2,2],[3,3],[4,4],[5,5]]
696-- >>> interleaved = Stream.unfoldInterleave Unfold.fromList lists
697-- >>> Stream.fold Fold.toList interleaved
698-- [1,2,3,4,5,5,4,3,2,1]
700-- Note that this is order of magnitude more efficient than "mergeMapWith
701-- interleave" because of fusion.
703{-# INLINE_NORMAL unfoldInterleave #-}
704unfoldInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b
705unfoldInterleave (Unfold istep inject) (Stream ostep ost) =
706 Stream step (ConcatUnfoldInterleaveOuter ost [])
710 {-# INLINE_LATE step #-}
711 step gst (ConcatUnfoldInterleaveOuter o ls) = do
712 r <- ostep (adaptState gst) o
716 i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))
717 Skip o' -> return $ Skip (ConcatUnfoldInterleaveOuter o' ls)
718 Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
720 step _ (ConcatUnfoldInterleaveInner _ []) = undefined
721 step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do
724 Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))
725 Skip s -> Skip (ConcatUnfoldInterleaveInner o (s:ls))
726 Stop -> Skip (ConcatUnfoldInterleaveOuter o ls)
728 step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop
729 step _ (ConcatUnfoldInterleaveInnerL [] rs) =
730 return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)
732 step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do
735 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))
736 Skip s -> Skip (ConcatUnfoldInterleaveInnerL (s:ls) rs)
737 Stop -> Skip (ConcatUnfoldInterleaveInnerL ls rs)
739 step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop
740 step _ (ConcatUnfoldInterleaveInnerR ls []) =
741 return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
743 step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do
746 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)
747 Skip s -> Skip (ConcatUnfoldInterleaveInnerR ls (s:rs))
748 Stop -> Skip (ConcatUnfoldInterleaveInnerR ls rs)
750-- XXX In general we can use different scheduling strategies e.g. how to
751-- schedule the outer vs inner loop or assigning weights to different streams
752-- or outer and inner loops.
754-- This could be inefficient if the tasks are too small.
756-- Compared to unfoldInterleave this one switches streams on Skips.
758-- | 'unfoldInterleave' switches to the next stream whenever a value from a
759-- stream is yielded, it does not switch on a 'Skip'. So if a stream keeps
760-- skipping for long time other streams won't get a chance to run.
761-- 'unfoldRoundRobin' switches on Skip as well. So it basically schedules each
762-- stream fairly irrespective of whether it produces a value or not.
764{-# INLINE_NORMAL unfoldRoundRobin #-}
765unfoldRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b
766unfoldRoundRobin (Unfold istep inject) (Stream ostep ost) =
767 Stream step (ConcatUnfoldInterleaveOuter ost [])
769 {-# INLINE_LATE step #-}
770 step gst (ConcatUnfoldInterleaveOuter o ls) = do
771 r <- ostep (adaptState gst) o
775 i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))
776 Skip o' -> return $ Skip (ConcatUnfoldInterleaveInner o' ls)
777 Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
779 step _ (ConcatUnfoldInterleaveInner o []) =
780 return $ Skip (ConcatUnfoldInterleaveOuter o [])
782 step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do
785 Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))
786 Skip s -> Skip (ConcatUnfoldInterleaveOuter o (s:ls))
787 Stop -> Skip (ConcatUnfoldInterleaveOuter o ls)
789 step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop
790 step _ (ConcatUnfoldInterleaveInnerL [] rs) =
791 return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)
793 step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do
796 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))
797 Skip s -> Skip (ConcatUnfoldInterleaveInnerL ls (s:rs))
798 Stop -> Skip (ConcatUnfoldInterleaveInnerL ls rs)
800 step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop
801 step _ (ConcatUnfoldInterleaveInnerR ls []) =
802 return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
804 step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do
807 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)
808 Skip s -> Skip (ConcatUnfoldInterleaveInnerR (s:ls) rs)
809 Stop -> Skip (ConcatUnfoldInterleaveInnerR ls rs)
811------------------------------------------------------------------------------
812-- Combine N Streams - interpose
813------------------------------------------------------------------------------
815{-# ANN type InterposeSuffixState Fuse #-}
816data InterposeSuffixState s1 i1 =
817 InterposeSuffixFirst s1
818 -- | InterposeSuffixFirstYield s1 i1
819 | InterposeSuffixFirstInner s1 i1
820 | InterposeSuffixSecond s1
822-- Note that if an unfolded layer turns out to be nil we still emit the
823-- separator effect. An alternate behavior could be to emit the separator
824-- effect only if at least one element has been yielded by the unfolding.
825-- However, that becomes a bit complicated, so we have chosen the former
827{-# INLINE_NORMAL interposeSuffixM #-}
830 => m c -> Unfold m b c -> Stream m b -> Stream m c
833 (Unfold istep1 inject1) (Stream step1 state1) =
834 Stream step (InterposeSuffixFirst state1)
838 {-# INLINE_LATE step #-}
839 step gst (InterposeSuffixFirst s1) = do
840 r <- step1 (adaptState gst) s1
844 i `seq` return (Skip (InterposeSuffixFirstInner s i))
845 -- i `seq` return (Skip (InterposeSuffixFirstYield s i))
846 Skip s -> return $ Skip (InterposeSuffixFirst s)
850 step _ (InterposeSuffixFirstYield s1 i1) = do
853 Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')
854 Skip i' -> Skip (InterposeSuffixFirstYield s1 i')
855 Stop -> Skip (InterposeSuffixFirst s1)
858 step _ (InterposeSuffixFirstInner s1 i1) = do
861 Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')
862 Skip i' -> Skip (InterposeSuffixFirstInner s1 i')
863 Stop -> Skip (InterposeSuffixSecond s1)
865 step _ (InterposeSuffixSecond s1) = do
867 return $ Yield r (InterposeSuffixFirst s1)
869-- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x)
871-- | Unfold the elements of a stream, append the given element after each
872-- unfolded stream and then concat them into a single stream.
874-- >>> unlines = Stream.interposeSuffix '\n'
877{-# INLINE interposeSuffix #-}
878interposeSuffix :: Monad m
879 => c -> Unfold m b c -> Stream m b -> Stream m c
880interposeSuffix x = interposeSuffixM (return x)
882{-# ANN type InterposeState Fuse #-}
883data InterposeState s1 i1 a =
885 -- | InterposeFirstYield s1 i1
886 | InterposeFirstInner s1 i1
887 | InterposeFirstInject s1
888 -- | InterposeFirstBuf s1 i1
889 | InterposeSecondYield s1 i1
890 -- -- | InterposeSecondYield s1 i1 a
891 -- -- | InterposeFirstResume s1 i1 a
893-- Note that this only interposes the pure values, we may run many effects to
894-- generate those values as some effects may not generate anything (Skip).
895{-# INLINE_NORMAL interposeM #-}
896interposeM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c
899 (Unfold istep1 inject1) (Stream step1 state1) =
900 Stream step (InterposeFirst state1)
904 {-# INLINE_LATE step #-}
905 step gst (InterposeFirst s1) = do
906 r <- step1 (adaptState gst) s1
910 i `seq` return (Skip (InterposeFirstInner s i))
911 -- i `seq` return (Skip (InterposeFirstYield s i))
912 Skip s -> return $ Skip (InterposeFirst s)
916 step _ (InterposeFirstYield s1 i1) = do
919 Yield x i' -> Yield x (InterposeFirstInner s1 i')
920 Skip i' -> Skip (InterposeFirstYield s1 i')
921 Stop -> Skip (InterposeFirst s1)
924 step _ (InterposeFirstInner s1 i1) = do
927 Yield x i' -> Yield x (InterposeFirstInner s1 i')
928 Skip i' -> Skip (InterposeFirstInner s1 i')
929 Stop -> Skip (InterposeFirstInject s1)
931 step gst (InterposeFirstInject s1) = do
932 r <- step1 (adaptState gst) s1
936 -- i `seq` return (Skip (InterposeFirstBuf s i))
937 i `seq` return (Skip (InterposeSecondYield s i))
938 Skip s -> return $ Skip (InterposeFirstInject s)
942 step _ (InterposeFirstBuf s1 i1) = do
945 Yield x i' -> Skip (InterposeSecondYield s1 i' x)
946 Skip i' -> Skip (InterposeFirstBuf s1 i')
951 step _ (InterposeSecondYield s1 i1 v) = do
953 return $ Yield r (InterposeFirstResume s1 i1 v)
955 step _ (InterposeSecondYield s1 i1) = do
957 return $ Yield r (InterposeFirstInner s1 i1)
960 step _ (InterposeFirstResume s1 i1 v) = do
961 return $ Yield v (InterposeFirstInner s1 i1)
964-- > interpose x unf str = gintercalate unf str UF.identity (repeat x)
966-- | Unfold the elements of a stream, intersperse the given element between the
967-- unfolded streams and then concat them into a single stream.
969-- >>> unwords = Stream.interpose ' '
972{-# INLINE interpose #-}
974 => c -> Unfold m b c -> Stream m b -> Stream m c
975interpose x = interposeM (return x)
977------------------------------------------------------------------------------
978-- Combine N Streams - intercalate
979------------------------------------------------------------------------------
981data ICUState s1 s2 i1 i2 =
986 | ICUFirstInner s1 s2 i1
987 | ICUSecondInner s1 s2 i2
988 | ICUFirstOnlyInner s1 i1
989 | ICUSecondOnlyInner s2 i2
991-- | 'interleaveFstSuffix' followed by unfold and concat.
994{-# INLINE_NORMAL gintercalateSuffix #-}
997 => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
999 (Unfold istep1 inject1) (Stream step1 state1)
1000 (Unfold istep2 inject2) (Stream step2 state2) =
1001 Stream step (ICUFirst state1 state2)
1005 {-# INLINE_LATE step #-}
1006 step gst (ICUFirst s1 s2) = do
1007 r <- step1 (adaptState gst) s1
1011 i `seq` return (Skip (ICUFirstInner s s2 i))
1012 Skip s -> return $ Skip (ICUFirst s s2)
1015 step gst (ICUFirstOnly s1) = do
1016 r <- step1 (adaptState gst) s1
1020 i `seq` return (Skip (ICUFirstOnlyInner s i))
1021 Skip s -> return $ Skip (ICUFirstOnly s)
1024 step _ (ICUFirstInner s1 s2 i1) = do
1027 Yield x i' -> Yield x (ICUFirstInner s1 s2 i')
1028 Skip i' -> Skip (ICUFirstInner s1 s2 i')
1029 Stop -> Skip (ICUSecond s1 s2)
1031 step _ (ICUFirstOnlyInner s1 i1) = do
1034 Yield x i' -> Yield x (ICUFirstOnlyInner s1 i')
1035 Skip i' -> Skip (ICUFirstOnlyInner s1 i')
1036 Stop -> Skip (ICUFirstOnly s1)
1038 step gst (ICUSecond s1 s2) = do
1039 r <- step2 (adaptState gst) s2
1043 i `seq` return (Skip (ICUSecondInner s1 s i))
1044 Skip s -> return $ Skip (ICUSecond s1 s)
1045 Stop -> return $ Skip (ICUFirstOnly s1)
1047 step _ (ICUSecondInner s1 s2 i2) = do
1050 Yield x i' -> Yield x (ICUSecondInner s1 s2 i')
1051 Skip i' -> Skip (ICUSecondInner s1 s2 i')
1052 Stop -> Skip (ICUFirst s1 s2)
1054 step _ (ICUSecondOnly _s2) = undefined
1055 step _ (ICUSecondOnlyInner _s2 _i2) = undefined
1057data ICALState s1 s2 i1 i2 a =
1059 -- | ICALFirstYield s1 s2 i1
1060 | ICALFirstInner s1 s2 i1
1062 | ICALFirstOnlyInner s1 i1
1063 | ICALSecondInject s1 s2
1064 | ICALFirstInject s1 s2 i2
1065 -- | ICALFirstBuf s1 s2 i1 i2
1066 | ICALSecondInner s1 s2 i1 i2
1067 -- -- | ICALSecondInner s1 s2 i1 i2 a
1068 -- -- | ICALFirstResume s1 s2 i1 i2 a
1070-- XXX we can swap the order of arguments to gintercalate so that the
1071-- definition of unfoldMany becomes simpler? The first stream should be
1072-- infixed inside the second one. However, if we change the order in
1073-- "interleave" as well similarly, then that will make it a bit unintuitive.
1075-- > unfoldMany unf str =
1076-- > gintercalate unf str (UF.nilM (\_ -> return ())) (repeat ())
1078-- | 'interleaveFst' followed by unfold and concat.
1081{-# INLINE_NORMAL gintercalate #-}
1084 => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
1086 (Unfold istep1 inject1) (Stream step1 state1)
1087 (Unfold istep2 inject2) (Stream step2 state2) =
1088 Stream step (ICALFirst state1 state2)
1092 {-# INLINE_LATE step #-}
1093 step gst (ICALFirst s1 s2) = do
1094 r <- step1 (adaptState gst) s1
1098 i `seq` return (Skip (ICALFirstInner s s2 i))
1099 -- i `seq` return (Skip (ICALFirstYield s s2 i))
1100 Skip s -> return $ Skip (ICALFirst s s2)
1104 step _ (ICALFirstYield s1 s2 i1) = do
1107 Yield x i' -> Yield x (ICALFirstInner s1 s2 i')
1108 Skip i' -> Skip (ICALFirstYield s1 s2 i')
1109 Stop -> Skip (ICALFirst s1 s2)
1112 step _ (ICALFirstInner s1 s2 i1) = do
1115 Yield x i' -> Yield x (ICALFirstInner s1 s2 i')
1116 Skip i' -> Skip (ICALFirstInner s1 s2 i')
1117 Stop -> Skip (ICALSecondInject s1 s2)
1119 step gst (ICALFirstOnly s1) = do
1120 r <- step1 (adaptState gst) s1
1124 i `seq` return (Skip (ICALFirstOnlyInner s i))
1125 Skip s -> return $ Skip (ICALFirstOnly s)
1128 step _ (ICALFirstOnlyInner s1 i1) = do
1131 Yield x i' -> Yield x (ICALFirstOnlyInner s1 i')
1132 Skip i' -> Skip (ICALFirstOnlyInner s1 i')
1133 Stop -> Skip (ICALFirstOnly s1)
1135 -- We inject the second stream even before checking if the first stream
1136 -- would yield any more elements. There is no clear choice whether we
1137 -- should do this before or after that. Doing it after may make the state
1138 -- machine a bit simpler though.
1139 step gst (ICALSecondInject s1 s2) = do
1140 r <- step2 (adaptState gst) s2
1144 i `seq` return (Skip (ICALFirstInject s1 s i))
1145 Skip s -> return $ Skip (ICALSecondInject s1 s)
1146 Stop -> return $ Skip (ICALFirstOnly s1)
1148 step gst (ICALFirstInject s1 s2 i2) = do
1149 r <- step1 (adaptState gst) s1
1153 i `seq` return (Skip (ICALSecondInner s s2 i i2))
1154 -- i `seq` return (Skip (ICALFirstBuf s s2 i i2))
1155 Skip s -> return $ Skip (ICALFirstInject s s2 i2)
1159 step _ (ICALFirstBuf s1 s2 i1 i2) = do
1162 Yield x i' -> Skip (ICALSecondInner s1 s2 i' i2 x)
1163 Skip i' -> Skip (ICALFirstBuf s1 s2 i' i2)
1166 step _ (ICALSecondInner s1 s2 i1 i2 v) = do
1169 Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i' v)
1170 Skip i' -> Skip (ICALSecondInner s1 s2 i1 i' v)
1171 Stop -> Skip (ICALFirstResume s1 s2 i1 i2 v)
1174 step _ (ICALSecondInner s1 s2 i1 i2) = do
1177 Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i')
1178 Skip i' -> Skip (ICALSecondInner s1 s2 i1 i')
1179 Stop -> Skip (ICALFirstInner s1 s2 i1)
1180 -- Stop -> Skip (ICALFirstResume s1 s2 i1 i2)
1183 step _ (ICALFirstResume s1 s2 i1 i2 x) = do
1184 return $ Yield x (ICALFirstInner s1 s2 i1 i2)
1187-- > intercalateSuffix unf seed str = gintercalateSuffix unf str unf (repeatM seed)
1189-- | 'intersperseMSuffix' followed by unfold and concat.
1191-- >>> intercalateSuffix u a = Stream.unfoldMany u . Stream.intersperseMSuffix a
1192-- >>> intersperseMSuffix = Stream.intercalateSuffix Unfold.identity
1193-- >>> unlines = Stream.intercalateSuffix Unfold.fromList "\n"
1195-- >>> input = Stream.fromList ["abc", "def", "ghi"]
1196-- >>> Stream.fold Fold.toList $ Stream.intercalateSuffix Unfold.fromList "\n" input
1199{-# INLINE intercalateSuffix #-}
1200intercalateSuffix :: Monad m
1201 => Unfold m b c -> b -> Stream m b -> Stream m c
1202intercalateSuffix unf seed = unfoldMany unf . intersperseMSuffix (return seed)
1204-- > intercalate unf seed str = gintercalate unf str unf (repeatM seed)
1206-- | 'intersperse' followed by unfold and concat.
1208-- >>> intercalate u a = Stream.unfoldMany u . Stream.intersperse a
1209-- >>> intersperse = Stream.intercalate Unfold.identity
1210-- >>> unwords = Stream.intercalate Unfold.fromList " "
1212-- >>> input = Stream.fromList ["abc", "def", "ghi"]
1213-- >>> Stream.fold Fold.toList $ Stream.intercalate Unfold.fromList " " input
1216{-# INLINE intercalate #-}
1217intercalate :: Monad m
1218 => Unfold m b c -> b -> Stream m b -> Stream m c
1219intercalate unf seed str = unfoldMany unf $ intersperse seed str
1221------------------------------------------------------------------------------
1223------------------------------------------------------------------------------
1225-- | Apply a stream of folds to an input stream and emit the results in the
1230{-# INLINE foldSequence #-}
1233 Stream m (Fold m a b)
1236foldSequence _f _m = undefined
1238{-# ANN type FIterState Fuse #-}
1239data FIterState s f m a b
1241 | forall fs. FIterStream s (fs -> a -> m (FL.Step fs b)) fs (fs -> m b)
1242 | FIterYield b (FIterState s f m a b)
1245-- | Iterate a fold generator on a stream. The initial value @b@ is used to
1246-- generate the first fold, the fold is applied on the stream and the result of
1247-- the fold is used to generate the next fold and so on.
1249-- >>> import Data.Monoid (Sum(..))
1250-- >>> f x = return (Fold.take 2 (Fold.sconcat x))
1251-- >>> s = fmap Sum $ Stream.fromList [1..10]
1252-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.foldIterateM f (pure 0) s
1253-- [3,10,21,36,55,55]
1255-- This is the streaming equivalent of monad like sequenced application of
1256-- folds where next fold is dependent on the previous fold.
1260{-# INLINE_NORMAL foldIterateM #-}
1262 Monad m => (b -> m (FL.Fold m a b)) -> m b -> Stream m a -> Stream m b
1263foldIterateM func seed0 (Stream step state) =
1264 Stream stepOuter (FIterInit state seed0)
1268 {-# INLINE iterStep #-}
1269 iterStep from st fstep extract = do
1274 FL.Partial fs -> FIterStream st fstep fs extract
1275 FL.Done fb -> FIterYield fb $ FIterInit st (return fb)
1277 {-# INLINE_LATE stepOuter #-}
1278 stepOuter _ (FIterInit st seed) = do
1279 (FL.Fold fstep initial extract) <- seed >>= func
1280 iterStep initial st fstep extract
1281 stepOuter gst (FIterStream st fstep fs extract) = do
1282 r <- step (adaptState gst) st
1285 iterStep (fstep fs x) s fstep extract
1286 Skip s -> return $ Skip $ FIterStream s fstep fs extract
1289 return $ Skip $ FIterYield b FIterStop
1290 stepOuter _ (FIterYield a next) = return $ Yield a next
1291 stepOuter _ FIterStop = return Stop
1293{-# ANN type CIterState Fuse #-}
1294data CIterState s f fs b
1297 | CIterYield b (CIterState s f fs b)
1300-- | Like 'foldIterateM' but using the 'Refold' type instead. This could be
1301-- much more efficient due to stream fusion.
1304{-# INLINE_NORMAL refoldIterateM #-}
1306 Monad m => Refold m b a b -> m b -> Stream m a -> Stream m b
1307refoldIterateM (Refold fstep finject fextract) initial (Stream step state) =
1308 Stream stepOuter (CIterInit state initial)
1312 {-# INLINE iterStep #-}
1313 iterStep st action = do
1318 FL.Partial fs -> CIterConsume st fs
1319 FL.Done fb -> CIterYield fb $ CIterInit st (return fb)
1321 {-# INLINE_LATE stepOuter #-}
1322 stepOuter _ (CIterInit st action) = do
1323 iterStep st (action >>= finject)
1324 stepOuter gst (CIterConsume st fs) = do
1325 r <- step (adaptState gst) st
1327 Yield x s -> iterStep s (fstep fs x)
1328 Skip s -> return $ Skip $ CIterConsume s fs
1331 return $ Skip $ CIterYield b CIterStop
1332 stepOuter _ (CIterYield a next) = return $ Yield a next
1333 stepOuter _ CIterStop = return Stop
1335-- "n" elements at the end are dropped by the fold.
1336{-# INLINE sliceBy #-}
1337sliceBy :: Monad m => Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)
1338sliceBy (Fold step1 initial1 extract1) n = Refold step inject extract
1342 inject (i, len) = do
1345 Partial s -> Partial $ Tuple' (i + len + n) s
1346 Done l -> Done (i, l)
1348 step (Tuple' i s) x = do
1351 Partial s1 -> Partial $ Tuple' i s1
1352 Done len -> Done (i, len)
1354 extract (Tuple' i s) = (i,) <$> extract1 s
1356{-# INLINE sliceOnSuffix #-}
1357sliceOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)
1358sliceOnSuffix predicate =
1359 -- Scan the stream with the given refold
1361 (sliceBy (FL.takeEndBy_ predicate FL.length) 1)
1364------------------------------------------------------------------------------
1366------------------------------------------------------------------------------
1368{-# ANN type ParseChunksState Fuse #-}
1369data ParseChunksState x inpBuf st pst =
1370 ParseChunksInit inpBuf st
1371 | ParseChunksInitBuf inpBuf
1372 | ParseChunksInitLeftOver inpBuf
1373 | ParseChunksStream st inpBuf !pst
1374 | ParseChunksStop inpBuf !pst
1375 | ParseChunksBuf inpBuf st inpBuf !pst
1376 | ParseChunksExtract inpBuf inpBuf !pst
1377 | ParseChunksYield x (ParseChunksState x inpBuf st pst)
1379-- XXX return the remaining stream as part of the error.
1380-- XXX This is in fact parseMany1 (a la foldMany1). Do we need a parseMany as
1382{-# INLINE_NORMAL parseManyD #-}
1387 -> Stream m (Either ParseError b)
1388parseManyD (PRD.Parser pstep initial extract) (Stream step state) =
1389 Stream stepOuter (ParseChunksInit [] state)
1393 {-# INLINE_LATE stepOuter #-}
1394 -- Buffer is empty, get the first element from the stream, initialize the
1395 -- fold and then go to stream processing loop.
1396 stepOuter gst (ParseChunksInit [] st) = do
1397 r <- step (adaptState gst) st
1403 return $ Skip $ ParseChunksBuf [x] s [] ps
1405 let next = ParseChunksInit [x] s
1406 in return $ Skip $ ParseChunksYield (Right pb) next
1411 (Left (ParseError err))
1412 (ParseChunksInitLeftOver [])
1413 Skip s -> return $ Skip $ ParseChunksInit [] s
1416 -- Buffer is not empty, go to buffered processing loop
1417 stepOuter _ (ParseChunksInit src st) = do
1421 return $ Skip $ ParseChunksBuf src st [] ps
1423 let next = ParseChunksInit src st
1424 in return $ Skip $ ParseChunksYield (Right pb) next
1429 (Left (ParseError err))
1430 (ParseChunksInitLeftOver [])
1432 -- This is simplified ParseChunksInit
1433 stepOuter _ (ParseChunksInitBuf src) = do
1437 return $ Skip $ ParseChunksExtract src [] ps
1439 let next = ParseChunksInitBuf src
1440 in return $ Skip $ ParseChunksYield (Right pb) next
1445 (Left (ParseError err))
1446 (ParseChunksInitLeftOver [])
1448 -- XXX we just discard any leftover input at the end
1449 stepOuter _ (ParseChunksInitLeftOver _) = return Stop
1451 -- Buffer is empty, process elements from the stream
1452 stepOuter gst (ParseChunksStream st buf pst) = do
1453 r <- step (adaptState gst) st
1458 PR.Partial 0 pst1 ->
1459 return $ Skip $ ParseChunksStream s [] pst1
1460 PR.Partial n pst1 -> do
1461 assert (n <= length (x:buf)) (return ())
1462 let src0 = Prelude.take n (x:buf)
1463 src = Prelude.reverse src0
1464 return $ Skip $ ParseChunksBuf src s [] pst1
1465 PR.Continue 0 pst1 ->
1466 return $ Skip $ ParseChunksStream s (x:buf) pst1
1467 PR.Continue n pst1 -> do
1468 assert (n <= length (x:buf)) (return ())
1469 let (src0, buf1) = splitAt n (x:buf)
1470 src = Prelude.reverse src0
1471 return $ Skip $ ParseChunksBuf src s buf1 pst1
1474 ParseChunksYield (Right b) (ParseChunksInit [] s)
1476 assert (n <= length (x:buf)) (return ())
1477 let src = Prelude.reverse (Prelude.take n (x:buf))
1479 ParseChunksYield (Right b) (ParseChunksInit src s)
1484 (Left (ParseError err))
1485 (ParseChunksInitLeftOver [])
1486 Skip s -> return $ Skip $ ParseChunksStream s buf pst
1487 Stop -> return $ Skip $ ParseChunksStop buf pst
1489 -- go back to stream processing mode
1490 stepOuter _ (ParseChunksBuf [] s buf pst) =
1491 return $ Skip $ ParseChunksStream s buf pst
1493 -- buffered processing loop
1494 stepOuter _ (ParseChunksBuf (x:xs) s buf pst) = do
1497 PR.Partial 0 pst1 ->
1498 return $ Skip $ ParseChunksBuf xs s [] pst1
1499 PR.Partial n pst1 -> do
1500 assert (n <= length (x:buf)) (return ())
1501 let src0 = Prelude.take n (x:buf)
1502 src = Prelude.reverse src0 ++ xs
1503 return $ Skip $ ParseChunksBuf src s [] pst1
1504 PR.Continue 0 pst1 ->
1505 return $ Skip $ ParseChunksBuf xs s (x:buf) pst1
1506 PR.Continue n pst1 -> do
1507 assert (n <= length (x:buf)) (return ())
1508 let (src0, buf1) = splitAt n (x:buf)
1509 src = Prelude.reverse src0 ++ xs
1510 return $ Skip $ ParseChunksBuf src s buf1 pst1
1514 $ ParseChunksYield (Right b) (ParseChunksInit xs s)
1516 assert (n <= length (x:buf)) (return ())
1517 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1519 $ ParseChunksYield (Right b) (ParseChunksInit src s)
1524 (Left (ParseError err))
1525 (ParseChunksInitLeftOver [])
1527 -- This is simplified ParseChunksBuf
1528 stepOuter _ (ParseChunksExtract [] buf pst) =
1529 return $ Skip $ ParseChunksStop buf pst
1531 stepOuter _ (ParseChunksExtract (x:xs) buf pst) = do
1534 PR.Partial 0 pst1 ->
1535 return $ Skip $ ParseChunksExtract xs [] pst1
1536 PR.Partial n pst1 -> do
1537 assert (n <= length (x:buf)) (return ())
1538 let src0 = Prelude.take n (x:buf)
1539 src = Prelude.reverse src0 ++ xs
1540 return $ Skip $ ParseChunksExtract src [] pst1
1541 PR.Continue 0 pst1 ->
1542 return $ Skip $ ParseChunksExtract xs (x:buf) pst1
1543 PR.Continue n pst1 -> do
1544 assert (n <= length (x:buf)) (return ())
1545 let (src0, buf1) = splitAt n (x:buf)
1546 src = Prelude.reverse src0 ++ xs
1547 return $ Skip $ ParseChunksExtract src buf1 pst1
1551 $ ParseChunksYield (Right b) (ParseChunksInitBuf xs)
1553 assert (n <= length (x:buf)) (return ())
1554 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1557 $ ParseChunksYield (Right b) (ParseChunksInitBuf src)
1562 (Left (ParseError err))
1563 (ParseChunksInitLeftOver [])
1565 -- This is simplified ParseChunksExtract
1566 stepOuter _ (ParseChunksStop buf pst) = do
1569 PR.Partial _ _ -> error "Bug: parseMany: Partial in extract"
1570 PR.Continue 0 pst1 ->
1571 return $ Skip $ ParseChunksStop buf pst1
1572 PR.Continue n pst1 -> do
1573 assert (n <= length buf) (return ())
1574 let (src0, buf1) = splitAt n buf
1575 src = Prelude.reverse src0
1576 return $ Skip $ ParseChunksExtract src buf1 pst1
1579 ParseChunksYield (Right b) (ParseChunksInitLeftOver [])
1581 assert (n <= length buf) (return ())
1582 let src = Prelude.reverse (Prelude.take n buf)
1584 ParseChunksYield (Right b) (ParseChunksInitBuf src)
1589 (Left (ParseError err))
1590 (ParseChunksInitLeftOver [])
1592 stepOuter _ (ParseChunksYield a next) = return $ Yield a next
1594-- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the
1599-- >>> s = Stream.fromList [1..10]
1600-- >>> parser = Parser.takeBetween 0 2 Fold.sum
1601-- >>> Stream.fold Fold.toList $ Stream.parseMany parser s
1602-- [Right 3,Right 7,Right 11,Right 15,Right 19]
1604-- This is the streaming equivalent of the 'Streamly.Data.Parser.many' parse
1607-- Known Issues: When the parser fails there is no way to get the remaining
1610{-# INLINE parseMany #-}
1615 -> Stream m (Either ParseError b)
1616parseMany = parseManyD
1618-- | Apply a stream of parsers to an input stream and emit the results in the
1623{-# INLINE parseSequence #-}
1626 Stream m (PR.Parser a m b)
1629parseSequence _f _m = undefined
1631-- XXX Change the parser arguments' order
1633-- | @parseManyTill collect test stream@ tries the parser @test@ on the input,
1634-- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds
1635-- @test@ is tried again and so on. The parser stops when @test@ succeeds. The
1636-- output of @test@ is discarded and the output of @collect@ is emitted in the
1637-- output stream. The parser fails if @collect@ fails.
1641{-# INLINE parseManyTill #-}
1648parseManyTill = undefined
1650{-# ANN type ConcatParseState Fuse #-}
1651data ConcatParseState c b inpBuf st p m a =
1652 ConcatParseInit inpBuf st p
1653 | ConcatParseInitBuf inpBuf p
1654 | ConcatParseInitLeftOver inpBuf
1655 | forall s. ConcatParseStop
1656 inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1657 | forall s. ConcatParseStream
1658 st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1659 | forall s. ConcatParseBuf
1660 inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1661 | forall s. ConcatParseExtract
1662 inpBuf inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1663 | ConcatParseYield c (ConcatParseState c b inpBuf st p m a)
1665-- XXX Review the changes
1666{-# INLINE_NORMAL parseIterateD #-}
1669 => (b -> PRD.Parser a m b)
1672 -> Stream m (Either ParseError b)
1673parseIterateD func seed (Stream step state) =
1674 Stream stepOuter (ConcatParseInit [] state (func seed))
1678 {-# INLINE_LATE stepOuter #-}
1679 -- Buffer is empty, go to stream processing loop
1680 stepOuter _ (ConcatParseInit [] st (PRD.Parser pstep initial extract)) = do
1684 return $ Skip $ ConcatParseStream st [] pstep ps extract
1686 let next = ConcatParseInit [] st (func pb)
1687 in return $ Skip $ ConcatParseYield (Right pb) next
1692 (Left (ParseError err))
1693 (ConcatParseInitLeftOver [])
1695 -- Buffer is not empty, go to buffered processing loop
1696 stepOuter _ (ConcatParseInit src st
1697 (PRD.Parser pstep initial extract)) = do
1701 return $ Skip $ ConcatParseBuf src st [] pstep ps extract
1703 let next = ConcatParseInit src st (func pb)
1704 in return $ Skip $ ConcatParseYield (Right pb) next
1709 (Left (ParseError err))
1710 (ConcatParseInitLeftOver [])
1712 -- This is simplified ConcatParseInit
1713 stepOuter _ (ConcatParseInitBuf src
1714 (PRD.Parser pstep initial extract)) = do
1718 return $ Skip $ ConcatParseExtract src [] pstep ps extract
1720 let next = ConcatParseInitBuf src (func pb)
1721 in return $ Skip $ ConcatParseYield (Right pb) next
1726 (Left (ParseError err))
1727 (ConcatParseInitLeftOver [])
1729 -- XXX we just discard any leftover input at the end
1730 stepOuter _ (ConcatParseInitLeftOver _) = return Stop
1732 -- Buffer is empty process elements from the stream
1733 stepOuter gst (ConcatParseStream st buf pstep pst extract) = do
1734 r <- step (adaptState gst) st
1739 PR.Partial 0 pst1 ->
1740 return $ Skip $ ConcatParseStream s [] pstep pst1 extract
1741 PR.Partial n pst1 -> do
1742 assert (n <= length (x:buf)) (return ())
1743 let src0 = Prelude.take n (x:buf)
1744 src = Prelude.reverse src0
1745 return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract
1746 -- PR.Continue 0 pst1 ->
1747 -- return $ Skip $ ConcatParseStream s (x:buf) pst1
1748 PR.Continue n pst1 -> do
1749 assert (n <= length (x:buf)) (return ())
1750 let (src0, buf1) = splitAt n (x:buf)
1751 src = Prelude.reverse src0
1752 return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract
1753 -- XXX Specialize for Stop 0 common case?
1755 assert (n <= length (x:buf)) (return ())
1756 let src = Prelude.reverse (Prelude.take n (x:buf))
1758 ConcatParseYield (Right b) (ConcatParseInit src s (func b))
1763 (Left (ParseError err))
1764 (ConcatParseInitLeftOver [])
1765 Skip s -> return $ Skip $ ConcatParseStream s buf pstep pst extract
1766 Stop -> return $ Skip $ ConcatParseStop buf pstep pst extract
1768 -- go back to stream processing mode
1769 stepOuter _ (ConcatParseBuf [] s buf pstep ps extract) =
1770 return $ Skip $ ConcatParseStream s buf pstep ps extract
1772 -- buffered processing loop
1773 stepOuter _ (ConcatParseBuf (x:xs) s buf pstep pst extract) = do
1776 PR.Partial 0 pst1 ->
1777 return $ Skip $ ConcatParseBuf xs s [] pstep pst1 extract
1778 PR.Partial n pst1 -> do
1779 assert (n <= length (x:buf)) (return ())
1780 let src0 = Prelude.take n (x:buf)
1781 src = Prelude.reverse src0 ++ xs
1782 return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract
1783 -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1
1784 PR.Continue n pst1 -> do
1785 assert (n <= length (x:buf)) (return ())
1786 let (src0, buf1) = splitAt n (x:buf)
1787 src = Prelude.reverse src0 ++ xs
1788 return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract
1789 -- XXX Specialize for Stop 0 common case?
1791 assert (n <= length (x:buf)) (return ())
1792 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1793 return $ Skip $ ConcatParseYield (Right b)
1794 (ConcatParseInit src s (func b))
1799 (Left (ParseError err))
1800 (ConcatParseInitLeftOver [])
1802 -- This is simplified ConcatParseBuf
1803 stepOuter _ (ConcatParseExtract [] buf pstep pst extract) =
1804 return $ Skip $ ConcatParseStop buf pstep pst extract
1806 stepOuter _ (ConcatParseExtract (x:xs) buf pstep pst extract) = do
1809 PR.Partial 0 pst1 ->
1810 return $ Skip $ ConcatParseExtract xs [] pstep pst1 extract
1811 PR.Partial n pst1 -> do
1812 assert (n <= length (x:buf)) (return ())
1813 let src0 = Prelude.take n (x:buf)
1814 src = Prelude.reverse src0 ++ xs
1815 return $ Skip $ ConcatParseExtract src [] pstep pst1 extract
1816 PR.Continue 0 pst1 ->
1817 return $ Skip $ ConcatParseExtract xs (x:buf) pstep pst1 extract
1818 PR.Continue n pst1 -> do
1819 assert (n <= length (x:buf)) (return ())
1820 let (src0, buf1) = splitAt n (x:buf)
1821 src = Prelude.reverse src0 ++ xs
1822 return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract
1824 return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf xs (func b))
1826 assert (n <= length (x:buf)) (return ())
1827 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1828 return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))
1833 (Left (ParseError err))
1834 (ConcatParseInitLeftOver [])
1836 -- This is simplified ConcatParseExtract
1837 stepOuter _ (ConcatParseStop buf pstep pst extract) = do
1840 PR.Partial _ _ -> error "Bug: parseIterate: Partial in extract"
1841 PR.Continue 0 pst1 ->
1842 return $ Skip $ ConcatParseStop buf pstep pst1 extract
1843 PR.Continue n pst1 -> do
1844 assert (n <= length buf) (return ())
1845 let (src0, buf1) = splitAt n buf
1846 src = Prelude.reverse src0
1847 return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract
1850 ConcatParseYield (Right b) (ConcatParseInitLeftOver [])
1852 assert (n <= length buf) (return ())
1853 let src = Prelude.reverse (Prelude.take n buf)
1855 ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))
1860 (Left (ParseError err))
1861 (ConcatParseInitLeftOver [])
1863 stepOuter _ (ConcatParseYield a next) = return $ Yield a next
1865-- | Iterate a parser generating function on a stream. The initial value @b@ is
1866-- used to generate the first parser, the parser is applied on the stream and
1867-- the result is used to generate the next parser and so on.
1869-- >>> import Data.Monoid (Sum(..))
1870-- >>> s = Stream.fromList [1..10]
1871-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.catRights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum s
1872-- [3,10,21,36,55,55]
1874-- This is the streaming equivalent of monad like sequenced application of
1875-- parsers where next parser is dependent on the previous parser.
1879{-# INLINE parseIterate #-}
1882 => (b -> PR.Parser a m b)
1885 -> Stream m (Either ParseError b)
1886parseIterate = parseIterateD
1888------------------------------------------------------------------------------
1890------------------------------------------------------------------------------
1892data GroupByState st fs a b
1895 | GroupingInitWith st !a
1896 | GroupingDoWith st !fs !a
1897 | GroupingYield !b (GroupByState st fs a b)
1900-- | The argument order of the comparison function in `groupsWhile` is
1901-- different than that of `groupsBy`.
1903-- In `groupsBy` the comparison function takes the next element as the first
1904-- argument and the previous element as the second argument. In `groupsWhile`
1905-- the first argument is the previous element and second argument is the next
1907{-# INLINE_NORMAL groupsWhile #-}
1908groupsWhile :: Monad m
1914groupsWhile eq fld = parseMany (PRD.groupBy eq fld)
1916groupsWhile cmp (Fold fstep initial done) (Stream step state) =
1917 Stream stepOuter (GroupingInit state)
1921 {-# INLINE_LATE stepOuter #-}
1922 stepOuter _ (GroupingInit st) = do
1923 -- XXX Note that if the stream stops without yielding a single element
1924 -- in the group we discard the "initial" effect.
1928 FL.Partial s -> Skip $ GroupingDo st s
1929 FL.Done b -> Yield b $ GroupingInit st
1930 stepOuter gst (GroupingDo st fs) = do
1931 res <- step (adaptState gst) st
1936 FL.Partial fs1 -> go SPEC x s fs1
1937 FL.Done b -> return $ Yield b (GroupingInit s)
1938 Skip s -> return $ Skip $ GroupingDo s fs
1943 go !_ prev stt !acc = do
1944 res <- step (adaptState gst) stt
1951 FL.Partial fs1 -> go SPEC prev s fs1
1952 FL.Done b -> return $ Yield b (GroupingInit s)
1955 return $ Yield r (GroupingInitWith s x)
1956 Skip s -> go SPEC prev s acc
1957 Stop -> done acc >>= \r -> return $ Yield r GroupingDone
1958 stepOuter _ (GroupingInitWith st x) = do
1962 FL.Partial s -> Skip $ GroupingDoWith st s x
1963 FL.Done b -> Yield b $ GroupingInitWith st x
1964 stepOuter gst (GroupingDoWith st fs prev) = do
1965 res <- fstep fs prev
1967 FL.Partial fs1 -> go SPEC st fs1
1968 FL.Done b -> return $ Yield b (GroupingInit st)
1972 -- XXX code duplicated from the previous equation
1974 res <- step (adaptState gst) stt
1981 FL.Partial fs1 -> go SPEC s fs1
1982 FL.Done b -> return $ Yield b (GroupingInit s)
1985 return $ Yield r (GroupingInitWith s x)
1986 Skip s -> go SPEC s acc
1987 Stop -> done acc >>= \r -> return $ Yield r GroupingDone
1988 stepOuter _ (GroupingYield _ _) = error "groupsWhile: Unreachable"
1989 stepOuter _ GroupingDone = return Stop
1991{-# DEPRECATED groupsBy "Please use groupsWhile instead. Please note the change in the argument order of the comparison function." #-}
1992{-# INLINE_NORMAL groupsBy #-}
1998groupsBy cmp = groupsWhile (flip cmp)
2000{-# INLINE_NORMAL groupsRollingBy #-}
2001groupsRollingBy :: Monad m
2007groupsRollingBy eq fld = parseMany (PRD.groupByRolling eq fld)
2009groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =
2010 Stream stepOuter (GroupingInit state)
2014 {-# INLINE_LATE stepOuter #-}
2015 stepOuter _ (GroupingInit st) = do
2016 -- XXX Note that if the stream stops without yielding a single element
2017 -- in the group we discard the "initial" effect.
2021 FL.Partial fs -> Skip $ GroupingDo st fs
2022 FL.Done fb -> Yield fb $ GroupingInit st
2023 stepOuter gst (GroupingDo st fs) = do
2024 res <- step (adaptState gst) st
2029 FL.Partial fs1 -> go SPEC x s fs1
2030 FL.Done fb -> return $ Yield fb (GroupingInit s)
2031 Skip s -> return $ Skip $ GroupingDo s fs
2036 go !_ prev stt !acc = do
2037 res <- step (adaptState gst) stt
2044 FL.Partial fs1 -> go SPEC x s fs1
2045 FL.Done b -> return $ Yield b (GroupingInit s)
2048 return $ Yield r (GroupingInitWith s x)
2049 Skip s -> go SPEC prev s acc
2050 Stop -> done acc >>= \r -> return $ Yield r GroupingDone
2051 stepOuter _ (GroupingInitWith st x) = do
2055 FL.Partial s -> Skip $ GroupingDoWith st s x
2056 FL.Done b -> Yield b $ GroupingInitWith st x
2057 stepOuter gst (GroupingDoWith st fs previous) = do
2058 res <- fstep fs previous
2060 FL.Partial s -> go SPEC previous st s
2061 FL.Done b -> return $ Yield b (GroupingInit st)
2065 -- XXX GHC: groupsWhile has one less parameter in this go loop and it
2066 -- fuses. However, groupsRollingBy does not fuse, removing the prev
2067 -- parameter makes it fuse. Something needs to be fixed in GHC. The
2068 -- workaround for this is noted in the comments below.
2069 go !_ prev !stt !acc = do
2070 res <- step (adaptState gst) stt
2077 FL.Partial fs1 -> go SPEC x s fs1
2078 FL.Done b -> return $ Yield b (GroupingInit st)
2082 return $ Yield r (GroupingInitWith s x)
2084 -- The code above does not let groupBy fuse. We use the
2085 -- alternative code below instead. Instead of jumping
2086 -- to GroupingInitWith state, we unroll the code of
2087 -- GroupingInitWith state here to help GHC with stream
2094 FL.Partial fsi -> GroupingDoWith s fsi x
2095 FL.Done b -> GroupingYield b (GroupingInit s)
2096 Skip s -> go SPEC prev s acc
2097 Stop -> done acc >>= \r -> return $ Yield r GroupingDone
2098 stepOuter _ (GroupingYield r next) = return $ Yield r next
2099 stepOuter _ GroupingDone = return Stop
2101------------------------------------------------------------------------------
2102-- Splitting - by a predicate
2103------------------------------------------------------------------------------
2105data WordsByState st fs b
2109 | WordsByYield !b (WordsByState st fs b)
2111-- | Split the stream after stripping leading, trailing, and repeated separators
2112-- as per the fold supplied.
2113-- Therefore, @".a..b."@ with '.' as the separator would be parsed as
2114-- @["a","b"]@. In other words, its like parsing words from whitespace
2117{-# INLINE_NORMAL wordsBy #-}
2118wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
2119wordsBy predicate (Fold fstep initial done) (Stream step state) =
2120 Stream stepOuter (WordsByInit state)
2124 {-# INLINE_LATE stepOuter #-}
2125 stepOuter _ (WordsByInit st) = do
2129 FL.Partial s -> Skip $ WordsByDo st s
2130 FL.Done b -> Yield b (WordsByInit st)
2132 stepOuter gst (WordsByDo st fs) = do
2133 res <- step (adaptState gst) st
2141 FL.Partial fs1 -> Skip $ WordsByDo s fs1
2142 FL.Done b -> Yield b (WordsByInit s)
2146 FL.Partial fs1 -> go SPEC s fs1
2147 FL.Done b -> return $ Yield b (WordsByInit s)
2148 Skip s -> return $ Skip $ WordsByDo s fs
2154 res <- step (adaptState gst) stt
2161 return $ Yield r (WordsByInit s)
2163 -- The above code does not fuse well. Need to check why
2164 -- GHC is not able to simplify it well. Using the code
2165 -- below, instead of jumping through the WordsByInit
2166 -- state always, we directly go to WordsByDo state in
2167 -- the common case of Partial.
2173 FL.Partial fs1 -> WordsByDo s fs1
2174 FL.Done b -> WordsByYield b (WordsByInit s)
2178 FL.Partial fs1 -> go SPEC s fs1
2179 FL.Done b -> return $ Yield b (WordsByInit s)
2180 Skip s -> go SPEC s acc
2181 Stop -> done acc >>= \r -> return $ Yield r WordsByDone
2183 stepOuter _ WordsByDone = return Stop
2185 stepOuter _ (WordsByYield b next) = return $ Yield b next
2187------------------------------------------------------------------------------
2188-- Splitting on a sequence
2189------------------------------------------------------------------------------
2191-- String search algorithms:
2192-- http://www-igm.univ-mlv.fr/~lecroq/string/index.html
2195-- TODO can we unify the splitting operations using a splitting configuration
2196-- like in the split package.
2198data SplitStyle = Infix | Suffix | Prefix deriving (Eq, Show)
2199data SplitOptions = SplitOptions
2200 { style :: SplitStyle
2201 , withSep :: Bool -- ^ keep the separators in output
2202 -- , compact :: Bool -- ^ treat multiple consecutive separators as one
2203 -- , trimHead :: Bool -- ^ drop blank at head
2204 -- , trimTail :: Bool -- ^ drop blank at tail
2208-- XXX using "fs" as the last arg in Constructors may simplify the code a bit,
2209-- because we can use the constructor directly without having to create "jump"
2211{-# ANN type SplitOnSeqState Fuse #-}
2212data SplitOnSeqState rb rh ck w fs s b x =
2214 | SplitOnSeqYield b (SplitOnSeqState rb rh ck w fs s b x)
2217 | SplitOnSeqEmpty !fs s
2219 | SplitOnSeqSingle !fs s x
2221 | SplitOnSeqWordInit !fs s
2222 | SplitOnSeqWordLoop !w s !fs
2223 | SplitOnSeqWordDone Int !fs !w
2225 | SplitOnSeqKRInit Int !fs s rb !rh
2226 | SplitOnSeqKRLoop fs s rb !rh !ck
2227 | SplitOnSeqKRCheck fs s rb !rh
2228 | SplitOnSeqKRDone Int !fs rb !rh
2230 | SplitOnSeqReinit (fs -> SplitOnSeqState rb rh ck w fs s b x)
2232{-# INLINE_NORMAL splitOnSeq #-}
2234 :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)
2239splitOnSeq patArr (Fold fstep initial done) (Stream step state) =
2240 Stream stepOuter SplitOnSeqInit
2244 patLen = A.length patArr
2245 maxIndex = patLen - 1
2246 elemBits = SIZE_OF(a) * 8
2248 -- For word pattern case
2250 wordMask = (1 `shiftL` (elemBits * patLen)) - 1
2253 elemMask = (1 `shiftL` elemBits) - 1
2256 wordPat = wordMask .&. A.foldl' addToWord 0 patArr
2258 addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)
2260 -- For Rabin-Karp search
2261 k = 2891336453 :: Word32
2264 addCksum cksum a = cksum * k + fromIntegral (fromEnum a)
2266 deltaCksum cksum old new =
2267 addCksum cksum new - coeff * fromIntegral (fromEnum old)
2269 -- XXX shall we use a random starting hash or 1 instead of 0?
2270 patHash = A.foldl' addCksum 0 patArr
2272 skip = return . Skip
2274 nextAfterInit nextGen stepRes =
2276 FL.Partial s -> nextGen s
2277 FL.Done b -> SplitOnSeqYield b (SplitOnSeqReinit nextGen)
2279 {-# INLINE yieldProceed #-}
2280 yieldProceed nextGen fs =
2281 initial >>= skip . SplitOnSeqYield fs . nextAfterInit nextGen
2283 {-# INLINE_LATE stepOuter #-}
2284 stepOuter _ SplitOnSeqInit = do
2289 then return $ Skip $ SplitOnSeqEmpty acc state
2292 pat <- liftIO $ A.unsafeIndexIO 0 patArr
2293 return $ Skip $ SplitOnSeqSingle acc state pat
2294 else if SIZE_OF(a) * patLen
2295 <= sizeOf (Proxy :: Proxy Word)
2296 then return $ Skip $ SplitOnSeqWordInit acc state
2298 (rb, rhead) <- liftIO $ RB.new patLen
2299 skip $ SplitOnSeqKRInit 0 acc state rb rhead
2300 FL.Done b -> skip $ SplitOnSeqYield b SplitOnSeqInit
2302 stepOuter _ (SplitOnSeqYield x next) = return $ Yield x next
2304 ---------------------------
2306 ---------------------------
2308 stepOuter _ (SplitOnSeqReinit nextGen) =
2309 initial >>= skip . nextAfterInit nextGen
2311 ---------------------------
2313 ---------------------------
2315 stepOuter gst (SplitOnSeqEmpty acc st) = do
2316 res <- step (adaptState gst) st
2322 FL.Partial acc1 -> done acc1
2323 FL.Done b -> return b
2324 let jump c = SplitOnSeqEmpty c s
2325 in yieldProceed jump b1
2326 Skip s -> skip (SplitOnSeqEmpty acc s)
2333 stepOuter _ SplitOnSeqDone = return Stop
2339 stepOuter gst (SplitOnSeqSingle fs st pat) = do
2340 res <- step (adaptState gst) st
2343 let jump c = SplitOnSeqSingle c s pat
2345 then done fs >>= yieldProceed jump
2349 FL.Partial fs1 -> skip $ jump fs1
2350 FL.Done b -> yieldProceed jump b
2351 Skip s -> return $ Skip $ SplitOnSeqSingle fs s pat
2354 return $ Skip $ SplitOnSeqYield r SplitOnSeqDone
2356 ---------------------------
2357 -- Short Pattern - Shift Or
2358 ---------------------------
2360 stepOuter _ (SplitOnSeqWordDone 0 fs _) = do
2362 skip $ SplitOnSeqYield r SplitOnSeqDone
2363 stepOuter _ (SplitOnSeqWordDone n fs wrd) = do
2364 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))
2365 r <- fstep fs (toEnum $ fromIntegral old)
2367 FL.Partial fs1 -> skip $ SplitOnSeqWordDone (n - 1) fs1 wrd
2369 let jump c = SplitOnSeqWordDone (n - 1) c wrd
2372 stepOuter gst (SplitOnSeqWordInit fs st0) =
2378 go !_ !idx !wrd !st = do
2379 res <- step (adaptState gst) st
2382 let wrd1 = addToWord wrd x
2385 if wrd1 .&. wordMask == wordPat
2387 let jump c = SplitOnSeqWordInit c s
2388 done fs >>= yieldProceed jump
2389 else skip $ SplitOnSeqWordLoop wrd1 s fs
2390 else go SPEC (idx + 1) wrd1 s
2391 Skip s -> go SPEC idx wrd s
2394 then skip $ SplitOnSeqWordDone idx fs wrd
2397 skip $ SplitOnSeqYield r SplitOnSeqDone
2399 stepOuter gst (SplitOnSeqWordLoop wrd0 st0 fs0) =
2400 go SPEC wrd0 st0 fs0
2405 go !_ !wrd !st !fs = do
2406 res <- step (adaptState gst) st
2409 let jump c = SplitOnSeqWordInit c s
2410 wrd1 = addToWord wrd x
2411 old = (wordMask .&. wrd)
2412 `shiftR` (elemBits * (patLen - 1))
2413 r <- fstep fs (toEnum $ fromIntegral old)
2415 FL.Partial fs1 -> do
2416 if wrd1 .&. wordMask == wordPat
2417 then done fs1 >>= yieldProceed jump
2418 else go SPEC wrd1 s fs1
2419 FL.Done b -> yieldProceed jump b
2420 Skip s -> go SPEC wrd s fs
2421 Stop -> skip $ SplitOnSeqWordDone patLen fs wrd
2423 -------------------------------
2424 -- General Pattern - Karp Rabin
2425 -------------------------------
2427 stepOuter gst (SplitOnSeqKRInit idx fs st rb rh) = do
2428 res <- step (adaptState gst) st
2431 rh1 <- liftIO $ RB.unsafeInsert rb rh x
2434 let fld = RB.unsafeFoldRing (RB.ringBound rb)
2435 let !ringHash = fld addCksum 0 rb
2436 if ringHash == patHash
2437 then skip $ SplitOnSeqKRCheck fs s rb rh1
2438 else skip $ SplitOnSeqKRLoop fs s rb rh1 ringHash
2439 else skip $ SplitOnSeqKRInit (idx + 1) fs s rb rh1
2440 Skip s -> skip $ SplitOnSeqKRInit idx fs s rb rh
2442 skip $ SplitOnSeqKRDone idx fs rb (RB.startOf rb)
2444 -- XXX The recursive "go" is more efficient than the state based recursion
2445 -- code commented out below. Perhaps its more efficient because of
2446 -- factoring out "rb" outside the loop.
2448 stepOuter gst (SplitOnSeqKRLoop fs0 st0 rb rh0 cksum0) =
2449 go SPEC fs0 st0 rh0 cksum0
2453 go !_ !fs !st !rh !cksum = do
2454 res <- step (adaptState gst) st
2457 old <- liftIO $ peek rh
2458 let cksum1 = deltaCksum cksum old x
2461 FL.Partial fs1 -> do
2462 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2463 if cksum1 == patHash
2464 then skip $ SplitOnSeqKRCheck fs1 s rb rh1
2465 else go SPEC fs1 s rh1 cksum1
2467 let rst = RB.startOf rb
2468 jump c = SplitOnSeqKRInit 0 c s rb rst
2470 Skip s -> go SPEC fs s rh cksum
2471 Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh
2473 -- XXX The following code is 5 times slower compared to the recursive loop
2474 -- based code above. Need to investigate why. One possibility is that the
2475 -- go loop above does not thread around the ring buffer (rb). This code may
2476 -- be causing the state to bloat and getting allocated on each iteration.
2477 -- We can check the cmm/asm code to confirm. If so a good GHC solution to
2478 -- such problem is needed. One way to avoid this could be to use unboxed
2481 stepOuter gst (SplitOnSeqKRLoop fs st rb rh cksum) = do
2482 res <- step (adaptState gst) st
2485 old <- liftIO $ peek rh
2486 let cksum1 = deltaCksum cksum old x
2488 if (cksum1 == patHash)
2491 skip $ SplitOnSeqYield r $ SplitOnSeqKRInit 0 s rb rh
2493 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2494 skip $ SplitOnSeqKRLoop fs1 s rb rh1 cksum1
2495 Skip s -> skip $ SplitOnSeqKRLoop fs s rb rh cksum
2496 Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh
2499 stepOuter _ (SplitOnSeqKRCheck fs st rb rh) = do
2500 if RB.unsafeEqArray rb rh patArr
2503 let rst = RB.startOf rb
2504 jump c = SplitOnSeqKRInit 0 c st rb rst
2506 else skip $ SplitOnSeqKRLoop fs st rb rh patHash
2508 stepOuter _ (SplitOnSeqKRDone 0 fs _ _) = do
2510 skip $ SplitOnSeqYield r SplitOnSeqDone
2511 stepOuter _ (SplitOnSeqKRDone n fs rb rh) = do
2512 old <- liftIO $ peek rh
2513 let rh1 = RB.advance rb rh
2516 FL.Partial fs1 -> skip $ SplitOnSeqKRDone (n - 1) fs1 rb rh1
2518 let jump c = SplitOnSeqKRDone (n - 1) c rb rh1
2521{-# ANN type SplitOnSuffixSeqState Fuse #-}
2522data SplitOnSuffixSeqState rb rh ck w fs s b x =
2523 SplitOnSuffixSeqInit
2524 | SplitOnSuffixSeqYield b (SplitOnSuffixSeqState rb rh ck w fs s b x)
2525 | SplitOnSuffixSeqDone
2527 | SplitOnSuffixSeqEmpty !fs s
2529 | SplitOnSuffixSeqSingleInit !fs s x
2530 | SplitOnSuffixSeqSingle !fs s x
2532 | SplitOnSuffixSeqWordInit !fs s
2533 | SplitOnSuffixSeqWordLoop !w s !fs
2534 | SplitOnSuffixSeqWordDone Int !fs !w
2536 | SplitOnSuffixSeqKRInit Int !fs s rb !rh
2537 | SplitOnSuffixSeqKRInit1 !fs s rb !rh
2538 | SplitOnSuffixSeqKRLoop fs s rb !rh !ck
2539 | SplitOnSuffixSeqKRCheck fs s rb !rh
2540 | SplitOnSuffixSeqKRDone Int !fs rb !rh
2542 | SplitOnSuffixSeqReinit
2543 (fs -> SplitOnSuffixSeqState rb rh ck w fs s b x)
2545{-# INLINE_NORMAL splitOnSuffixSeq #-}
2547 :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)
2553splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =
2554 Stream stepOuter SplitOnSuffixSeqInit
2558 patLen = A.length patArr
2559 maxIndex = patLen - 1
2560 elemBits = SIZE_OF(a) * 8
2562 -- For word pattern case
2564 wordMask = (1 `shiftL` (elemBits * patLen)) - 1
2567 elemMask = (1 `shiftL` elemBits) - 1
2570 wordPat = wordMask .&. A.foldl' addToWord 0 patArr
2572 addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)
2574 nextAfterInit nextGen stepRes =
2576 FL.Partial s -> nextGen s
2578 SplitOnSuffixSeqYield b (SplitOnSuffixSeqReinit nextGen)
2580 {-# INLINE yieldProceed #-}
2581 yieldProceed nextGen fs =
2582 initial >>= skip . SplitOnSuffixSeqYield fs . nextAfterInit nextGen
2584 -- For single element pattern case
2585 {-# INLINE processYieldSingle #-}
2586 processYieldSingle pat x s fs = do
2587 let jump c = SplitOnSuffixSeqSingleInit c s pat
2590 r <- if withSep then fstep fs x else return $ FL.Partial fs
2593 FL.Partial fs1 -> done fs1
2594 FL.Done b -> return b
2595 yieldProceed jump b1
2599 FL.Partial fs1 -> skip $ SplitOnSuffixSeqSingle fs1 s pat
2600 FL.Done b -> yieldProceed jump b
2602 -- For Rabin-Karp search
2603 k = 2891336453 :: Word32
2606 addCksum cksum a = cksum * k + fromIntegral (fromEnum a)
2608 deltaCksum cksum old new =
2609 addCksum cksum new - coeff * fromIntegral (fromEnum old)
2611 -- XXX shall we use a random starting hash or 1 instead of 0?
2612 patHash = A.foldl' addCksum 0 patArr
2614 skip = return . Skip
2616 {-# INLINE_LATE stepOuter #-}
2617 stepOuter _ SplitOnSuffixSeqInit = do
2622 then skip $ SplitOnSuffixSeqEmpty fs state
2625 pat <- liftIO $ A.unsafeIndexIO 0 patArr
2626 skip $ SplitOnSuffixSeqSingleInit fs state pat
2627 else if SIZE_OF(a) * patLen
2628 <= sizeOf (Proxy :: Proxy Word)
2629 then skip $ SplitOnSuffixSeqWordInit fs state
2631 (rb, rhead) <- liftIO $ RB.new patLen
2632 skip $ SplitOnSuffixSeqKRInit 0 fs state rb rhead
2633 FL.Done fb -> skip $ SplitOnSuffixSeqYield fb SplitOnSuffixSeqInit
2635 stepOuter _ (SplitOnSuffixSeqYield x next) = return $ Yield x next
2637 ---------------------------
2639 ---------------------------
2641 stepOuter _ (SplitOnSuffixSeqReinit nextGen) =
2642 initial >>= skip . nextAfterInit nextGen
2644 ---------------------------
2646 ---------------------------
2648 stepOuter gst (SplitOnSuffixSeqEmpty acc st) = do
2649 res <- step (adaptState gst) st
2652 let jump c = SplitOnSuffixSeqEmpty c s
2656 FL.Partial fs -> done fs
2657 FL.Done b -> return b
2658 yieldProceed jump b1
2659 Skip s -> skip (SplitOnSuffixSeqEmpty acc s)
2666 stepOuter _ SplitOnSuffixSeqDone = return Stop
2672 stepOuter gst (SplitOnSuffixSeqSingleInit fs st pat) = do
2673 res <- step (adaptState gst) st
2675 Yield x s -> processYieldSingle pat x s fs
2676 Skip s -> skip $ SplitOnSuffixSeqSingleInit fs s pat
2679 stepOuter gst (SplitOnSuffixSeqSingle fs st pat) = do
2680 res <- step (adaptState gst) st
2682 Yield x s -> processYieldSingle pat x s fs
2683 Skip s -> skip $ SplitOnSuffixSeqSingle fs s pat
2686 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2688 ---------------------------
2689 -- Short Pattern - Shift Or
2690 ---------------------------
2692 stepOuter _ (SplitOnSuffixSeqWordDone 0 fs _) = do
2694 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2695 stepOuter _ (SplitOnSuffixSeqWordDone n fs wrd) = do
2696 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))
2697 r <- fstep fs (toEnum $ fromIntegral old)
2699 FL.Partial fs1 -> skip $ SplitOnSuffixSeqWordDone (n - 1) fs1 wrd
2701 let jump c = SplitOnSuffixSeqWordDone (n - 1) c wrd
2704 stepOuter gst (SplitOnSuffixSeqWordInit fs0 st0) = do
2705 res <- step (adaptState gst) st0
2708 let wrd = addToWord 0 x
2709 r <- if withSep then fstep fs0 x else return $ FL.Partial fs0
2711 FL.Partial fs1 -> go SPEC 1 wrd s fs1
2713 let jump c = SplitOnSuffixSeqWordInit c s
2715 Skip s -> skip (SplitOnSuffixSeqWordInit fs0 s)
2721 go !_ !idx !wrd !st !fs = do
2722 res <- step (adaptState gst) st
2725 let jump c = SplitOnSuffixSeqWordInit c s
2726 let wrd1 = addToWord wrd x
2727 r <- if withSep then fstep fs x else return $ FL.Partial fs
2731 then go SPEC (idx + 1) wrd1 s fs1
2732 else if wrd1 .&. wordMask /= wordPat
2733 then skip $ SplitOnSuffixSeqWordLoop wrd1 s fs1
2734 else do done fs >>= yieldProceed jump
2735 FL.Done b -> yieldProceed jump b
2736 Skip s -> go SPEC idx wrd s fs
2737 Stop -> skip $ SplitOnSuffixSeqWordDone idx fs wrd
2739 stepOuter gst (SplitOnSuffixSeqWordLoop wrd0 st0 fs0) =
2740 go SPEC wrd0 st0 fs0
2745 go !_ !wrd !st !fs = do
2746 res <- step (adaptState gst) st
2749 let jump c = SplitOnSuffixSeqWordInit c s
2750 wrd1 = addToWord wrd x
2751 old = (wordMask .&. wrd)
2752 `shiftR` (elemBits * (patLen - 1))
2756 else fstep fs (toEnum $ fromIntegral old)
2759 if wrd1 .&. wordMask == wordPat
2760 then done fs1 >>= yieldProceed jump
2761 else go SPEC wrd1 s fs1
2762 FL.Done b -> yieldProceed jump b
2763 Skip s -> go SPEC wrd s fs
2765 if wrd .&. wordMask == wordPat
2770 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2771 else skip $ SplitOnSuffixSeqWordDone patLen fs wrd
2773 -------------------------------
2774 -- General Pattern - Karp Rabin
2775 -------------------------------
2777 stepOuter gst (SplitOnSuffixSeqKRInit idx0 fs st0 rb rh0) = do
2778 res <- step (adaptState gst) st0
2781 rh1 <- liftIO $ RB.unsafeInsert rb rh0 x
2782 r <- if withSep then fstep fs x else return $ FL.Partial fs
2785 skip $ SplitOnSuffixSeqKRInit1 fs1 s rb rh1
2787 let rst = RB.startOf rb
2788 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst
2790 Skip s -> skip $ SplitOnSuffixSeqKRInit idx0 fs s rb rh0
2793 stepOuter gst (SplitOnSuffixSeqKRInit1 fs0 st0 rb rh0) = do
2794 go SPEC 1 rh0 st0 fs0
2798 go !_ !idx !rh st !fs = do
2799 res <- step (adaptState gst) st
2802 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2803 r <- if withSep then fstep fs x else return $ FL.Partial fs
2807 then go SPEC (idx + 1) rh1 s fs1
2809 let fld = RB.unsafeFoldRing (RB.ringBound rb)
2810 !ringHash = fld addCksum 0 rb
2811 in if ringHash == patHash
2812 then SplitOnSuffixSeqKRCheck fs1 s rb rh1
2813 else SplitOnSuffixSeqKRLoop
2814 fs1 s rb rh1 ringHash
2816 let rst = RB.startOf rb
2817 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst
2819 Skip s -> go SPEC idx rh s fs
2821 -- do not issue a blank segment when we end at pattern
2822 if (idx == maxIndex) && RB.unsafeEqArray rb rh patArr
2827 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2828 else skip $ SplitOnSuffixSeqKRDone idx fs rb (RB.startOf rb)
2830 stepOuter gst (SplitOnSuffixSeqKRLoop fs0 st0 rb rh0 cksum0) =
2831 go SPEC fs0 st0 rh0 cksum0
2835 go !_ !fs !st !rh !cksum = do
2836 res <- step (adaptState gst) st
2839 old <- liftIO $ peek rh
2840 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2841 let cksum1 = deltaCksum cksum old x
2842 r <- if withSep then fstep fs x else fstep fs old
2845 if cksum1 /= patHash
2846 then go SPEC fs1 s rh1 cksum1
2847 else skip $ SplitOnSuffixSeqKRCheck fs1 s rb rh1
2849 let rst = RB.startOf rb
2850 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst
2852 Skip s -> go SPEC fs s rh cksum
2854 if RB.unsafeEqArray rb rh patArr
2859 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2860 else skip $ SplitOnSuffixSeqKRDone patLen fs rb rh
2862 stepOuter _ (SplitOnSuffixSeqKRCheck fs st rb rh) = do
2863 if RB.unsafeEqArray rb rh patArr
2866 let rst = RB.startOf rb
2867 jump c = SplitOnSuffixSeqKRInit 0 c st rb rst
2869 else skip $ SplitOnSuffixSeqKRLoop fs st rb rh patHash
2871 stepOuter _ (SplitOnSuffixSeqKRDone 0 fs _ _) = do
2873 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2874 stepOuter _ (SplitOnSuffixSeqKRDone n fs rb rh) = do
2875 old <- liftIO $ peek rh
2876 let rh1 = RB.advance rb rh
2879 FL.Partial fs1 -> skip $ SplitOnSuffixSeqKRDone (n - 1) fs1 rb rh1
2881 let jump c = SplitOnSuffixSeqKRDone (n - 1) c rb rh1
2884-- Implement this as a fold or a parser instead.
2885-- This can be implemented easily using Rabin Karp
2886-- | Split post any one of the given patterns.
2889{-# INLINE splitOnSuffixSeqAny #-}
2890splitOnSuffixSeqAny :: -- (Monad m, Unboxed a, Integral a) =>
2891 [Array a] -> Fold m a b -> Stream m a -> Stream m b
2892splitOnSuffixSeqAny _subseq _f _m = undefined
2893 -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m)
2895-- | Split on a prefixed separator element, dropping the separator. The
2896-- supplied 'Fold' is applied on the split segments.
2899-- > splitOnPrefix' p xs = Stream.toList $ Stream.splitOnPrefix p (Fold.toList) (Stream.fromList xs)
2900-- > splitOnPrefix' (== '.') ".a.b"
2904-- An empty stream results in an empty output stream:
2906-- > splitOnPrefix' (== '.') ""
2910-- An empty segment consisting of only a prefix is folded to the default output
2914-- > splitOnPrefix' (== '.') "."
2917-- > splitOnPrefix' (== '.') ".a.b."
2920-- > splitOnPrefix' (== '.') ".a..b"
2925-- A prefix is optional at the beginning of the stream:
2928-- > splitOnPrefix' (== '.') "a"
2931-- > splitOnPrefix' (== '.') "a.b"
2935-- 'splitOnPrefix' is an inverse of 'intercalatePrefix' with a single element:
2937-- > Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList . Stream.splitOnPrefix (== '.') Fold.toList === id
2939-- Assuming the input stream does not contain the separator:
2941-- > Stream.splitOnPrefix (== '.') Fold.toList . Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList === id
2944{-# INLINE splitOnPrefix #-}
2945splitOnPrefix :: -- (IsStream t, MonadCatch m) =>
2946 (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
2947splitOnPrefix _predicate _f = undefined
2948 -- parseMany (Parser.sliceBeginBy predicate f)
2950-- Int list examples for splitOn:
2952-- >>> splitList [] [1,2,3,3,4]
2953-- > [[1],[2],[3],[3],[4]]
2955-- >>> splitList [5] [1,2,3,3,4]
2958-- >>> splitList [1] [1,2,3,3,4]
2961-- >>> splitList [4] [1,2,3,3,4]
2964-- >>> splitList [2] [1,2,3,3,4]
2967-- >>> splitList [3] [1,2,3,3,4]
2970-- >>> splitList [3,3] [1,2,3,3,4]
2973-- >>> splitList [1,2,3,3,4] [1,2,3,3,4]
2976-- This can be implemented easily using Rabin Karp
2977-- | Split on any one of the given patterns.
2981{-# INLINE splitOnAny #-}
2982splitOnAny :: -- (Monad m, Unboxed a, Integral a) =>
2983 [Array a] -> Fold m a b -> Stream m a -> Stream m b
2984splitOnAny _subseq _f _m =
2985 undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m)
2987------------------------------------------------------------------------------
2988-- Nested Container Transformation
2989------------------------------------------------------------------------------
2991{-# ANN type SplitState Fuse #-}
2992data SplitState s arr
2994 | SplitBuffering s arr
2995 | SplitSplitting s arr
2996 | SplitYielding arr (SplitState s arr)
2999-- XXX An alternative approach would be to use a partial fold (Fold m a b) to
3000-- split using a splitBy like combinator. The Fold would consume upto the
3001-- separator and return any leftover which can then be fed to the next fold.
3003-- We can revisit this once we have partial folds/parsers.
3005-- | Performs infix separator style splitting.
3006{-# INLINE_NORMAL splitInnerBy #-}
3009 => (f a -> m (f a, Maybe (f a))) -- splitter
3010 -> (f a -> f a -> m (f a)) -- joiner
3013splitInnerBy splitter joiner (Stream step1 state1) =
3014 Stream step (SplitInitial state1)
3018 {-# INLINE_LATE step #-}
3019 step gst (SplitInitial st) = do
3023 (x1, mx2) <- splitter x
3024 return $ case mx2 of
3025 Nothing -> Skip (SplitBuffering s x1)
3026 Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))
3027 Skip s -> return $ Skip (SplitInitial s)
3030 step gst (SplitBuffering st buf) = do
3034 (x1, mx2) <- splitter x
3035 buf' <- joiner buf x1
3036 return $ case mx2 of
3037 Nothing -> Skip (SplitBuffering s buf')
3038 Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))
3039 Skip s -> return $ Skip (SplitBuffering s buf)
3040 Stop -> return $ Skip (SplitYielding buf SplitFinishing)
3042 step _ (SplitSplitting st buf) = do
3043 (x1, mx2) <- splitter buf
3044 return $ case mx2 of
3045 Nothing -> Skip $ SplitBuffering st x1
3046 Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)
3048 step _ (SplitYielding x next) = return $ Yield x next
3049 step _ SplitFinishing = return Stop
3051-- | Performs infix separator style splitting.
3052{-# INLINE_NORMAL splitInnerBySuffix #-}
3054 :: (Monad m, Eq (f a), Monoid (f a))
3055 => (f a -> m (f a, Maybe (f a))) -- splitter
3056 -> (f a -> f a -> m (f a)) -- joiner
3059splitInnerBySuffix splitter joiner (Stream step1 state1) =
3060 Stream step (SplitInitial state1)
3064 {-# INLINE_LATE step #-}
3065 step gst (SplitInitial st) = do
3069 (x1, mx2) <- splitter x
3070 return $ case mx2 of
3071 Nothing -> Skip (SplitBuffering s x1)
3072 Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))
3073 Skip s -> return $ Skip (SplitInitial s)
3076 step gst (SplitBuffering st buf) = do
3080 (x1, mx2) <- splitter x
3081 buf' <- joiner buf x1
3082 return $ case mx2 of
3083 Nothing -> Skip (SplitBuffering s buf')
3084 Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))
3085 Skip s -> return $ Skip (SplitBuffering s buf)
3089 else Skip (SplitYielding buf SplitFinishing)
3091 step _ (SplitSplitting st buf) = do
3092 (x1, mx2) <- splitter buf
3093 return $ case mx2 of
3094 Nothing -> Skip $ SplitBuffering st x1
3095 Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)
3097 step _ (SplitYielding x next) = return $ Yield x next
3098 step _ SplitFinishing = return Stop
3100------------------------------------------------------------------------------
3102------------------------------------------------------------------------------
3104-- | Drop prefix from the input stream if present.
3109{-# INLINE dropPrefix #-}
3111 -- (Monad m, Eq a) =>
3112 Stream m a -> Stream m a -> Stream m a
3113dropPrefix = error "Not implemented yet!"
3115-- | Drop all matching infix from the input stream if present. Infix stream
3116-- may be consumed multiple times.
3118-- Space: @O(n)@ where n is the length of the infix.
3121{-# INLINE dropInfix #-}
3123 -- (Monad m, Eq a) =>
3124 Stream m a -> Stream m a -> Stream m a
3125dropInfix = error "Not implemented yet!"
3127-- | Drop suffix from the input stream if present. Suffix stream may be
3128-- consumed multiple times.
3130-- Space: @O(n)@ where n is the length of the suffix.
3133{-# INLINE dropSuffix #-}
3135 -- (Monad m, Eq a) =>
3136 Stream m a -> Stream m a -> Stream m a
3137dropSuffix = error "Not implemented yet!"
keysesc to close
- j k
- move down, up
- enter
- open
- esc
- back, or up a level
- 1 2 3 4
- readme, files, commits, refs
- /
- filter
- y
- copy the clone command
- c
- compare the chosen commit with another (or shift-click both)
- ?
- show or hide this list