2-- Module : Streamly.Internal.Data.Stream.StreamD.Nesting
3-- Copyright : (c) 2018 Composewell Technologies
4-- (c) Roman Leshchinskiy 2008-2010
5-- License : BSD-3-Clause
6-- Maintainer : streamly@composewell.com
7-- Stability : experimental
10-- This module contains transformations involving multiple streams, unfolds or
11-- folds. There are two types of transformations generational or eliminational.
12-- Generational transformations are like the "Generate" module but they
13-- generate a stream by combining streams instead of elements. Eliminational
14-- transformations are like the "Eliminate" module but they transform a stream
15-- by eliminating parts of the stream instead of eliminating the whole stream.
17-- These combinators involve transformation, generation, elimination so can be
18-- classified under any of those.
20-- Ultimately these operations should be supported by Unfolds, Pipes and Folds,
21-- and this module may become redundant.
23-- The zipWithM combinator in this module has been adapted from the vector
24-- package (c) Roman Leshchinskiy.
26module Streamly.Internal.Data.Stream.StreamD.Nesting
29 -- | Combining streams to generate streams.
31 -- ** Combine Two Streams
32 -- | Functions ending in the shape:
34 -- @t m a -> t m a -> t m a@.
37 -- | Append a stream after another. A special case of concatMap or
43 -- | Interleave elements from two streams alternately. A special case of
52 -- | Execute streams alternately irrespective of whether they generate
53 -- elements or not. Note 'interleave' would execute a stream until it
54 -- yields an element. A special case of unfoldRoundRobin.
55 , roundRobin -- interleaveFair?/ParallelFair
58 -- | Zip corresponding elements of two streams.
63 -- | Interleave elements from two streams based on a condition.
69 -- ** Combine N Streams
70 -- | Functions generally ending in these shapes:
73 -- concat: f (t m a) -> t m a
74 -- concatMap: (a -> t m b) -> t m a -> t m b
75 -- unfoldMany: Unfold m a b -> t m a -> t m b
79 -- | Generate streams by mapping a stream generator on each element of an
80 -- input stream, append the resulting streams and flatten.
85 -- | Generate streams by using an unfold on each element of an input
86 -- stream, append the resulting streams and flatten. A special case of
89 , ConcatUnfoldInterleaveState (..)
94 -- | Like unfoldMany but intersperses an effect between the streams. A
95 -- special case of gintercalate.
102 -- | Like unfoldMany but intersperses streams from another source between
103 -- the streams from the first source.
110 -- | Folding and Parsing chunks of streams to eliminate nested streams.
111 -- Functions generally ending in these shapes:
114 -- f (Fold m a b) -> t m a -> t m b
115 -- f (Parser a m b) -> t m a -> t m b
119 -- | Apply folds on a stream.
127 -- | Parsing is opposite to flattening. 'parseMany' is dual to concatMap or
128 -- unfoldMany. concatMap generates a stream from single values in a
129 -- stream and flattens, parseMany does the opposite of flattening by
130 -- splitting the stream and then folds each such split to single value in
131 -- the output stream.
140 -- | Group segments of a stream and fold. Special case of parsing.
146 -- | A special case of parsing.
152 -- XXX Implement these as folds or parsers instead.
153 , splitOnSuffixSeqAny
157 -- * Transform (Nested Containers)
158 -- | Opposite to compact in ArrayStream
163 -- * Reduce By Streams
171#include "ArrayMacros.h"
173import Control.Exception (assert)
174import Control.Monad.IO.Class (MonadIO(..))
175import Data.Bits (shiftR, shiftL, (.|.), (.&.))
176import Data.Proxy (Proxy(..))
177import Data.Word (Word32)
178import Foreign.Storable (Storable, peek)
179import Fusion.Plugin.Types (Fuse(..))
180import GHC.Types (SPEC(..))
182import Streamly.Internal.Data.Array.Type (Array(..))
183import Streamly.Internal.Data.Fold.Step (Step(..))
184import Streamly.Internal.Data.Fold.Type (Fold(..))
185import Streamly.Internal.Data.Parser (ParseError(..))
186import Streamly.Internal.Data.Refold.Type (Refold(..))
187import Streamly.Internal.Data.SVar.Type (adaptState)
188import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
189import Streamly.Internal.Data.Unboxed (Unbox, sizeOf)
190import Streamly.Internal.Data.Unfold.Type (Unfold(..))
192import qualified Streamly.Internal.Data.Array.Type as A
193import qualified Streamly.Internal.Data.Fold as FL
194import qualified Streamly.Internal.Data.Parser as PR
195import qualified Streamly.Internal.Data.Parser.ParserD as PRD
196import qualified Streamly.Internal.Data.Ring.Unboxed as RB
198import Streamly.Internal.Data.Stream.StreamD.Transform
199 (intersperse, intersperseMSuffix)
200import Streamly.Internal.Data.Stream.StreamD.Type
202import Prelude hiding (concatMap, mapM, zipWith)
206-- >>> import Data.Either (either)
207-- >>> import Data.IORef
208-- >>> import Streamly.Internal.Data.Stream (Stream)
209-- >>> import Prelude hiding (zipWith, concatMap, concat)
210-- >>> import qualified Streamly.Data.Array as Array
211-- >>> import qualified Streamly.Internal.Data.Fold as Fold
212-- >>> import qualified Streamly.Internal.Data.Stream as Stream
213-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold
214-- >>> import qualified Streamly.Internal.Data.Parser as Parser
215-- >>> import qualified Streamly.Internal.FileSystem.Dir as Dir
218------------------------------------------------------------------------------
220------------------------------------------------------------------------------
222data AppendState s1 s2 = AppendFirst s1 | AppendSecond s2
224-- | Fuses two streams sequentially, yielding all elements from the first
225-- stream, and then all elements from the second stream.
227-- >>> s1 = Stream.fromList [1,2]
228-- >>> s2 = Stream.fromList [3,4]
229-- >>> Stream.fold Fold.toList $ s1 `Stream.append` s2
232-- This function should not be used to dynamically construct a stream. If a
233-- stream is constructed by successive use of this function it would take
234-- quadratic time complexity to consume the stream.
236-- This function should only be used to statically fuse a stream with another
237-- stream. Do not use this recursively or where it cannot be inlined.
239-- See "Streamly.Data.Stream.StreamK" for an 'append' that can be used to
240-- construct a stream recursively.
242{-# INLINE_NORMAL append #-}
243append :: Monad m => Stream m a -> Stream m a -> Stream m a
244append (Stream step1 state1) (Stream step2 state2) =
245 Stream step (AppendFirst state1)
249 {-# INLINE_LATE step #-}
250 step gst (AppendFirst st) = do
253 Yield a s -> Yield a (AppendFirst s)
254 Skip s -> Skip (AppendFirst s)
255 Stop -> Skip (AppendSecond state2)
257 step gst (AppendSecond st) = do
260 Yield a s -> Yield a (AppendSecond s)
261 Skip s -> Skip (AppendSecond s)
264------------------------------------------------------------------------------
266------------------------------------------------------------------------------
268data InterleaveState s1 s2 = InterleaveFirst s1 s2 | InterleaveSecond s1 s2
269 | InterleaveSecondOnly s2 | InterleaveFirstOnly s1
271-- | Interleaves two streams, yielding one element from each stream
272-- alternately. When one stream stops the rest of the other stream is used in
275-- When joining many streams in a left associative manner earlier streams will
276-- get exponential priority than the ones joining later. Because of exponential
277-- weighting it can be used with 'concatMapWith' even on a large number of
280{-# INLINE_NORMAL interleave #-}
281interleave :: Monad m => Stream m a -> Stream m a -> Stream m a
282interleave (Stream step1 state1) (Stream step2 state2) =
283 Stream step (InterleaveFirst state1 state2)
287 {-# INLINE_LATE step #-}
288 step gst (InterleaveFirst st1 st2) = do
291 Yield a s -> Yield a (InterleaveSecond s st2)
292 Skip s -> Skip (InterleaveFirst s st2)
293 Stop -> Skip (InterleaveSecondOnly st2)
295 step gst (InterleaveSecond st1 st2) = do
298 Yield a s -> Yield a (InterleaveFirst st1 s)
299 Skip s -> Skip (InterleaveSecond st1 s)
300 Stop -> Skip (InterleaveFirstOnly st1)
302 step gst (InterleaveFirstOnly st1) = do
305 Yield a s -> Yield a (InterleaveFirstOnly s)
306 Skip s -> Skip (InterleaveFirstOnly s)
309 step gst (InterleaveSecondOnly st2) = do
312 Yield a s -> Yield a (InterleaveSecondOnly s)
313 Skip s -> Skip (InterleaveSecondOnly s)
316-- | Like `interleave` but stops interleaving as soon as any of the two streams
319{-# INLINE_NORMAL interleaveMin #-}
320interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a
321interleaveMin (Stream step1 state1) (Stream step2 state2) =
322 Stream step (InterleaveFirst state1 state2)
326 {-# INLINE_LATE step #-}
327 step gst (InterleaveFirst st1 st2) = do
330 Yield a s -> Yield a (InterleaveSecond s st2)
331 Skip s -> Skip (InterleaveFirst s st2)
334 step gst (InterleaveSecond st1 st2) = do
337 Yield a s -> Yield a (InterleaveFirst st1 s)
338 Skip s -> Skip (InterleaveSecond st1 s)
341 step _ (InterleaveFirstOnly _) = undefined
342 step _ (InterleaveSecondOnly _) = undefined
344-- | Interleaves the outputs of two streams, yielding elements from each stream
345-- alternately, starting from the first stream. As soon as the first stream
346-- finishes, the output stops, discarding the remaining part of the second
347-- stream. In this case, the last element in the resulting stream would be from
348-- the second stream. If the second stream finishes early then the first stream
349-- still continues to yield elements until it finishes.
351-- >>> :set -XOverloadedStrings
352-- >>> import Data.Functor.Identity (Identity)
353-- >>> Stream.interleaveFstSuffix "abc" ",,,," :: Stream Identity Char
355-- >>> Stream.interleaveFstSuffix "abc" "," :: Stream Identity Char
358-- 'interleaveFstSuffix' is a dual of 'interleaveFst'.
360-- Do not use dynamically.
363{-# INLINE_NORMAL interleaveFstSuffix #-}
364interleaveFstSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a
365interleaveFstSuffix (Stream step1 state1) (Stream step2 state2) =
366 Stream step (InterleaveFirst state1 state2)
370 {-# INLINE_LATE step #-}
371 step gst (InterleaveFirst st1 st2) = do
374 Yield a s -> Yield a (InterleaveSecond s st2)
375 Skip s -> Skip (InterleaveFirst s st2)
378 step gst (InterleaveSecond st1 st2) = do
381 Yield a s -> Yield a (InterleaveFirst st1 s)
382 Skip s -> Skip (InterleaveSecond st1 s)
383 Stop -> Skip (InterleaveFirstOnly st1)
385 step gst (InterleaveFirstOnly st1) = do
388 Yield a s -> Yield a (InterleaveFirstOnly s)
389 Skip s -> Skip (InterleaveFirstOnly s)
392 step _ (InterleaveSecondOnly _) = undefined
394data InterleaveInfixState s1 s2 a
395 = InterleaveInfixFirst s1 s2
396 | InterleaveInfixSecondBuf s1 s2
397 | InterleaveInfixSecondYield s1 s2 a
398 | InterleaveInfixFirstYield s1 s2 a
399 | InterleaveInfixFirstOnly s1
401-- | Interleaves the outputs of two streams, yielding elements from each stream
402-- alternately, starting from the first stream and ending at the first stream.
403-- If the second stream is longer than the first, elements from the second
404-- stream are infixed with elements from the first stream. If the first stream
405-- is longer then it continues yielding elements even after the second stream
408-- >>> :set -XOverloadedStrings
409-- >>> import Data.Functor.Identity (Identity)
410-- >>> Stream.interleaveFst "abc" ",,,," :: Stream Identity Char
412-- >>> Stream.interleaveFst "abc" "," :: Stream Identity Char
415-- 'interleaveFst' is a dual of 'interleaveFstSuffix'.
417-- Do not use dynamically.
420{-# INLINE_NORMAL interleaveFst #-}
421interleaveFst :: Monad m => Stream m a -> Stream m a -> Stream m a
422interleaveFst (Stream step1 state1) (Stream step2 state2) =
423 Stream step (InterleaveInfixFirst state1 state2)
427 {-# INLINE_LATE step #-}
428 step gst (InterleaveInfixFirst st1 st2) = do
431 Yield a s -> Yield a (InterleaveInfixSecondBuf s st2)
432 Skip s -> Skip (InterleaveInfixFirst s st2)
435 step gst (InterleaveInfixSecondBuf st1 st2) = do
438 Yield a s -> Skip (InterleaveInfixSecondYield st1 s a)
439 Skip s -> Skip (InterleaveInfixSecondBuf st1 s)
440 Stop -> Skip (InterleaveInfixFirstOnly st1)
442 step gst (InterleaveInfixSecondYield st1 st2 x) = do
445 Yield a s -> Yield x (InterleaveInfixFirstYield s st2 a)
446 Skip s -> Skip (InterleaveInfixSecondYield s st2 x)
449 step _ (InterleaveInfixFirstYield st1 st2 x) = do
450 return $ Yield x (InterleaveInfixSecondBuf st1 st2)
452 step gst (InterleaveInfixFirstOnly st1) = do
455 Yield a s -> Yield a (InterleaveInfixFirstOnly s)
456 Skip s -> Skip (InterleaveInfixFirstOnly s)
459------------------------------------------------------------------------------
461------------------------------------------------------------------------------
463-- | Schedule the execution of two streams in a fair round-robin manner,
464-- executing each stream once, alternately. Execution of a stream may not
465-- necessarily result in an output, a stream may choose to @Skip@ producing an
466-- element until later giving the other stream a chance to run. Therefore, this
467-- combinator fairly interleaves the execution of two streams rather than
468-- fairly interleaving the output of the two streams. This can be useful in
469-- co-operative multitasking without using explicit threads. This can be used
470-- as an alternative to `async`.
472-- Do not use dynamically.
475{-# INLINE_NORMAL roundRobin #-}
476roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a
477roundRobin (Stream step1 state1) (Stream step2 state2) =
478 Stream step (InterleaveFirst state1 state2)
482 {-# INLINE_LATE step #-}
483 step gst (InterleaveFirst st1 st2) = do
486 Yield a s -> Yield a (InterleaveSecond s st2)
487 Skip s -> Skip (InterleaveSecond s st2)
488 Stop -> Skip (InterleaveSecondOnly st2)
490 step gst (InterleaveSecond st1 st2) = do
493 Yield a s -> Yield a (InterleaveFirst st1 s)
494 Skip s -> Skip (InterleaveFirst st1 s)
495 Stop -> Skip (InterleaveFirstOnly st1)
497 step gst (InterleaveSecondOnly st2) = do
500 Yield a s -> Yield a (InterleaveSecondOnly s)
501 Skip s -> Skip (InterleaveSecondOnly s)
504 step gst (InterleaveFirstOnly st1) = do
507 Yield a s -> Yield a (InterleaveFirstOnly s)
508 Skip s -> Skip (InterleaveFirstOnly s)
511------------------------------------------------------------------------------
513------------------------------------------------------------------------------
515-- | Like 'mergeBy' but with a monadic comparison function.
517-- Merge two streams randomly:
520-- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT
521-- > Stream.toList $ Stream.mergeByM randomly (Stream.fromList [1,1,1,1]) (Stream.fromList [2,2,2,2])
525-- Merge two streams in a proportion of 2:1:
529-- let s1 = Stream.fromList [1,1,1,1,1,1]
530-- s2 = Stream.fromList [2,2,2]
531-- let proportionately m n = do
532-- ref <- newIORef $ cycle $ Prelude.concat [Prelude.replicate m LT, Prelude.replicate n GT]
533-- return $ \_ _ -> do
535-- writeIORef ref $ Prelude.tail r
536-- return $ Prelude.head r
537-- f <- proportionately 2 1
538-- xs <- Stream.fold Fold.toList $ Stream.mergeByM f s1 s2
541-- [1,1,2,1,1,2,1,1,2]
543{-# INLINE_NORMAL mergeByM #-}
546 => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
547mergeByM cmp (Stream stepa ta) (Stream stepb tb) =
548 Stream step (Just ta, Just tb, Nothing, Nothing)
550 {-# INLINE_LATE step #-}
552 -- one of the values is missing, and the corresponding stream is running
553 step gst (Just sa, sb, Nothing, b) = do
556 Yield a sa' -> Skip (Just sa', sb, Just a, b)
557 Skip sa' -> Skip (Just sa', sb, Nothing, b)
558 Stop -> Skip (Nothing, sb, Nothing, b)
560 step gst (sa, Just sb, a, Nothing) = do
563 Yield b sb' -> Skip (sa, Just sb', a, Just b)
564 Skip sb' -> Skip (sa, Just sb', a, Nothing)
565 Stop -> Skip (sa, Nothing, a, Nothing)
567 -- both the values are available
568 step _ (sa, sb, Just a, Just b) = do
571 GT -> Yield b (sa, sb, Just a, Nothing)
572 _ -> Yield a (sa, sb, Nothing, Just b)
574 -- one of the values is missing, corresponding stream is done
575 step _ (Nothing, sb, Nothing, Just b) =
576 return $ Yield b (Nothing, sb, Nothing, Nothing)
578 step _ (sa, Nothing, Just a, Nothing) =
579 return $ Yield a (sa, Nothing, Nothing, Nothing)
581 step _ (Nothing, Nothing, Nothing, Nothing) = return Stop
583-- | Merge two streams using a comparison function. The head elements of both
584-- the streams are compared and the smaller of the two elements is emitted, if
585-- both elements are equal then the element from the first stream is used
588-- If the streams are sorted in ascending order, the resulting stream would
589-- also remain sorted in ascending order.
591-- >>> s1 = Stream.fromList [1,3,5]
592-- >>> s2 = Stream.fromList [2,4,6,8]
593-- >>> Stream.fold Fold.toList $ Stream.mergeBy compare s1 s2
596{-# INLINE mergeBy #-}
599 => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a
600mergeBy cmp = mergeByM (\a b -> return $ cmp a b)
602-- | Like 'mergeByM' but stops merging as soon as any of the two streams stops.
605{-# INLINABLE mergeMinBy #-}
606mergeMinBy :: -- Monad m =>
607 (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
608mergeMinBy _f _m1 _m2 = undefined
609 -- fromStreamD $ D.mergeMinBy f (toStreamD m1) (toStreamD m2)
611-- | Like 'mergeByM' but stops merging as soon as the first stream stops.
614{-# INLINABLE mergeFstBy #-}
615mergeFstBy :: -- Monad m =>
616 (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
617mergeFstBy _f _m1 _m2 = undefined
618 -- fromStreamK $ D.mergeFstBy f (toStreamD m1) (toStreamD m2)
620-------------------------------------------------------------------------------
621-- Intersection of sorted streams
622-------------------------------------------------------------------------------
624-- Assuming the streams are sorted in ascending order
625{-# INLINE_NORMAL intersectBySorted #-}
626intersectBySorted :: Monad m
627 => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a
628intersectBySorted cmp (Stream stepa ta) (Stream stepb tb) =
630 ( ta -- left stream state
631 , tb -- right stream state
632 , Nothing -- left value
633 , Nothing -- right value
638 {-# INLINE_LATE step #-}
639 -- step 1, fetch the first value
640 step gst (sa, sb, Nothing, b) = do
643 Yield a sa' -> Skip (sa', sb, Just a, b) -- step 2/3
644 Skip sa' -> Skip (sa', sb, Nothing, b)
647 -- step 2, fetch the second value
648 step gst (sa, sb, a@(Just _), Nothing) = do
651 Yield b sb' -> Skip (sa, sb', a, Just b) -- step 3
652 Skip sb' -> Skip (sa, sb', a, Nothing)
655 -- step 3, compare the two values
656 step _ (sa, sb, Just a, Just b) = do
659 GT -> Skip (sa, sb, Just a, Nothing) -- step 2
660 LT -> Skip (sa, sb, Nothing, Just b) -- step 1
661 EQ -> Yield a (sa, sb, Nothing, Just b) -- step 1
663------------------------------------------------------------------------------
664-- Combine N Streams - unfoldMany
665------------------------------------------------------------------------------
667data ConcatUnfoldInterleaveState o i =
668 ConcatUnfoldInterleaveOuter o [i]
669 | ConcatUnfoldInterleaveInner o [i]
670 | ConcatUnfoldInterleaveInnerL [i] [i]
671 | ConcatUnfoldInterleaveInnerR [i] [i]
673-- XXX use arrays to store state instead of lists?
675-- XXX In general we can use different scheduling strategies e.g. how to
676-- schedule the outer vs inner loop or assigning weights to different streams
677-- or outer and inner loops.
679-- After a yield, switch to the next stream. Do not switch streams on Skip.
680-- Yield from outer stream switches to the inner stream.
682-- There are two choices here, (1) exhaust the outer stream first and then
683-- start yielding from the inner streams, this is much simpler to implement,
684-- (2) yield at least one element from an inner stream before going back to
685-- outer stream and opening the next stream from it.
687-- Ideally, we need some scheduling bias to inner streams vs outer stream.
688-- Maybe we can configure the behavior.
690-- XXX Instead of using "concatPairsWith wSerial" we can implement an N-way
691-- interleaving CPS combinator which behaves like unfoldInterleave. Instead
692-- of pairing up the streams we just need to go yielding one element from each
693-- stream and storing the remaining streams and then keep doing rounds through
694-- those in a round robin fashion. This would be much like wAsync.
696-- | This does not pair streams like mergeMapWith, instead, it goes through
697-- each stream one by one and yields one element from each stream. After it
698-- goes to the last stream it reverses the traversal to come back to the first
699-- stream yielding elements from each stream on its way back to the first
702-- >>> lists = Stream.fromList [[1,1],[2,2],[3,3],[4,4],[5,5]]
703-- >>> interleaved = Stream.unfoldInterleave Unfold.fromList lists
704-- >>> Stream.fold Fold.toList interleaved
705-- [1,2,3,4,5,5,4,3,2,1]
707-- Note that this is order of magnitude more efficient than "mergeMapWith
708-- interleave" because of fusion.
710{-# INLINE_NORMAL unfoldInterleave #-}
711unfoldInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b
712unfoldInterleave (Unfold istep inject) (Stream ostep ost) =
713 Stream step (ConcatUnfoldInterleaveOuter ost [])
717 {-# INLINE_LATE step #-}
718 step gst (ConcatUnfoldInterleaveOuter o ls) = do
719 r <- ostep (adaptState gst) o
723 i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))
724 Skip o' -> return $ Skip (ConcatUnfoldInterleaveOuter o' ls)
725 Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
727 step _ (ConcatUnfoldInterleaveInner _ []) = undefined
728 step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do
731 Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))
732 Skip s -> Skip (ConcatUnfoldInterleaveInner o (s:ls))
733 Stop -> Skip (ConcatUnfoldInterleaveOuter o ls)
735 step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop
736 step _ (ConcatUnfoldInterleaveInnerL [] rs) =
737 return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)
739 step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do
742 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))
743 Skip s -> Skip (ConcatUnfoldInterleaveInnerL (s:ls) rs)
744 Stop -> Skip (ConcatUnfoldInterleaveInnerL ls rs)
746 step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop
747 step _ (ConcatUnfoldInterleaveInnerR ls []) =
748 return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
750 step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do
753 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)
754 Skip s -> Skip (ConcatUnfoldInterleaveInnerR ls (s:rs))
755 Stop -> Skip (ConcatUnfoldInterleaveInnerR ls rs)
757-- XXX In general we can use different scheduling strategies e.g. how to
758-- schedule the outer vs inner loop or assigning weights to different streams
759-- or outer and inner loops.
761-- This could be inefficient if the tasks are too small.
763-- Compared to unfoldInterleave this one switches streams on Skips.
765-- | 'unfoldInterleave' switches to the next stream whenever a value from a
766-- stream is yielded, it does not switch on a 'Skip'. So if a stream keeps
767-- skipping for long time other streams won't get a chance to run.
768-- 'unfoldRoundRobin' switches on Skip as well. So it basically schedules each
769-- stream fairly irrespective of whether it produces a value or not.
771{-# INLINE_NORMAL unfoldRoundRobin #-}
772unfoldRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b
773unfoldRoundRobin (Unfold istep inject) (Stream ostep ost) =
774 Stream step (ConcatUnfoldInterleaveOuter ost [])
776 {-# INLINE_LATE step #-}
777 step gst (ConcatUnfoldInterleaveOuter o ls) = do
778 r <- ostep (adaptState gst) o
782 i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))
783 Skip o' -> return $ Skip (ConcatUnfoldInterleaveInner o' ls)
784 Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
786 step _ (ConcatUnfoldInterleaveInner o []) =
787 return $ Skip (ConcatUnfoldInterleaveOuter o [])
789 step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do
792 Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))
793 Skip s -> Skip (ConcatUnfoldInterleaveOuter o (s:ls))
794 Stop -> Skip (ConcatUnfoldInterleaveOuter o ls)
796 step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop
797 step _ (ConcatUnfoldInterleaveInnerL [] rs) =
798 return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)
800 step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do
803 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))
804 Skip s -> Skip (ConcatUnfoldInterleaveInnerL ls (s:rs))
805 Stop -> Skip (ConcatUnfoldInterleaveInnerL ls rs)
807 step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop
808 step _ (ConcatUnfoldInterleaveInnerR ls []) =
809 return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
811 step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do
814 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)
815 Skip s -> Skip (ConcatUnfoldInterleaveInnerR (s:ls) rs)
816 Stop -> Skip (ConcatUnfoldInterleaveInnerR ls rs)
818------------------------------------------------------------------------------
819-- Combine N Streams - interpose
820------------------------------------------------------------------------------
822{-# ANN type InterposeSuffixState Fuse #-}
823data InterposeSuffixState s1 i1 =
824 InterposeSuffixFirst s1
825 -- | InterposeSuffixFirstYield s1 i1
826 | InterposeSuffixFirstInner s1 i1
827 | InterposeSuffixSecond s1
829-- Note that if an unfolded layer turns out to be nil we still emit the
830-- separator effect. An alternate behavior could be to emit the separator
831-- effect only if at least one element has been yielded by the unfolding.
832-- However, that becomes a bit complicated, so we have chosen the former
834{-# INLINE_NORMAL interposeSuffixM #-}
837 => m c -> Unfold m b c -> Stream m b -> Stream m c
840 (Unfold istep1 inject1) (Stream step1 state1) =
841 Stream step (InterposeSuffixFirst state1)
845 {-# INLINE_LATE step #-}
846 step gst (InterposeSuffixFirst s1) = do
847 r <- step1 (adaptState gst) s1
851 i `seq` return (Skip (InterposeSuffixFirstInner s i))
852 -- i `seq` return (Skip (InterposeSuffixFirstYield s i))
853 Skip s -> return $ Skip (InterposeSuffixFirst s)
857 step _ (InterposeSuffixFirstYield s1 i1) = do
860 Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')
861 Skip i' -> Skip (InterposeSuffixFirstYield s1 i')
862 Stop -> Skip (InterposeSuffixFirst s1)
865 step _ (InterposeSuffixFirstInner s1 i1) = do
868 Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')
869 Skip i' -> Skip (InterposeSuffixFirstInner s1 i')
870 Stop -> Skip (InterposeSuffixSecond s1)
872 step _ (InterposeSuffixSecond s1) = do
874 return $ Yield r (InterposeSuffixFirst s1)
876-- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x)
878-- | Unfold the elements of a stream, append the given element after each
879-- unfolded stream and then concat them into a single stream.
881-- >>> unlines = Stream.interposeSuffix '\n'
884{-# INLINE interposeSuffix #-}
885interposeSuffix :: Monad m
886 => c -> Unfold m b c -> Stream m b -> Stream m c
887interposeSuffix x = interposeSuffixM (return x)
889{-# ANN type InterposeState Fuse #-}
890data InterposeState s1 i1 a =
892 -- | InterposeFirstYield s1 i1
893 | InterposeFirstInner s1 i1
894 | InterposeFirstInject s1
895 -- | InterposeFirstBuf s1 i1
896 | InterposeSecondYield s1 i1
897 -- -- | InterposeSecondYield s1 i1 a
898 -- -- | InterposeFirstResume s1 i1 a
900-- Note that this only interposes the pure values, we may run many effects to
901-- generate those values as some effects may not generate anything (Skip).
902{-# INLINE_NORMAL interposeM #-}
903interposeM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c
906 (Unfold istep1 inject1) (Stream step1 state1) =
907 Stream step (InterposeFirst state1)
911 {-# INLINE_LATE step #-}
912 step gst (InterposeFirst s1) = do
913 r <- step1 (adaptState gst) s1
917 i `seq` return (Skip (InterposeFirstInner s i))
918 -- i `seq` return (Skip (InterposeFirstYield s i))
919 Skip s -> return $ Skip (InterposeFirst s)
923 step _ (InterposeFirstYield s1 i1) = do
926 Yield x i' -> Yield x (InterposeFirstInner s1 i')
927 Skip i' -> Skip (InterposeFirstYield s1 i')
928 Stop -> Skip (InterposeFirst s1)
931 step _ (InterposeFirstInner s1 i1) = do
934 Yield x i' -> Yield x (InterposeFirstInner s1 i')
935 Skip i' -> Skip (InterposeFirstInner s1 i')
936 Stop -> Skip (InterposeFirstInject s1)
938 step gst (InterposeFirstInject s1) = do
939 r <- step1 (adaptState gst) s1
943 -- i `seq` return (Skip (InterposeFirstBuf s i))
944 i `seq` return (Skip (InterposeSecondYield s i))
945 Skip s -> return $ Skip (InterposeFirstInject s)
949 step _ (InterposeFirstBuf s1 i1) = do
952 Yield x i' -> Skip (InterposeSecondYield s1 i' x)
953 Skip i' -> Skip (InterposeFirstBuf s1 i')
958 step _ (InterposeSecondYield s1 i1 v) = do
960 return $ Yield r (InterposeFirstResume s1 i1 v)
962 step _ (InterposeSecondYield s1 i1) = do
964 return $ Yield r (InterposeFirstInner s1 i1)
967 step _ (InterposeFirstResume s1 i1 v) = do
968 return $ Yield v (InterposeFirstInner s1 i1)
971-- > interpose x unf str = gintercalate unf str UF.identity (repeat x)
973-- | Unfold the elements of a stream, intersperse the given element between the
974-- unfolded streams and then concat them into a single stream.
976-- >>> unwords = Stream.interpose ' '
979{-# INLINE interpose #-}
981 => c -> Unfold m b c -> Stream m b -> Stream m c
982interpose x = interposeM (return x)
984------------------------------------------------------------------------------
985-- Combine N Streams - intercalate
986------------------------------------------------------------------------------
988data ICUState s1 s2 i1 i2 =
993 | ICUFirstInner s1 s2 i1
994 | ICUSecondInner s1 s2 i2
995 | ICUFirstOnlyInner s1 i1
996 | ICUSecondOnlyInner s2 i2
998-- | 'interleaveFstSuffix' followed by unfold and concat.
1001{-# INLINE_NORMAL gintercalateSuffix #-}
1004 => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
1006 (Unfold istep1 inject1) (Stream step1 state1)
1007 (Unfold istep2 inject2) (Stream step2 state2) =
1008 Stream step (ICUFirst state1 state2)
1012 {-# INLINE_LATE step #-}
1013 step gst (ICUFirst s1 s2) = do
1014 r <- step1 (adaptState gst) s1
1018 i `seq` return (Skip (ICUFirstInner s s2 i))
1019 Skip s -> return $ Skip (ICUFirst s s2)
1022 step gst (ICUFirstOnly s1) = do
1023 r <- step1 (adaptState gst) s1
1027 i `seq` return (Skip (ICUFirstOnlyInner s i))
1028 Skip s -> return $ Skip (ICUFirstOnly s)
1031 step _ (ICUFirstInner s1 s2 i1) = do
1034 Yield x i' -> Yield x (ICUFirstInner s1 s2 i')
1035 Skip i' -> Skip (ICUFirstInner s1 s2 i')
1036 Stop -> Skip (ICUSecond s1 s2)
1038 step _ (ICUFirstOnlyInner s1 i1) = do
1041 Yield x i' -> Yield x (ICUFirstOnlyInner s1 i')
1042 Skip i' -> Skip (ICUFirstOnlyInner s1 i')
1043 Stop -> Skip (ICUFirstOnly s1)
1045 step gst (ICUSecond s1 s2) = do
1046 r <- step2 (adaptState gst) s2
1050 i `seq` return (Skip (ICUSecondInner s1 s i))
1051 Skip s -> return $ Skip (ICUSecond s1 s)
1052 Stop -> return $ Skip (ICUFirstOnly s1)
1054 step _ (ICUSecondInner s1 s2 i2) = do
1057 Yield x i' -> Yield x (ICUSecondInner s1 s2 i')
1058 Skip i' -> Skip (ICUSecondInner s1 s2 i')
1059 Stop -> Skip (ICUFirst s1 s2)
1061 step _ (ICUSecondOnly _s2) = undefined
1062 step _ (ICUSecondOnlyInner _s2 _i2) = undefined
1064data ICALState s1 s2 i1 i2 a =
1066 -- | ICALFirstYield s1 s2 i1
1067 | ICALFirstInner s1 s2 i1
1069 | ICALFirstOnlyInner s1 i1
1070 | ICALSecondInject s1 s2
1071 | ICALFirstInject s1 s2 i2
1072 -- | ICALFirstBuf s1 s2 i1 i2
1073 | ICALSecondInner s1 s2 i1 i2
1074 -- -- | ICALSecondInner s1 s2 i1 i2 a
1075 -- -- | ICALFirstResume s1 s2 i1 i2 a
1077-- XXX we can swap the order of arguments to gintercalate so that the
1078-- definition of unfoldMany becomes simpler? The first stream should be
1079-- infixed inside the second one. However, if we change the order in
1080-- "interleave" as well similarly, then that will make it a bit unintuitive.
1082-- > unfoldMany unf str =
1083-- > gintercalate unf str (UF.nilM (\_ -> return ())) (repeat ())
1085-- | 'interleaveFst' followed by unfold and concat.
1088{-# INLINE_NORMAL gintercalate #-}
1091 => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
1093 (Unfold istep1 inject1) (Stream step1 state1)
1094 (Unfold istep2 inject2) (Stream step2 state2) =
1095 Stream step (ICALFirst state1 state2)
1099 {-# INLINE_LATE step #-}
1100 step gst (ICALFirst s1 s2) = do
1101 r <- step1 (adaptState gst) s1
1105 i `seq` return (Skip (ICALFirstInner s s2 i))
1106 -- i `seq` return (Skip (ICALFirstYield s s2 i))
1107 Skip s -> return $ Skip (ICALFirst s s2)
1111 step _ (ICALFirstYield s1 s2 i1) = do
1114 Yield x i' -> Yield x (ICALFirstInner s1 s2 i')
1115 Skip i' -> Skip (ICALFirstYield s1 s2 i')
1116 Stop -> Skip (ICALFirst s1 s2)
1119 step _ (ICALFirstInner s1 s2 i1) = do
1122 Yield x i' -> Yield x (ICALFirstInner s1 s2 i')
1123 Skip i' -> Skip (ICALFirstInner s1 s2 i')
1124 Stop -> Skip (ICALSecondInject s1 s2)
1126 step gst (ICALFirstOnly s1) = do
1127 r <- step1 (adaptState gst) s1
1131 i `seq` return (Skip (ICALFirstOnlyInner s i))
1132 Skip s -> return $ Skip (ICALFirstOnly s)
1135 step _ (ICALFirstOnlyInner s1 i1) = do
1138 Yield x i' -> Yield x (ICALFirstOnlyInner s1 i')
1139 Skip i' -> Skip (ICALFirstOnlyInner s1 i')
1140 Stop -> Skip (ICALFirstOnly s1)
1142 -- We inject the second stream even before checking if the first stream
1143 -- would yield any more elements. There is no clear choice whether we
1144 -- should do this before or after that. Doing it after may make the state
1145 -- machine a bit simpler though.
1146 step gst (ICALSecondInject s1 s2) = do
1147 r <- step2 (adaptState gst) s2
1151 i `seq` return (Skip (ICALFirstInject s1 s i))
1152 Skip s -> return $ Skip (ICALSecondInject s1 s)
1153 Stop -> return $ Skip (ICALFirstOnly s1)
1155 step gst (ICALFirstInject s1 s2 i2) = do
1156 r <- step1 (adaptState gst) s1
1160 i `seq` return (Skip (ICALSecondInner s s2 i i2))
1161 -- i `seq` return (Skip (ICALFirstBuf s s2 i i2))
1162 Skip s -> return $ Skip (ICALFirstInject s s2 i2)
1166 step _ (ICALFirstBuf s1 s2 i1 i2) = do
1169 Yield x i' -> Skip (ICALSecondInner s1 s2 i' i2 x)
1170 Skip i' -> Skip (ICALFirstBuf s1 s2 i' i2)
1173 step _ (ICALSecondInner s1 s2 i1 i2 v) = do
1176 Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i' v)
1177 Skip i' -> Skip (ICALSecondInner s1 s2 i1 i' v)
1178 Stop -> Skip (ICALFirstResume s1 s2 i1 i2 v)
1181 step _ (ICALSecondInner s1 s2 i1 i2) = do
1184 Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i')
1185 Skip i' -> Skip (ICALSecondInner s1 s2 i1 i')
1186 Stop -> Skip (ICALFirstInner s1 s2 i1)
1187 -- Stop -> Skip (ICALFirstResume s1 s2 i1 i2)
1190 step _ (ICALFirstResume s1 s2 i1 i2 x) = do
1191 return $ Yield x (ICALFirstInner s1 s2 i1 i2)
1194-- > intercalateSuffix unf seed str = gintercalateSuffix unf str unf (repeatM seed)
1196-- | 'intersperseMSuffix' followed by unfold and concat.
1198-- >>> intercalateSuffix u a = Stream.unfoldMany u . Stream.intersperseMSuffix a
1199-- >>> intersperseMSuffix = Stream.intercalateSuffix Unfold.identity
1200-- >>> unlines = Stream.intercalateSuffix Unfold.fromList "\n"
1202-- >>> input = Stream.fromList ["abc", "def", "ghi"]
1203-- >>> Stream.fold Fold.toList $ Stream.intercalateSuffix Unfold.fromList "\n" input
1206{-# INLINE intercalateSuffix #-}
1207intercalateSuffix :: Monad m
1208 => Unfold m b c -> b -> Stream m b -> Stream m c
1209intercalateSuffix unf seed = unfoldMany unf . intersperseMSuffix (return seed)
1211-- > intercalate unf seed str = gintercalate unf str unf (repeatM seed)
1213-- | 'intersperse' followed by unfold and concat.
1215-- >>> intercalate u a = Stream.unfoldMany u . Stream.intersperse a
1216-- >>> intersperse = Stream.intercalate Unfold.identity
1217-- >>> unwords = Stream.intercalate Unfold.fromList " "
1219-- >>> input = Stream.fromList ["abc", "def", "ghi"]
1220-- >>> Stream.fold Fold.toList $ Stream.intercalate Unfold.fromList " " input
1223{-# INLINE intercalate #-}
1224intercalate :: Monad m
1225 => Unfold m b c -> b -> Stream m b -> Stream m c
1226intercalate unf seed str = unfoldMany unf $ intersperse seed str
1228------------------------------------------------------------------------------
1230------------------------------------------------------------------------------
1232-- | Apply a stream of folds to an input stream and emit the results in the
1237{-# INLINE foldSequence #-}
1240 Stream m (Fold m a b)
1243foldSequence _f _m = undefined
1245{-# ANN type FIterState Fuse #-}
1246data FIterState s f m a b
1248 | forall fs. FIterStream s (fs -> a -> m (FL.Step fs b)) fs (fs -> m b)
1249 | FIterYield b (FIterState s f m a b)
1252-- | Iterate a fold generator on a stream. The initial value @b@ is used to
1253-- generate the first fold, the fold is applied on the stream and the result of
1254-- the fold is used to generate the next fold and so on.
1256-- >>> import Data.Monoid (Sum(..))
1257-- >>> f x = return (Fold.take 2 (Fold.sconcat x))
1258-- >>> s = fmap Sum $ Stream.fromList [1..10]
1259-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.foldIterateM f (pure 0) s
1260-- [3,10,21,36,55,55]
1262-- This is the streaming equivalent of monad like sequenced application of
1263-- folds where next fold is dependent on the previous fold.
1267{-# INLINE_NORMAL foldIterateM #-}
1269 Monad m => (b -> m (FL.Fold m a b)) -> m b -> Stream m a -> Stream m b
1270foldIterateM func seed0 (Stream step state) =
1271 Stream stepOuter (FIterInit state seed0)
1275 {-# INLINE iterStep #-}
1276 iterStep from st fstep extract = do
1281 FL.Partial fs -> FIterStream st fstep fs extract
1282 FL.Done fb -> FIterYield fb $ FIterInit st (return fb)
1284 {-# INLINE_LATE stepOuter #-}
1285 stepOuter _ (FIterInit st seed) = do
1286 (FL.Fold fstep initial extract) <- seed >>= func
1287 iterStep initial st fstep extract
1288 stepOuter gst (FIterStream st fstep fs extract) = do
1289 r <- step (adaptState gst) st
1292 iterStep (fstep fs x) s fstep extract
1293 Skip s -> return $ Skip $ FIterStream s fstep fs extract
1296 return $ Skip $ FIterYield b FIterStop
1297 stepOuter _ (FIterYield a next) = return $ Yield a next
1298 stepOuter _ FIterStop = return Stop
1300{-# ANN type CIterState Fuse #-}
1301data CIterState s f fs b
1304 | CIterYield b (CIterState s f fs b)
1307-- | Like 'foldIterateM' but using the 'Refold' type instead. This could be
1308-- much more efficient due to stream fusion.
1311{-# INLINE_NORMAL refoldIterateM #-}
1313 Monad m => Refold m b a b -> m b -> Stream m a -> Stream m b
1314refoldIterateM (Refold fstep finject fextract) initial (Stream step state) =
1315 Stream stepOuter (CIterInit state initial)
1319 {-# INLINE iterStep #-}
1320 iterStep st action = do
1325 FL.Partial fs -> CIterConsume st fs
1326 FL.Done fb -> CIterYield fb $ CIterInit st (return fb)
1328 {-# INLINE_LATE stepOuter #-}
1329 stepOuter _ (CIterInit st action) = do
1330 iterStep st (action >>= finject)
1331 stepOuter gst (CIterConsume st fs) = do
1332 r <- step (adaptState gst) st
1334 Yield x s -> iterStep s (fstep fs x)
1335 Skip s -> return $ Skip $ CIterConsume s fs
1338 return $ Skip $ CIterYield b CIterStop
1339 stepOuter _ (CIterYield a next) = return $ Yield a next
1340 stepOuter _ CIterStop = return Stop
1342-- "n" elements at the end are dropped by the fold.
1343{-# INLINE sliceBy #-}
1344sliceBy :: Monad m => Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)
1345sliceBy (Fold step1 initial1 extract1) n = Refold step inject extract
1349 inject (i, len) = do
1352 Partial s -> Partial $ Tuple' (i + len + n) s
1353 Done l -> Done (i, l)
1355 step (Tuple' i s) x = do
1358 Partial s1 -> Partial $ Tuple' i s1
1359 Done len -> Done (i, len)
1361 extract (Tuple' i s) = (i,) <$> extract1 s
1363{-# INLINE sliceOnSuffix #-}
1364sliceOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)
1365sliceOnSuffix predicate =
1366 -- Scan the stream with the given refold
1368 (sliceBy (FL.takeEndBy_ predicate FL.length) 1)
1371------------------------------------------------------------------------------
1373------------------------------------------------------------------------------
1375{-# ANN type ParseChunksState Fuse #-}
1376data ParseChunksState x inpBuf st pst =
1377 ParseChunksInit inpBuf st
1378 | ParseChunksInitBuf inpBuf
1379 | ParseChunksInitLeftOver inpBuf
1380 | ParseChunksStream st inpBuf !pst
1381 | ParseChunksStop inpBuf !pst
1382 | ParseChunksBuf inpBuf st inpBuf !pst
1383 | ParseChunksExtract inpBuf inpBuf !pst
1384 | ParseChunksYield x (ParseChunksState x inpBuf st pst)
1386-- XXX return the remaining stream as part of the error.
1387-- XXX This is in fact parseMany1 (a la foldMany1). Do we need a parseMany as
1389{-# INLINE_NORMAL parseManyD #-}
1394 -> Stream m (Either ParseError b)
1395parseManyD (PRD.Parser pstep initial extract) (Stream step state) =
1396 Stream stepOuter (ParseChunksInit [] state)
1400 {-# INLINE_LATE stepOuter #-}
1401 -- Buffer is empty, get the first element from the stream, initialize the
1402 -- fold and then go to stream processing loop.
1403 stepOuter gst (ParseChunksInit [] st) = do
1404 r <- step (adaptState gst) st
1410 return $ Skip $ ParseChunksBuf [x] s [] ps
1412 let next = ParseChunksInit [x] s
1413 in return $ Skip $ ParseChunksYield (Right pb) next
1418 (Left (ParseError err))
1419 (ParseChunksInitLeftOver [])
1420 Skip s -> return $ Skip $ ParseChunksInit [] s
1423 -- Buffer is not empty, go to buffered processing loop
1424 stepOuter _ (ParseChunksInit src st) = do
1428 return $ Skip $ ParseChunksBuf src st [] ps
1430 let next = ParseChunksInit src st
1431 in return $ Skip $ ParseChunksYield (Right pb) next
1436 (Left (ParseError err))
1437 (ParseChunksInitLeftOver [])
1439 -- This is simplified ParseChunksInit
1440 stepOuter _ (ParseChunksInitBuf src) = do
1444 return $ Skip $ ParseChunksExtract src [] ps
1446 let next = ParseChunksInitBuf src
1447 in return $ Skip $ ParseChunksYield (Right pb) next
1452 (Left (ParseError err))
1453 (ParseChunksInitLeftOver [])
1455 -- XXX we just discard any leftover input at the end
1456 stepOuter _ (ParseChunksInitLeftOver _) = return Stop
1458 -- Buffer is empty, process elements from the stream
1459 stepOuter gst (ParseChunksStream st buf pst) = do
1460 r <- step (adaptState gst) st
1465 PR.Partial 0 pst1 ->
1466 return $ Skip $ ParseChunksStream s [] pst1
1467 PR.Partial n pst1 -> do
1468 assert (n <= length (x:buf)) (return ())
1469 let src0 = Prelude.take n (x:buf)
1470 src = Prelude.reverse src0
1471 return $ Skip $ ParseChunksBuf src s [] pst1
1472 PR.Continue 0 pst1 ->
1473 return $ Skip $ ParseChunksStream s (x:buf) pst1
1474 PR.Continue n pst1 -> do
1475 assert (n <= length (x:buf)) (return ())
1476 let (src0, buf1) = splitAt n (x:buf)
1477 src = Prelude.reverse src0
1478 return $ Skip $ ParseChunksBuf src s buf1 pst1
1481 ParseChunksYield (Right b) (ParseChunksInit [] s)
1483 assert (n <= length (x:buf)) (return ())
1484 let src = Prelude.reverse (Prelude.take n (x:buf))
1486 ParseChunksYield (Right b) (ParseChunksInit src s)
1491 (Left (ParseError err))
1492 (ParseChunksInitLeftOver [])
1493 Skip s -> return $ Skip $ ParseChunksStream s buf pst
1494 Stop -> return $ Skip $ ParseChunksStop buf pst
1496 -- go back to stream processing mode
1497 stepOuter _ (ParseChunksBuf [] s buf pst) =
1498 return $ Skip $ ParseChunksStream s buf pst
1500 -- buffered processing loop
1501 stepOuter _ (ParseChunksBuf (x:xs) s buf pst) = do
1504 PR.Partial 0 pst1 ->
1505 return $ Skip $ ParseChunksBuf xs s [] pst1
1506 PR.Partial n pst1 -> do
1507 assert (n <= length (x:buf)) (return ())
1508 let src0 = Prelude.take n (x:buf)
1509 src = Prelude.reverse src0 ++ xs
1510 return $ Skip $ ParseChunksBuf src s [] pst1
1511 PR.Continue 0 pst1 ->
1512 return $ Skip $ ParseChunksBuf xs s (x:buf) pst1
1513 PR.Continue n pst1 -> do
1514 assert (n <= length (x:buf)) (return ())
1515 let (src0, buf1) = splitAt n (x:buf)
1516 src = Prelude.reverse src0 ++ xs
1517 return $ Skip $ ParseChunksBuf src s buf1 pst1
1521 $ ParseChunksYield (Right b) (ParseChunksInit xs s)
1523 assert (n <= length (x:buf)) (return ())
1524 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1526 $ ParseChunksYield (Right b) (ParseChunksInit src s)
1531 (Left (ParseError err))
1532 (ParseChunksInitLeftOver [])
1534 -- This is simplified ParseChunksBuf
1535 stepOuter _ (ParseChunksExtract [] buf pst) =
1536 return $ Skip $ ParseChunksStop buf pst
1538 stepOuter _ (ParseChunksExtract (x:xs) buf pst) = do
1541 PR.Partial 0 pst1 ->
1542 return $ Skip $ ParseChunksExtract xs [] pst1
1543 PR.Partial n pst1 -> do
1544 assert (n <= length (x:buf)) (return ())
1545 let src0 = Prelude.take n (x:buf)
1546 src = Prelude.reverse src0 ++ xs
1547 return $ Skip $ ParseChunksExtract src [] pst1
1548 PR.Continue 0 pst1 ->
1549 return $ Skip $ ParseChunksExtract xs (x:buf) pst1
1550 PR.Continue n pst1 -> do
1551 assert (n <= length (x:buf)) (return ())
1552 let (src0, buf1) = splitAt n (x:buf)
1553 src = Prelude.reverse src0 ++ xs
1554 return $ Skip $ ParseChunksExtract src buf1 pst1
1558 $ ParseChunksYield (Right b) (ParseChunksInitBuf xs)
1560 assert (n <= length (x:buf)) (return ())
1561 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1564 $ ParseChunksYield (Right b) (ParseChunksInitBuf src)
1569 (Left (ParseError err))
1570 (ParseChunksInitLeftOver [])
1572 -- This is simplified ParseChunksExtract
1573 stepOuter _ (ParseChunksStop buf pst) = do
1576 PR.Partial _ _ -> error "Bug: parseMany: Partial in extract"
1577 PR.Continue 0 pst1 ->
1578 return $ Skip $ ParseChunksStop buf pst1
1579 PR.Continue n pst1 -> do
1580 assert (n <= length buf) (return ())
1581 let (src0, buf1) = splitAt n buf
1582 src = Prelude.reverse src0
1583 return $ Skip $ ParseChunksExtract src buf1 pst1
1586 ParseChunksYield (Right b) (ParseChunksInitLeftOver [])
1588 assert (n <= length buf) (return ())
1589 let src = Prelude.reverse (Prelude.take n buf)
1591 ParseChunksYield (Right b) (ParseChunksInitBuf src)
1596 (Left (ParseError err))
1597 (ParseChunksInitLeftOver [])
1599 stepOuter _ (ParseChunksYield a next) = return $ Yield a next
1601-- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the
1606-- >>> s = Stream.fromList [1..10]
1607-- >>> parser = Parser.takeBetween 0 2 Fold.sum
1608-- >>> Stream.fold Fold.toList $ Stream.parseMany parser s
1609-- [Right 3,Right 7,Right 11,Right 15,Right 19]
1611-- This is the streaming equivalent of the 'Streamly.Data.Parser.many' parse
1614-- Known Issues: When the parser fails there is no way to get the remaining
1617{-# INLINE parseMany #-}
1622 -> Stream m (Either ParseError b)
1623parseMany = parseManyD
1625-- | Apply a stream of parsers to an input stream and emit the results in the
1630{-# INLINE parseSequence #-}
1633 Stream m (PR.Parser a m b)
1636parseSequence _f _m = undefined
1638-- XXX Change the parser arguments' order
1640-- | @parseManyTill collect test stream@ tries the parser @test@ on the input,
1641-- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds
1642-- @test@ is tried again and so on. The parser stops when @test@ succeeds. The
1643-- output of @test@ is discarded and the output of @collect@ is emitted in the
1644-- output stream. The parser fails if @collect@ fails.
1648{-# INLINE parseManyTill #-}
1655parseManyTill = undefined
1657{-# ANN type ConcatParseState Fuse #-}
1658data ConcatParseState c b inpBuf st p m a =
1659 ConcatParseInit inpBuf st p
1660 | ConcatParseInitBuf inpBuf p
1661 | ConcatParseInitLeftOver inpBuf
1662 | forall s. ConcatParseStop
1663 inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1664 | forall s. ConcatParseStream
1665 st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1666 | forall s. ConcatParseBuf
1667 inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1668 | forall s. ConcatParseExtract
1669 inpBuf inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1670 | ConcatParseYield c (ConcatParseState c b inpBuf st p m a)
1672-- XXX Review the changes
1673{-# INLINE_NORMAL parseIterateD #-}
1676 => (b -> PRD.Parser a m b)
1679 -> Stream m (Either ParseError b)
1680parseIterateD func seed (Stream step state) =
1681 Stream stepOuter (ConcatParseInit [] state (func seed))
1685 {-# INLINE_LATE stepOuter #-}
1686 -- Buffer is empty, go to stream processing loop
1687 stepOuter _ (ConcatParseInit [] st (PRD.Parser pstep initial extract)) = do
1691 return $ Skip $ ConcatParseStream st [] pstep ps extract
1693 let next = ConcatParseInit [] st (func pb)
1694 in return $ Skip $ ConcatParseYield (Right pb) next
1699 (Left (ParseError err))
1700 (ConcatParseInitLeftOver [])
1702 -- Buffer is not empty, go to buffered processing loop
1703 stepOuter _ (ConcatParseInit src st
1704 (PRD.Parser pstep initial extract)) = do
1708 return $ Skip $ ConcatParseBuf src st [] pstep ps extract
1710 let next = ConcatParseInit src st (func pb)
1711 in return $ Skip $ ConcatParseYield (Right pb) next
1716 (Left (ParseError err))
1717 (ConcatParseInitLeftOver [])
1719 -- This is simplified ConcatParseInit
1720 stepOuter _ (ConcatParseInitBuf src
1721 (PRD.Parser pstep initial extract)) = do
1725 return $ Skip $ ConcatParseExtract src [] pstep ps extract
1727 let next = ConcatParseInitBuf src (func pb)
1728 in return $ Skip $ ConcatParseYield (Right pb) next
1733 (Left (ParseError err))
1734 (ConcatParseInitLeftOver [])
1736 -- XXX we just discard any leftover input at the end
1737 stepOuter _ (ConcatParseInitLeftOver _) = return Stop
1739 -- Buffer is empty process elements from the stream
1740 stepOuter gst (ConcatParseStream st buf pstep pst extract) = do
1741 r <- step (adaptState gst) st
1746 PR.Partial 0 pst1 ->
1747 return $ Skip $ ConcatParseStream s [] pstep pst1 extract
1748 PR.Partial n pst1 -> do
1749 assert (n <= length (x:buf)) (return ())
1750 let src0 = Prelude.take n (x:buf)
1751 src = Prelude.reverse src0
1752 return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract
1753 -- PR.Continue 0 pst1 ->
1754 -- return $ Skip $ ConcatParseStream s (x:buf) pst1
1755 PR.Continue n pst1 -> do
1756 assert (n <= length (x:buf)) (return ())
1757 let (src0, buf1) = splitAt n (x:buf)
1758 src = Prelude.reverse src0
1759 return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract
1760 -- XXX Specialize for Stop 0 common case?
1762 assert (n <= length (x:buf)) (return ())
1763 let src = Prelude.reverse (Prelude.take n (x:buf))
1765 ConcatParseYield (Right b) (ConcatParseInit src s (func b))
1770 (Left (ParseError err))
1771 (ConcatParseInitLeftOver [])
1772 Skip s -> return $ Skip $ ConcatParseStream s buf pstep pst extract
1773 Stop -> return $ Skip $ ConcatParseStop buf pstep pst extract
1775 -- go back to stream processing mode
1776 stepOuter _ (ConcatParseBuf [] s buf pstep ps extract) =
1777 return $ Skip $ ConcatParseStream s buf pstep ps extract
1779 -- buffered processing loop
1780 stepOuter _ (ConcatParseBuf (x:xs) s buf pstep pst extract) = do
1783 PR.Partial 0 pst1 ->
1784 return $ Skip $ ConcatParseBuf xs s [] pstep pst1 extract
1785 PR.Partial n pst1 -> do
1786 assert (n <= length (x:buf)) (return ())
1787 let src0 = Prelude.take n (x:buf)
1788 src = Prelude.reverse src0 ++ xs
1789 return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract
1790 -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1
1791 PR.Continue n pst1 -> do
1792 assert (n <= length (x:buf)) (return ())
1793 let (src0, buf1) = splitAt n (x:buf)
1794 src = Prelude.reverse src0 ++ xs
1795 return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract
1796 -- XXX Specialize for Stop 0 common case?
1798 assert (n <= length (x:buf)) (return ())
1799 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1800 return $ Skip $ ConcatParseYield (Right b)
1801 (ConcatParseInit src s (func b))
1806 (Left (ParseError err))
1807 (ConcatParseInitLeftOver [])
1809 -- This is simplified ConcatParseBuf
1810 stepOuter _ (ConcatParseExtract [] buf pstep pst extract) =
1811 return $ Skip $ ConcatParseStop buf pstep pst extract
1813 stepOuter _ (ConcatParseExtract (x:xs) buf pstep pst extract) = do
1816 PR.Partial 0 pst1 ->
1817 return $ Skip $ ConcatParseExtract xs [] pstep pst1 extract
1818 PR.Partial n pst1 -> do
1819 assert (n <= length (x:buf)) (return ())
1820 let src0 = Prelude.take n (x:buf)
1821 src = Prelude.reverse src0 ++ xs
1822 return $ Skip $ ConcatParseExtract src [] pstep pst1 extract
1823 PR.Continue 0 pst1 ->
1824 return $ Skip $ ConcatParseExtract xs (x:buf) pstep pst1 extract
1825 PR.Continue n pst1 -> do
1826 assert (n <= length (x:buf)) (return ())
1827 let (src0, buf1) = splitAt n (x:buf)
1828 src = Prelude.reverse src0 ++ xs
1829 return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract
1831 return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf xs (func b))
1833 assert (n <= length (x:buf)) (return ())
1834 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1835 return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))
1840 (Left (ParseError err))
1841 (ConcatParseInitLeftOver [])
1843 -- This is simplified ConcatParseExtract
1844 stepOuter _ (ConcatParseStop buf pstep pst extract) = do
1847 PR.Partial _ _ -> error "Bug: parseIterate: Partial in extract"
1848 PR.Continue 0 pst1 ->
1849 return $ Skip $ ConcatParseStop buf pstep pst1 extract
1850 PR.Continue n pst1 -> do
1851 assert (n <= length buf) (return ())
1852 let (src0, buf1) = splitAt n buf
1853 src = Prelude.reverse src0
1854 return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract
1857 ConcatParseYield (Right b) (ConcatParseInitLeftOver [])
1859 assert (n <= length buf) (return ())
1860 let src = Prelude.reverse (Prelude.take n buf)
1862 ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))
1867 (Left (ParseError err))
1868 (ConcatParseInitLeftOver [])
1870 stepOuter _ (ConcatParseYield a next) = return $ Yield a next
1872-- | Iterate a parser generating function on a stream. The initial value @b@ is
1873-- used to generate the first parser, the parser is applied on the stream and
1874-- the result is used to generate the next parser and so on.
1876-- >>> import Data.Monoid (Sum(..))
1877-- >>> s = Stream.fromList [1..10]
1878-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.catRights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum s
1879-- [3,10,21,36,55,55]
1881-- This is the streaming equivalent of monad like sequenced application of
1882-- parsers where next parser is dependent on the previous parser.
1886{-# INLINE parseIterate #-}
1889 => (b -> PR.Parser a m b)
1892 -> Stream m (Either ParseError b)
1893parseIterate = parseIterateD
1895------------------------------------------------------------------------------
1897------------------------------------------------------------------------------
1899data GroupByState st fs a b
1902 | GroupingInitWith st !a
1903 | GroupingDoWith st !fs !a
1904 | GroupingYield !b (GroupByState st fs a b)
1907{-# INLINE_NORMAL groupsBy #-}
1914groupsBy eq fld = parseMany (PRD.groupBy eq fld)
1916groupsBy 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 "groupsBy: Unreachable"
1989 stepOuter _ GroupingDone = return Stop
1991{-# INLINE_NORMAL groupsRollingBy #-}
1992groupsRollingBy :: Monad m
1998groupsRollingBy eq fld = parseMany (PRD.groupByRolling eq fld)
2000groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =
2001 Stream stepOuter (GroupingInit state)
2005 {-# INLINE_LATE stepOuter #-}
2006 stepOuter _ (GroupingInit st) = do
2007 -- XXX Note that if the stream stops without yielding a single element
2008 -- in the group we discard the "initial" effect.
2012 FL.Partial fs -> Skip $ GroupingDo st fs
2013 FL.Done fb -> Yield fb $ GroupingInit st
2014 stepOuter gst (GroupingDo st fs) = do
2015 res <- step (adaptState gst) st
2020 FL.Partial fs1 -> go SPEC x s fs1
2021 FL.Done fb -> return $ Yield fb (GroupingInit s)
2022 Skip s -> return $ Skip $ GroupingDo s fs
2027 go !_ prev stt !acc = do
2028 res <- step (adaptState gst) stt
2035 FL.Partial fs1 -> go SPEC x s fs1
2036 FL.Done b -> return $ Yield b (GroupingInit s)
2039 return $ Yield r (GroupingInitWith s x)
2040 Skip s -> go SPEC prev s acc
2041 Stop -> done acc >>= \r -> return $ Yield r GroupingDone
2042 stepOuter _ (GroupingInitWith st x) = do
2046 FL.Partial s -> Skip $ GroupingDoWith st s x
2047 FL.Done b -> Yield b $ GroupingInitWith st x
2048 stepOuter gst (GroupingDoWith st fs previous) = do
2049 res <- fstep fs previous
2051 FL.Partial s -> go SPEC previous st s
2052 FL.Done b -> return $ Yield b (GroupingInit st)
2056 -- XXX GHC: groupsBy has one less parameter in this go loop and it
2057 -- fuses. However, groupsRollingBy does not fuse, removing the prev
2058 -- parameter makes it fuse. Something needs to be fixed in GHC. The
2059 -- workaround for this is noted in the comments below.
2060 go !_ prev !stt !acc = do
2061 res <- step (adaptState gst) stt
2068 FL.Partial fs1 -> go SPEC x s fs1
2069 FL.Done b -> return $ Yield b (GroupingInit st)
2073 return $ Yield r (GroupingInitWith s x)
2075 -- The code above does not let groupBy fuse. We use the
2076 -- alternative code below instead. Instead of jumping
2077 -- to GroupingInitWith state, we unroll the code of
2078 -- GroupingInitWith state here to help GHC with stream
2085 FL.Partial fsi -> GroupingDoWith s fsi x
2086 FL.Done b -> GroupingYield b (GroupingInit s)
2087 Skip s -> go SPEC prev s acc
2088 Stop -> done acc >>= \r -> return $ Yield r GroupingDone
2089 stepOuter _ (GroupingYield r next) = return $ Yield r next
2090 stepOuter _ GroupingDone = return Stop
2092------------------------------------------------------------------------------
2093-- Splitting - by a predicate
2094------------------------------------------------------------------------------
2096data WordsByState st fs b
2100 | WordsByYield !b (WordsByState st fs b)
2102{-# INLINE_NORMAL wordsBy #-}
2103wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
2104wordsBy predicate (Fold fstep initial done) (Stream step state) =
2105 Stream stepOuter (WordsByInit state)
2109 {-# INLINE_LATE stepOuter #-}
2110 stepOuter _ (WordsByInit st) = do
2114 FL.Partial s -> Skip $ WordsByDo st s
2115 FL.Done b -> Yield b (WordsByInit st)
2117 stepOuter gst (WordsByDo st fs) = do
2118 res <- step (adaptState gst) st
2126 FL.Partial fs1 -> Skip $ WordsByDo s fs1
2127 FL.Done b -> Yield b (WordsByInit s)
2131 FL.Partial fs1 -> go SPEC s fs1
2132 FL.Done b -> return $ Yield b (WordsByInit s)
2133 Skip s -> return $ Skip $ WordsByDo s fs
2139 res <- step (adaptState gst) stt
2146 return $ Yield r (WordsByInit s)
2148 -- The above code does not fuse well. Need to check why
2149 -- GHC is not able to simplify it well. Using the code
2150 -- below, instead of jumping through the WordsByInit
2151 -- state always, we directly go to WordsByDo state in
2152 -- the common case of Partial.
2158 FL.Partial fs1 -> WordsByDo s fs1
2159 FL.Done b -> WordsByYield b (WordsByInit s)
2163 FL.Partial fs1 -> go SPEC s fs1
2164 FL.Done b -> return $ Yield b (WordsByInit s)
2165 Skip s -> go SPEC s acc
2166 Stop -> done acc >>= \r -> return $ Yield r WordsByDone
2168 stepOuter _ WordsByDone = return Stop
2170 stepOuter _ (WordsByYield b next) = return $ Yield b next
2172------------------------------------------------------------------------------
2173-- Splitting on a sequence
2174------------------------------------------------------------------------------
2176-- String search algorithms:
2177-- http://www-igm.univ-mlv.fr/~lecroq/string/index.html
2180-- TODO can we unify the splitting operations using a splitting configuration
2181-- like in the split package.
2183data SplitStyle = Infix | Suffix | Prefix deriving (Eq, Show)
2184data SplitOptions = SplitOptions
2185 { style :: SplitStyle
2186 , withSep :: Bool -- ^ keep the separators in output
2187 -- , compact :: Bool -- ^ treat multiple consecutive separators as one
2188 -- , trimHead :: Bool -- ^ drop blank at head
2189 -- , trimTail :: Bool -- ^ drop blank at tail
2193-- XXX using "fs" as the last arg in Constructors may simplify the code a bit,
2194-- because we can use the constructor directly without having to create "jump"
2196{-# ANN type SplitOnSeqState Fuse #-}
2197data SplitOnSeqState rb rh ck w fs s b x =
2199 | SplitOnSeqYield b (SplitOnSeqState rb rh ck w fs s b x)
2202 | SplitOnSeqEmpty !fs s
2204 | SplitOnSeqSingle !fs s x
2206 | SplitOnSeqWordInit !fs s
2207 | SplitOnSeqWordLoop !w s !fs
2208 | SplitOnSeqWordDone Int !fs !w
2210 | SplitOnSeqKRInit Int !fs s rb !rh
2211 | SplitOnSeqKRLoop fs s rb !rh !ck
2212 | SplitOnSeqKRCheck fs s rb !rh
2213 | SplitOnSeqKRDone Int !fs rb !rh
2215 | SplitOnSeqReinit (fs -> SplitOnSeqState rb rh ck w fs s b x)
2217{-# INLINE_NORMAL splitOnSeq #-}
2219 :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)
2224splitOnSeq patArr (Fold fstep initial done) (Stream step state) =
2225 Stream stepOuter SplitOnSeqInit
2229 patLen = A.length patArr
2230 maxIndex = patLen - 1
2231 elemBits = SIZE_OF(a) * 8
2233 -- For word pattern case
2235 wordMask = (1 `shiftL` (elemBits * patLen)) - 1
2238 elemMask = (1 `shiftL` elemBits) - 1
2241 wordPat = wordMask .&. A.foldl' addToWord 0 patArr
2243 addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)
2245 -- For Rabin-Karp search
2246 k = 2891336453 :: Word32
2249 addCksum cksum a = cksum * k + fromIntegral (fromEnum a)
2251 deltaCksum cksum old new =
2252 addCksum cksum new - coeff * fromIntegral (fromEnum old)
2254 -- XXX shall we use a random starting hash or 1 instead of 0?
2255 patHash = A.foldl' addCksum 0 patArr
2257 skip = return . Skip
2259 nextAfterInit nextGen stepRes =
2261 FL.Partial s -> nextGen s
2262 FL.Done b -> SplitOnSeqYield b (SplitOnSeqReinit nextGen)
2264 {-# INLINE yieldProceed #-}
2265 yieldProceed nextGen fs =
2266 initial >>= skip . SplitOnSeqYield fs . nextAfterInit nextGen
2268 {-# INLINE_LATE stepOuter #-}
2269 stepOuter _ SplitOnSeqInit = do
2274 then return $ Skip $ SplitOnSeqEmpty acc state
2277 pat <- liftIO $ A.unsafeIndexIO 0 patArr
2278 return $ Skip $ SplitOnSeqSingle acc state pat
2279 else if SIZE_OF(a) * patLen
2280 <= sizeOf (Proxy :: Proxy Word)
2281 then return $ Skip $ SplitOnSeqWordInit acc state
2283 (rb, rhead) <- liftIO $ RB.new patLen
2284 skip $ SplitOnSeqKRInit 0 acc state rb rhead
2285 FL.Done b -> skip $ SplitOnSeqYield b SplitOnSeqInit
2287 stepOuter _ (SplitOnSeqYield x next) = return $ Yield x next
2289 ---------------------------
2291 ---------------------------
2293 stepOuter _ (SplitOnSeqReinit nextGen) =
2294 initial >>= skip . nextAfterInit nextGen
2296 ---------------------------
2298 ---------------------------
2300 stepOuter gst (SplitOnSeqEmpty acc st) = do
2301 res <- step (adaptState gst) st
2307 FL.Partial acc1 -> done acc1
2308 FL.Done b -> return b
2309 let jump c = SplitOnSeqEmpty c s
2310 in yieldProceed jump b1
2311 Skip s -> skip (SplitOnSeqEmpty acc s)
2318 stepOuter _ SplitOnSeqDone = return Stop
2324 stepOuter gst (SplitOnSeqSingle fs st pat) = do
2325 res <- step (adaptState gst) st
2328 let jump c = SplitOnSeqSingle c s pat
2330 then done fs >>= yieldProceed jump
2334 FL.Partial fs1 -> skip $ jump fs1
2335 FL.Done b -> yieldProceed jump b
2336 Skip s -> return $ Skip $ SplitOnSeqSingle fs s pat
2339 return $ Skip $ SplitOnSeqYield r SplitOnSeqDone
2341 ---------------------------
2342 -- Short Pattern - Shift Or
2343 ---------------------------
2345 stepOuter _ (SplitOnSeqWordDone 0 fs _) = do
2347 skip $ SplitOnSeqYield r SplitOnSeqDone
2348 stepOuter _ (SplitOnSeqWordDone n fs wrd) = do
2349 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))
2350 r <- fstep fs (toEnum $ fromIntegral old)
2352 FL.Partial fs1 -> skip $ SplitOnSeqWordDone (n - 1) fs1 wrd
2354 let jump c = SplitOnSeqWordDone (n - 1) c wrd
2357 stepOuter gst (SplitOnSeqWordInit fs st0) =
2363 go !_ !idx !wrd !st = do
2364 res <- step (adaptState gst) st
2367 let wrd1 = addToWord wrd x
2370 if wrd1 .&. wordMask == wordPat
2372 let jump c = SplitOnSeqWordInit c s
2373 done fs >>= yieldProceed jump
2374 else skip $ SplitOnSeqWordLoop wrd1 s fs
2375 else go SPEC (idx + 1) wrd1 s
2376 Skip s -> go SPEC idx wrd s
2379 then skip $ SplitOnSeqWordDone idx fs wrd
2382 skip $ SplitOnSeqYield r SplitOnSeqDone
2384 stepOuter gst (SplitOnSeqWordLoop wrd0 st0 fs0) =
2385 go SPEC wrd0 st0 fs0
2390 go !_ !wrd !st !fs = do
2391 res <- step (adaptState gst) st
2394 let jump c = SplitOnSeqWordInit c s
2395 wrd1 = addToWord wrd x
2396 old = (wordMask .&. wrd)
2397 `shiftR` (elemBits * (patLen - 1))
2398 r <- fstep fs (toEnum $ fromIntegral old)
2400 FL.Partial fs1 -> do
2401 if wrd1 .&. wordMask == wordPat
2402 then done fs1 >>= yieldProceed jump
2403 else go SPEC wrd1 s fs1
2404 FL.Done b -> yieldProceed jump b
2405 Skip s -> go SPEC wrd s fs
2406 Stop -> skip $ SplitOnSeqWordDone patLen fs wrd
2408 -------------------------------
2409 -- General Pattern - Karp Rabin
2410 -------------------------------
2412 stepOuter gst (SplitOnSeqKRInit idx fs st rb rh) = do
2413 res <- step (adaptState gst) st
2416 rh1 <- liftIO $ RB.unsafeInsert rb rh x
2419 let fld = RB.unsafeFoldRing (RB.ringBound rb)
2420 let !ringHash = fld addCksum 0 rb
2421 if ringHash == patHash
2422 then skip $ SplitOnSeqKRCheck fs s rb rh1
2423 else skip $ SplitOnSeqKRLoop fs s rb rh1 ringHash
2424 else skip $ SplitOnSeqKRInit (idx + 1) fs s rb rh1
2425 Skip s -> skip $ SplitOnSeqKRInit idx fs s rb rh
2427 skip $ SplitOnSeqKRDone idx fs rb (RB.startOf rb)
2429 -- XXX The recursive "go" is more efficient than the state based recursion
2430 -- code commented out below. Perhaps its more efficient because of
2431 -- factoring out "rb" outside the loop.
2433 stepOuter gst (SplitOnSeqKRLoop fs0 st0 rb rh0 cksum0) =
2434 go SPEC fs0 st0 rh0 cksum0
2438 go !_ !fs !st !rh !cksum = do
2439 res <- step (adaptState gst) st
2442 old <- liftIO $ peek rh
2443 let cksum1 = deltaCksum cksum old x
2446 FL.Partial fs1 -> do
2447 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2448 if cksum1 == patHash
2449 then skip $ SplitOnSeqKRCheck fs1 s rb rh1
2450 else go SPEC fs1 s rh1 cksum1
2452 let rst = RB.startOf rb
2453 jump c = SplitOnSeqKRInit 0 c s rb rst
2455 Skip s -> go SPEC fs s rh cksum
2456 Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh
2458 -- XXX The following code is 5 times slower compared to the recursive loop
2459 -- based code above. Need to investigate why. One possibility is that the
2460 -- go loop above does not thread around the ring buffer (rb). This code may
2461 -- be causing the state to bloat and getting allocated on each iteration.
2462 -- We can check the cmm/asm code to confirm. If so a good GHC solution to
2463 -- such problem is needed. One way to avoid this could be to use unboxed
2466 stepOuter gst (SplitOnSeqKRLoop fs st rb rh cksum) = do
2467 res <- step (adaptState gst) st
2470 old <- liftIO $ peek rh
2471 let cksum1 = deltaCksum cksum old x
2473 if (cksum1 == patHash)
2476 skip $ SplitOnSeqYield r $ SplitOnSeqKRInit 0 s rb rh
2478 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2479 skip $ SplitOnSeqKRLoop fs1 s rb rh1 cksum1
2480 Skip s -> skip $ SplitOnSeqKRLoop fs s rb rh cksum
2481 Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh
2484 stepOuter _ (SplitOnSeqKRCheck fs st rb rh) = do
2485 if RB.unsafeEqArray rb rh patArr
2488 let rst = RB.startOf rb
2489 jump c = SplitOnSeqKRInit 0 c st rb rst
2491 else skip $ SplitOnSeqKRLoop fs st rb rh patHash
2493 stepOuter _ (SplitOnSeqKRDone 0 fs _ _) = do
2495 skip $ SplitOnSeqYield r SplitOnSeqDone
2496 stepOuter _ (SplitOnSeqKRDone n fs rb rh) = do
2497 old <- liftIO $ peek rh
2498 let rh1 = RB.advance rb rh
2501 FL.Partial fs1 -> skip $ SplitOnSeqKRDone (n - 1) fs1 rb rh1
2503 let jump c = SplitOnSeqKRDone (n - 1) c rb rh1
2506{-# ANN type SplitOnSuffixSeqState Fuse #-}
2507data SplitOnSuffixSeqState rb rh ck w fs s b x =
2508 SplitOnSuffixSeqInit
2509 | SplitOnSuffixSeqYield b (SplitOnSuffixSeqState rb rh ck w fs s b x)
2510 | SplitOnSuffixSeqDone
2512 | SplitOnSuffixSeqEmpty !fs s
2514 | SplitOnSuffixSeqSingleInit !fs s x
2515 | SplitOnSuffixSeqSingle !fs s x
2517 | SplitOnSuffixSeqWordInit !fs s
2518 | SplitOnSuffixSeqWordLoop !w s !fs
2519 | SplitOnSuffixSeqWordDone Int !fs !w
2521 | SplitOnSuffixSeqKRInit Int !fs s rb !rh
2522 | SplitOnSuffixSeqKRInit1 !fs s rb !rh
2523 | SplitOnSuffixSeqKRLoop fs s rb !rh !ck
2524 | SplitOnSuffixSeqKRCheck fs s rb !rh
2525 | SplitOnSuffixSeqKRDone Int !fs rb !rh
2527 | SplitOnSuffixSeqReinit
2528 (fs -> SplitOnSuffixSeqState rb rh ck w fs s b x)
2530{-# INLINE_NORMAL splitOnSuffixSeq #-}
2532 :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)
2538splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =
2539 Stream stepOuter SplitOnSuffixSeqInit
2543 patLen = A.length patArr
2544 maxIndex = patLen - 1
2545 elemBits = SIZE_OF(a) * 8
2547 -- For word pattern case
2549 wordMask = (1 `shiftL` (elemBits * patLen)) - 1
2552 elemMask = (1 `shiftL` elemBits) - 1
2555 wordPat = wordMask .&. A.foldl' addToWord 0 patArr
2557 addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)
2559 nextAfterInit nextGen stepRes =
2561 FL.Partial s -> nextGen s
2563 SplitOnSuffixSeqYield b (SplitOnSuffixSeqReinit nextGen)
2565 {-# INLINE yieldProceed #-}
2566 yieldProceed nextGen fs =
2567 initial >>= skip . SplitOnSuffixSeqYield fs . nextAfterInit nextGen
2569 -- For single element pattern case
2570 {-# INLINE processYieldSingle #-}
2571 processYieldSingle pat x s fs = do
2572 let jump c = SplitOnSuffixSeqSingleInit c s pat
2575 r <- if withSep then fstep fs x else return $ FL.Partial fs
2578 FL.Partial fs1 -> done fs1
2579 FL.Done b -> return b
2580 yieldProceed jump b1
2584 FL.Partial fs1 -> skip $ SplitOnSuffixSeqSingle fs1 s pat
2585 FL.Done b -> yieldProceed jump b
2587 -- For Rabin-Karp search
2588 k = 2891336453 :: Word32
2591 addCksum cksum a = cksum * k + fromIntegral (fromEnum a)
2593 deltaCksum cksum old new =
2594 addCksum cksum new - coeff * fromIntegral (fromEnum old)
2596 -- XXX shall we use a random starting hash or 1 instead of 0?
2597 patHash = A.foldl' addCksum 0 patArr
2599 skip = return . Skip
2601 {-# INLINE_LATE stepOuter #-}
2602 stepOuter _ SplitOnSuffixSeqInit = do
2607 then skip $ SplitOnSuffixSeqEmpty fs state
2610 pat <- liftIO $ A.unsafeIndexIO 0 patArr
2611 skip $ SplitOnSuffixSeqSingleInit fs state pat
2612 else if SIZE_OF(a) * patLen
2613 <= sizeOf (Proxy :: Proxy Word)
2614 then skip $ SplitOnSuffixSeqWordInit fs state
2616 (rb, rhead) <- liftIO $ RB.new patLen
2617 skip $ SplitOnSuffixSeqKRInit 0 fs state rb rhead
2618 FL.Done fb -> skip $ SplitOnSuffixSeqYield fb SplitOnSuffixSeqInit
2620 stepOuter _ (SplitOnSuffixSeqYield x next) = return $ Yield x next
2622 ---------------------------
2624 ---------------------------
2626 stepOuter _ (SplitOnSuffixSeqReinit nextGen) =
2627 initial >>= skip . nextAfterInit nextGen
2629 ---------------------------
2631 ---------------------------
2633 stepOuter gst (SplitOnSuffixSeqEmpty acc st) = do
2634 res <- step (adaptState gst) st
2637 let jump c = SplitOnSuffixSeqEmpty c s
2641 FL.Partial fs -> done fs
2642 FL.Done b -> return b
2643 yieldProceed jump b1
2644 Skip s -> skip (SplitOnSuffixSeqEmpty acc s)
2651 stepOuter _ SplitOnSuffixSeqDone = return Stop
2657 stepOuter gst (SplitOnSuffixSeqSingleInit fs st pat) = do
2658 res <- step (adaptState gst) st
2660 Yield x s -> processYieldSingle pat x s fs
2661 Skip s -> skip $ SplitOnSuffixSeqSingleInit fs s pat
2664 stepOuter gst (SplitOnSuffixSeqSingle fs st pat) = do
2665 res <- step (adaptState gst) st
2667 Yield x s -> processYieldSingle pat x s fs
2668 Skip s -> skip $ SplitOnSuffixSeqSingle fs s pat
2671 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2673 ---------------------------
2674 -- Short Pattern - Shift Or
2675 ---------------------------
2677 stepOuter _ (SplitOnSuffixSeqWordDone 0 fs _) = do
2679 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2680 stepOuter _ (SplitOnSuffixSeqWordDone n fs wrd) = do
2681 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))
2682 r <- fstep fs (toEnum $ fromIntegral old)
2684 FL.Partial fs1 -> skip $ SplitOnSuffixSeqWordDone (n - 1) fs1 wrd
2686 let jump c = SplitOnSuffixSeqWordDone (n - 1) c wrd
2689 stepOuter gst (SplitOnSuffixSeqWordInit fs0 st0) = do
2690 res <- step (adaptState gst) st0
2693 let wrd = addToWord 0 x
2694 r <- if withSep then fstep fs0 x else return $ FL.Partial fs0
2696 FL.Partial fs1 -> go SPEC 1 wrd s fs1
2698 let jump c = SplitOnSuffixSeqWordInit c s
2700 Skip s -> skip (SplitOnSuffixSeqWordInit fs0 s)
2706 go !_ !idx !wrd !st !fs = do
2707 res <- step (adaptState gst) st
2710 let jump c = SplitOnSuffixSeqWordInit c s
2711 let wrd1 = addToWord wrd x
2712 r <- if withSep then fstep fs x else return $ FL.Partial fs
2716 then go SPEC (idx + 1) wrd1 s fs1
2717 else if wrd1 .&. wordMask /= wordPat
2718 then skip $ SplitOnSuffixSeqWordLoop wrd1 s fs1
2719 else do done fs >>= yieldProceed jump
2720 FL.Done b -> yieldProceed jump b
2721 Skip s -> go SPEC idx wrd s fs
2722 Stop -> skip $ SplitOnSuffixSeqWordDone idx fs wrd
2724 stepOuter gst (SplitOnSuffixSeqWordLoop wrd0 st0 fs0) =
2725 go SPEC wrd0 st0 fs0
2730 go !_ !wrd !st !fs = do
2731 res <- step (adaptState gst) st
2734 let jump c = SplitOnSuffixSeqWordInit c s
2735 wrd1 = addToWord wrd x
2736 old = (wordMask .&. wrd)
2737 `shiftR` (elemBits * (patLen - 1))
2741 else fstep fs (toEnum $ fromIntegral old)
2744 if wrd1 .&. wordMask == wordPat
2745 then done fs1 >>= yieldProceed jump
2746 else go SPEC wrd1 s fs1
2747 FL.Done b -> yieldProceed jump b
2748 Skip s -> go SPEC wrd s fs
2750 if wrd .&. wordMask == wordPat
2755 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2756 else skip $ SplitOnSuffixSeqWordDone patLen fs wrd
2758 -------------------------------
2759 -- General Pattern - Karp Rabin
2760 -------------------------------
2762 stepOuter gst (SplitOnSuffixSeqKRInit idx0 fs st0 rb rh0) = do
2763 res <- step (adaptState gst) st0
2766 rh1 <- liftIO $ RB.unsafeInsert rb rh0 x
2767 r <- if withSep then fstep fs x else return $ FL.Partial fs
2770 skip $ SplitOnSuffixSeqKRInit1 fs1 s rb rh1
2772 let rst = RB.startOf rb
2773 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst
2775 Skip s -> skip $ SplitOnSuffixSeqKRInit idx0 fs s rb rh0
2778 stepOuter gst (SplitOnSuffixSeqKRInit1 fs0 st0 rb rh0) = do
2779 go SPEC 1 rh0 st0 fs0
2783 go !_ !idx !rh st !fs = do
2784 res <- step (adaptState gst) st
2787 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2788 r <- if withSep then fstep fs x else return $ FL.Partial fs
2792 then go SPEC (idx + 1) rh1 s fs1
2794 let fld = RB.unsafeFoldRing (RB.ringBound rb)
2795 !ringHash = fld addCksum 0 rb
2796 in if ringHash == patHash
2797 then SplitOnSuffixSeqKRCheck fs1 s rb rh1
2798 else SplitOnSuffixSeqKRLoop
2799 fs1 s rb rh1 ringHash
2801 let rst = RB.startOf rb
2802 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst
2804 Skip s -> go SPEC idx rh s fs
2806 -- do not issue a blank segment when we end at pattern
2807 if (idx == maxIndex) && RB.unsafeEqArray rb rh patArr
2812 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2813 else skip $ SplitOnSuffixSeqKRDone idx fs rb (RB.startOf rb)
2815 stepOuter gst (SplitOnSuffixSeqKRLoop fs0 st0 rb rh0 cksum0) =
2816 go SPEC fs0 st0 rh0 cksum0
2820 go !_ !fs !st !rh !cksum = do
2821 res <- step (adaptState gst) st
2824 old <- liftIO $ peek rh
2825 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2826 let cksum1 = deltaCksum cksum old x
2827 r <- if withSep then fstep fs x else fstep fs old
2830 if cksum1 /= patHash
2831 then go SPEC fs1 s rh1 cksum1
2832 else skip $ SplitOnSuffixSeqKRCheck fs1 s rb rh1
2834 let rst = RB.startOf rb
2835 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst
2837 Skip s -> go SPEC fs s rh cksum
2839 if RB.unsafeEqArray rb rh patArr
2844 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2845 else skip $ SplitOnSuffixSeqKRDone patLen fs rb rh
2847 stepOuter _ (SplitOnSuffixSeqKRCheck fs st rb rh) = do
2848 if RB.unsafeEqArray rb rh patArr
2851 let rst = RB.startOf rb
2852 jump c = SplitOnSuffixSeqKRInit 0 c st rb rst
2854 else skip $ SplitOnSuffixSeqKRLoop fs st rb rh patHash
2856 stepOuter _ (SplitOnSuffixSeqKRDone 0 fs _ _) = do
2858 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2859 stepOuter _ (SplitOnSuffixSeqKRDone n fs rb rh) = do
2860 old <- liftIO $ peek rh
2861 let rh1 = RB.advance rb rh
2864 FL.Partial fs1 -> skip $ SplitOnSuffixSeqKRDone (n - 1) fs1 rb rh1
2866 let jump c = SplitOnSuffixSeqKRDone (n - 1) c rb rh1
2869-- Implement this as a fold or a parser instead.
2870-- This can be implemented easily using Rabin Karp
2871-- | Split post any one of the given patterns.
2874{-# INLINE splitOnSuffixSeqAny #-}
2875splitOnSuffixSeqAny :: -- (Monad m, Unboxed a, Integral a) =>
2876 [Array a] -> Fold m a b -> Stream m a -> Stream m b
2877splitOnSuffixSeqAny _subseq _f _m = undefined
2878 -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m)
2880-- | Split on a prefixed separator element, dropping the separator. The
2881-- supplied 'Fold' is applied on the split segments.
2884-- > splitOnPrefix' p xs = Stream.toList $ Stream.splitOnPrefix p (Fold.toList) (Stream.fromList xs)
2885-- > splitOnPrefix' (== '.') ".a.b"
2889-- An empty stream results in an empty output stream:
2891-- > splitOnPrefix' (== '.') ""
2895-- An empty segment consisting of only a prefix is folded to the default output
2899-- > splitOnPrefix' (== '.') "."
2902-- > splitOnPrefix' (== '.') ".a.b."
2905-- > splitOnPrefix' (== '.') ".a..b"
2910-- A prefix is optional at the beginning of the stream:
2913-- > splitOnPrefix' (== '.') "a"
2916-- > splitOnPrefix' (== '.') "a.b"
2920-- 'splitOnPrefix' is an inverse of 'intercalatePrefix' with a single element:
2922-- > Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList . Stream.splitOnPrefix (== '.') Fold.toList === id
2924-- Assuming the input stream does not contain the separator:
2926-- > Stream.splitOnPrefix (== '.') Fold.toList . Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList === id
2929{-# INLINE splitOnPrefix #-}
2930splitOnPrefix :: -- (IsStream t, MonadCatch m) =>
2931 (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
2932splitOnPrefix _predicate _f = undefined
2933 -- parseMany (Parser.sliceBeginBy predicate f)
2935-- Int list examples for splitOn:
2937-- >>> splitList [] [1,2,3,3,4]
2938-- > [[1],[2],[3],[3],[4]]
2940-- >>> splitList [5] [1,2,3,3,4]
2943-- >>> splitList [1] [1,2,3,3,4]
2946-- >>> splitList [4] [1,2,3,3,4]
2949-- >>> splitList [2] [1,2,3,3,4]
2952-- >>> splitList [3] [1,2,3,3,4]
2955-- >>> splitList [3,3] [1,2,3,3,4]
2958-- >>> splitList [1,2,3,3,4] [1,2,3,3,4]
2961-- This can be implemented easily using Rabin Karp
2962-- | Split on any one of the given patterns.
2966{-# INLINE splitOnAny #-}
2967splitOnAny :: -- (Monad m, Unboxed a, Integral a) =>
2968 [Array a] -> Fold m a b -> Stream m a -> Stream m b
2969splitOnAny _subseq _f _m =
2970 undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m)
2972------------------------------------------------------------------------------
2973-- Nested Container Transformation
2974------------------------------------------------------------------------------
2976{-# ANN type SplitState Fuse #-}
2977data SplitState s arr
2979 | SplitBuffering s arr
2980 | SplitSplitting s arr
2981 | SplitYielding arr (SplitState s arr)
2984-- XXX An alternative approach would be to use a partial fold (Fold m a b) to
2985-- split using a splitBy like combinator. The Fold would consume upto the
2986-- separator and return any leftover which can then be fed to the next fold.
2988-- We can revisit this once we have partial folds/parsers.
2990-- | Performs infix separator style splitting.
2991{-# INLINE_NORMAL splitInnerBy #-}
2994 => (f a -> m (f a, Maybe (f a))) -- splitter
2995 -> (f a -> f a -> m (f a)) -- joiner
2998splitInnerBy splitter joiner (Stream step1 state1) =
2999 Stream step (SplitInitial state1)
3003 {-# INLINE_LATE step #-}
3004 step gst (SplitInitial st) = do
3008 (x1, mx2) <- splitter x
3009 return $ case mx2 of
3010 Nothing -> Skip (SplitBuffering s x1)
3011 Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))
3012 Skip s -> return $ Skip (SplitInitial s)
3015 step gst (SplitBuffering st buf) = do
3019 (x1, mx2) <- splitter x
3020 buf' <- joiner buf x1
3021 return $ case mx2 of
3022 Nothing -> Skip (SplitBuffering s buf')
3023 Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))
3024 Skip s -> return $ Skip (SplitBuffering s buf)
3025 Stop -> return $ Skip (SplitYielding buf SplitFinishing)
3027 step _ (SplitSplitting st buf) = do
3028 (x1, mx2) <- splitter buf
3029 return $ case mx2 of
3030 Nothing -> Skip $ SplitBuffering st x1
3031 Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)
3033 step _ (SplitYielding x next) = return $ Yield x next
3034 step _ SplitFinishing = return Stop
3036-- | Performs infix separator style splitting.
3037{-# INLINE_NORMAL splitInnerBySuffix #-}
3039 :: (Monad m, Eq (f a), Monoid (f a))
3040 => (f a -> m (f a, Maybe (f a))) -- splitter
3041 -> (f a -> f a -> m (f a)) -- joiner
3044splitInnerBySuffix splitter joiner (Stream step1 state1) =
3045 Stream step (SplitInitial state1)
3049 {-# INLINE_LATE step #-}
3050 step gst (SplitInitial st) = do
3054 (x1, mx2) <- splitter x
3055 return $ case mx2 of
3056 Nothing -> Skip (SplitBuffering s x1)
3057 Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))
3058 Skip s -> return $ Skip (SplitInitial s)
3061 step gst (SplitBuffering st buf) = do
3065 (x1, mx2) <- splitter x
3066 buf' <- joiner buf x1
3067 return $ case mx2 of
3068 Nothing -> Skip (SplitBuffering s buf')
3069 Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))
3070 Skip s -> return $ Skip (SplitBuffering s buf)
3074 else Skip (SplitYielding buf SplitFinishing)
3076 step _ (SplitSplitting st buf) = do
3077 (x1, mx2) <- splitter buf
3078 return $ case mx2 of
3079 Nothing -> Skip $ SplitBuffering st x1
3080 Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)
3082 step _ (SplitYielding x next) = return $ Yield x next
3083 step _ SplitFinishing = return Stop
3085------------------------------------------------------------------------------
3087------------------------------------------------------------------------------
3089-- | Drop prefix from the input stream if present.
3094{-# INLINE dropPrefix #-}
3096 -- (Monad m, Eq a) =>
3097 Stream m a -> Stream m a -> Stream m a
3098dropPrefix = error "Not implemented yet!"
3100-- | Drop all matching infix from the input stream if present. Infix stream
3101-- may be consumed multiple times.
3103-- Space: @O(n)@ where n is the length of the infix.
3106{-# INLINE dropInfix #-}
3108 -- (Monad m, Eq a) =>
3109 Stream m a -> Stream m a -> Stream m a
3110dropInfix = error "Not implemented yet!"
3112-- | Drop suffix from the input stream if present. Suffix stream may be
3113-- consumed multiple times.
3115-- Space: @O(n)@ where n is the length of the suffix.
3118{-# INLINE dropSuffix #-}
3120 -- (Monad m, Eq a) =>
3121 Stream m a -> Stream m a -> Stream m a
3122dropSuffix = 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