3-- Module : Streamly.Internal.Data.Stream.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.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 as RB
200import Streamly.Internal.Data.Stream.Transform
201 (intersperse, intersperseMSuffix)
202import Streamly.Internal.Data.Stream.Type
204import Prelude hiding (concatMap, mapM, zipWith)
206#include "DocTestDataStream.hs"
208------------------------------------------------------------------------------
210------------------------------------------------------------------------------
212data AppendState s1 s2 = AppendFirst s1 | AppendSecond s2
214-- From an implementation perspective, StreamK.'Streamly.Data.StreamK.append'
215-- translates into a function call whereas Stream.'append' translates into a
216-- conditional branch (jump). However, the overhead of the function call in
217-- StreamK.append is incurred only once, while the overhead of the conditional
218-- branch in fused append is incurred for each element in the stream. As a
219-- result, StreamK.append has a linear time complexity of O(n), while fused
220-- append has a quadratic time complexity of O(n^2), where @n@ represents the
221-- number of 'append's used.
223-- | WARNING! O(n^2) time complexity wrt number of streams. Suitable for
224-- statically fusing a small number of streams. Use the O(n) complexity
225-- StreamK.'Streamly.Data.StreamK.append' otherwise.
227-- Fuses two streams sequentially, yielding all elements from the first
228-- stream, and then all elements from the second stream.
230-- >>> s1 = Stream.fromList [1,2]
231-- >>> s2 = Stream.fromList [3,4]
232-- >>> Stream.fold Fold.toList $ s1 `Stream.append` s2
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-- | WARNING! O(n^2) time complexity wrt number of streams. Suitable for
265-- statically fusing a small number of streams. Use the O(n) complexity
266-- StreamK.'Streamly.Data.StreamK.interleave' otherwise.
268-- Interleaves two streams, yielding one element from each stream alternately.
269-- When one stream stops the rest of the other stream is used in the output
272{-# INLINE_NORMAL interleave #-}
273interleave :: Monad m => Stream m a -> Stream m a -> Stream m a
274interleave (Stream step1 state1) (Stream step2 state2) =
275 Stream step (InterleaveFirst state1 state2)
279 {-# INLINE_LATE step #-}
280 step gst (InterleaveFirst st1 st2) = do
283 Yield a s -> Yield a (InterleaveSecond s st2)
284 Skip s -> Skip (InterleaveFirst s st2)
285 Stop -> Skip (InterleaveSecondOnly st2)
287 step gst (InterleaveSecond st1 st2) = do
290 Yield a s -> Yield a (InterleaveFirst st1 s)
291 Skip s -> Skip (InterleaveSecond st1 s)
292 Stop -> Skip (InterleaveFirstOnly st1)
294 step gst (InterleaveFirstOnly st1) = do
297 Yield a s -> Yield a (InterleaveFirstOnly s)
298 Skip s -> Skip (InterleaveFirstOnly s)
301 step gst (InterleaveSecondOnly st2) = do
304 Yield a s -> Yield a (InterleaveSecondOnly s)
305 Skip s -> Skip (InterleaveSecondOnly s)
308-- | Like `interleave` but stops interleaving as soon as any of the two streams
311{-# INLINE_NORMAL interleaveMin #-}
312interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a
313interleaveMin (Stream step1 state1) (Stream step2 state2) =
314 Stream step (InterleaveFirst state1 state2)
318 {-# INLINE_LATE step #-}
319 step gst (InterleaveFirst st1 st2) = do
322 Yield a s -> Yield a (InterleaveSecond s st2)
323 Skip s -> Skip (InterleaveFirst s st2)
326 step gst (InterleaveSecond st1 st2) = do
329 Yield a s -> Yield a (InterleaveFirst st1 s)
330 Skip s -> Skip (InterleaveSecond st1 s)
333 step _ (InterleaveFirstOnly _) = undefined
334 step _ (InterleaveSecondOnly _) = undefined
336-- | Interleaves the outputs of two streams, yielding elements from each stream
337-- alternately, starting from the first stream. As soon as the first stream
338-- finishes, the output stops, discarding the remaining part of the second
339-- stream. In this case, the last element in the resulting stream would be from
340-- the second stream. If the second stream finishes early then the first stream
341-- still continues to yield elements until it finishes.
343-- >>> :set -XOverloadedStrings
344-- >>> import Data.Functor.Identity (Identity)
345-- >>> Stream.interleaveFstSuffix "abc" ",,,," :: Stream Identity Char
347-- >>> Stream.interleaveFstSuffix "abc" "," :: Stream Identity Char
350-- 'interleaveFstSuffix' is a dual of 'interleaveFst'.
352-- Do not use dynamically.
355{-# INLINE_NORMAL interleaveFstSuffix #-}
356interleaveFstSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a
357interleaveFstSuffix (Stream step1 state1) (Stream step2 state2) =
358 Stream step (InterleaveFirst state1 state2)
362 {-# INLINE_LATE step #-}
363 step gst (InterleaveFirst st1 st2) = do
366 Yield a s -> Yield a (InterleaveSecond s st2)
367 Skip s -> Skip (InterleaveFirst s st2)
370 step gst (InterleaveSecond st1 st2) = do
373 Yield a s -> Yield a (InterleaveFirst st1 s)
374 Skip s -> Skip (InterleaveSecond st1 s)
375 Stop -> Skip (InterleaveFirstOnly st1)
377 step gst (InterleaveFirstOnly st1) = do
380 Yield a s -> Yield a (InterleaveFirstOnly s)
381 Skip s -> Skip (InterleaveFirstOnly s)
384 step _ (InterleaveSecondOnly _) = undefined
386data InterleaveInfixState s1 s2 a
387 = InterleaveInfixFirst s1 s2
388 | InterleaveInfixSecondBuf s1 s2
389 | InterleaveInfixSecondYield s1 s2 a
390 | InterleaveInfixFirstYield s1 s2 a
391 | InterleaveInfixFirstOnly s1
393-- | Interleaves the outputs of two streams, yielding elements from each stream
394-- alternately, starting from the first stream and ending at the first stream.
395-- If the second stream is longer than the first, elements from the second
396-- stream are infixed with elements from the first stream. If the first stream
397-- is longer then it continues yielding elements even after the second stream
400-- >>> :set -XOverloadedStrings
401-- >>> import Data.Functor.Identity (Identity)
402-- >>> Stream.interleaveFst "abc" ",,,," :: Stream Identity Char
404-- >>> Stream.interleaveFst "abc" "," :: Stream Identity Char
407-- 'interleaveFst' is a dual of 'interleaveFstSuffix'.
409-- Do not use dynamically.
412{-# INLINE_NORMAL interleaveFst #-}
413interleaveFst :: Monad m => Stream m a -> Stream m a -> Stream m a
414interleaveFst (Stream step1 state1) (Stream step2 state2) =
415 Stream step (InterleaveInfixFirst state1 state2)
419 {-# INLINE_LATE step #-}
420 step gst (InterleaveInfixFirst st1 st2) = do
423 Yield a s -> Yield a (InterleaveInfixSecondBuf s st2)
424 Skip s -> Skip (InterleaveInfixFirst s st2)
427 step gst (InterleaveInfixSecondBuf st1 st2) = do
430 Yield a s -> Skip (InterleaveInfixSecondYield st1 s a)
431 Skip s -> Skip (InterleaveInfixSecondBuf st1 s)
432 Stop -> Skip (InterleaveInfixFirstOnly st1)
434 step gst (InterleaveInfixSecondYield st1 st2 x) = do
437 Yield a s -> Yield x (InterleaveInfixFirstYield s st2 a)
438 Skip s -> Skip (InterleaveInfixSecondYield s st2 x)
441 step _ (InterleaveInfixFirstYield st1 st2 x) = do
442 return $ Yield x (InterleaveInfixSecondBuf st1 st2)
444 step gst (InterleaveInfixFirstOnly st1) = do
447 Yield a s -> Yield a (InterleaveInfixFirstOnly s)
448 Skip s -> Skip (InterleaveInfixFirstOnly s)
451------------------------------------------------------------------------------
453------------------------------------------------------------------------------
455-- | Schedule the execution of two streams in a fair round-robin manner,
456-- executing each stream once, alternately. Execution of a stream may not
457-- necessarily result in an output, a stream may choose to @Skip@ producing an
458-- element until later giving the other stream a chance to run. Therefore, this
459-- combinator fairly interleaves the execution of two streams rather than
460-- fairly interleaving the output of the two streams. This can be useful in
461-- co-operative multitasking without using explicit threads. This can be used
462-- as an alternative to `async`.
464-- Do not use dynamically.
467{-# INLINE_NORMAL roundRobin #-}
468roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a
469roundRobin (Stream step1 state1) (Stream step2 state2) =
470 Stream step (InterleaveFirst state1 state2)
474 {-# INLINE_LATE step #-}
475 step gst (InterleaveFirst st1 st2) = do
478 Yield a s -> Yield a (InterleaveSecond s st2)
479 Skip s -> Skip (InterleaveSecond s st2)
480 Stop -> Skip (InterleaveSecondOnly st2)
482 step gst (InterleaveSecond st1 st2) = do
485 Yield a s -> Yield a (InterleaveFirst st1 s)
486 Skip s -> Skip (InterleaveFirst st1 s)
487 Stop -> Skip (InterleaveFirstOnly st1)
489 step gst (InterleaveSecondOnly st2) = do
492 Yield a s -> Yield a (InterleaveSecondOnly s)
493 Skip s -> Skip (InterleaveSecondOnly s)
496 step gst (InterleaveFirstOnly st1) = do
499 Yield a s -> Yield a (InterleaveFirstOnly s)
500 Skip s -> Skip (InterleaveFirstOnly s)
503------------------------------------------------------------------------------
505------------------------------------------------------------------------------
507-- | Like 'mergeBy' but with a monadic comparison function.
509-- Example, to merge two streams randomly:
512-- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT
513-- > Stream.toList $ Stream.mergeByM randomly (Stream.fromList [1,1,1,1]) (Stream.fromList [2,2,2,2])
517-- Example, merge two streams in a proportion of 2:1:
521-- let s1 = Stream.fromList [1,1,1,1,1,1]
522-- s2 = Stream.fromList [2,2,2]
523-- let proportionately m n = do
524-- ref <- newIORef $ cycle $ Prelude.concat [Prelude.replicate m LT, Prelude.replicate n GT]
525-- return $ \_ _ -> do
527-- writeIORef ref $ Prelude.tail r
528-- return $ Prelude.head r
529-- f <- proportionately 2 1
530-- xs <- Stream.fold Fold.toList $ Stream.mergeByM f s1 s2
533-- [1,1,2,1,1,2,1,1,2]
535{-# INLINE_NORMAL mergeByM #-}
538 => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
539mergeByM cmp (Stream stepa ta) (Stream stepb tb) =
540 Stream step (Just ta, Just tb, Nothing, Nothing)
542 {-# INLINE_LATE step #-}
544 -- one of the values is missing, and the corresponding stream is running
545 step gst (Just sa, sb, Nothing, b) = do
548 Yield a sa' -> Skip (Just sa', sb, Just a, b)
549 Skip sa' -> Skip (Just sa', sb, Nothing, b)
550 Stop -> Skip (Nothing, sb, Nothing, b)
552 step gst (sa, Just sb, a, Nothing) = do
555 Yield b sb' -> Skip (sa, Just sb', a, Just b)
556 Skip sb' -> Skip (sa, Just sb', a, Nothing)
557 Stop -> Skip (sa, Nothing, a, Nothing)
559 -- both the values are available
560 step _ (sa, sb, Just a, Just b) = do
563 GT -> Yield b (sa, sb, Just a, Nothing)
564 _ -> Yield a (sa, sb, Nothing, Just b)
566 -- one of the values is missing, corresponding stream is done
567 step _ (Nothing, sb, Nothing, Just b) =
568 return $ Yield b (Nothing, sb, Nothing, Nothing)
570 step _ (sa, Nothing, Just a, Nothing) =
571 return $ Yield a (sa, Nothing, Nothing, Nothing)
573 step _ (Nothing, Nothing, Nothing, Nothing) = return Stop
575-- | WARNING! O(n^2) time complexity wrt number of streams. Suitable for
576-- statically fusing a small number of streams. Use the O(n) complexity
577-- StreamK.'Streamly.Data.StreamK.mergeBy' otherwise.
579-- Merge two streams using a comparison function. The head elements of both
580-- the streams are compared and the smaller of the two elements is emitted, if
581-- both elements are equal then the element from the first stream is used
584-- If the streams are sorted in ascending order, the resulting stream would
585-- also remain sorted in ascending order.
587-- >>> s1 = Stream.fromList [1,3,5]
588-- >>> s2 = Stream.fromList [2,4,6,8]
589-- >>> Stream.fold Fold.toList $ Stream.mergeBy compare s1 s2
592{-# INLINE mergeBy #-}
595 => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a
596mergeBy cmp = mergeByM (\a b -> return $ cmp a b)
598-- | Like 'mergeByM' but stops merging as soon as any of the two streams stops.
601{-# INLINABLE mergeMinBy #-}
602mergeMinBy :: -- Monad m =>
603 (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
604mergeMinBy _f _m1 _m2 = undefined
605 -- fromStreamD $ D.mergeMinBy f (toStreamD m1) (toStreamD m2)
607-- | Like 'mergeByM' but stops merging as soon as the first stream stops.
610{-# INLINABLE mergeFstBy #-}
611mergeFstBy :: -- Monad m =>
612 (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
613mergeFstBy _f _m1 _m2 = undefined
614 -- fromStreamK $ D.mergeFstBy f (toStreamD m1) (toStreamD m2)
616-------------------------------------------------------------------------------
617-- Intersection of sorted streams
618-------------------------------------------------------------------------------
620-- Assuming the streams are sorted in ascending order
621{-# INLINE_NORMAL intersectBySorted #-}
622intersectBySorted :: Monad m
623 => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a
624intersectBySorted cmp (Stream stepa ta) (Stream stepb tb) =
626 ( ta -- left stream state
627 , tb -- right stream state
628 , Nothing -- left value
629 , Nothing -- right value
634 {-# INLINE_LATE step #-}
635 -- step 1, fetch the first value
636 step gst (sa, sb, Nothing, b) = do
639 Yield a sa' -> Skip (sa', sb, Just a, b) -- step 2/3
640 Skip sa' -> Skip (sa', sb, Nothing, b)
643 -- step 2, fetch the second value
644 step gst (sa, sb, a@(Just _), Nothing) = do
647 Yield b sb' -> Skip (sa, sb', a, Just b) -- step 3
648 Skip sb' -> Skip (sa, sb', a, Nothing)
651 -- step 3, compare the two values
652 step _ (sa, sb, Just a, Just b) = do
655 GT -> Skip (sa, sb, Just a, Nothing) -- step 2
656 LT -> Skip (sa, sb, Nothing, Just b) -- step 1
657 EQ -> Yield a (sa, sb, Nothing, Just b) -- step 1
659------------------------------------------------------------------------------
660-- Combine N Streams - unfoldMany
661------------------------------------------------------------------------------
663data ConcatUnfoldInterleaveState o i =
664 ConcatUnfoldInterleaveOuter o [i]
665 | ConcatUnfoldInterleaveInner o [i]
666 | ConcatUnfoldInterleaveInnerL [i] [i]
667 | ConcatUnfoldInterleaveInnerR [i] [i]
669-- XXX use arrays to store state instead of lists?
671-- XXX In general we can use different scheduling strategies e.g. how to
672-- schedule the outer vs inner loop or assigning weights to different streams
673-- or outer and inner loops.
675-- After a yield, switch to the next stream. Do not switch streams on Skip.
676-- Yield from outer stream switches to the inner stream.
678-- There are two choices here, (1) exhaust the outer stream first and then
679-- start yielding from the inner streams, this is much simpler to implement,
680-- (2) yield at least one element from an inner stream before going back to
681-- outer stream and opening the next stream from it.
683-- Ideally, we need some scheduling bias to inner streams vs outer stream.
684-- Maybe we can configure the behavior.
686-- XXX Instead of using "concatPairsWith wSerial" we can implement an N-way
687-- interleaving CPS combinator which behaves like unfoldInterleave. Instead
688-- of pairing up the streams we just need to go yielding one element from each
689-- stream and storing the remaining streams and then keep doing rounds through
690-- those in a round robin fashion. This would be much like wAsync.
692-- | This does not pair streams like mergeMapWith, instead, it goes through
693-- each stream one by one and yields one element from each stream. After it
694-- goes to the last stream it reverses the traversal to come back to the first
695-- stream yielding elements from each stream on its way back to the first
698-- >>> lists = Stream.fromList [[1,1],[2,2],[3,3],[4,4],[5,5]]
699-- >>> interleaved = Stream.unfoldInterleave Unfold.fromList lists
700-- >>> Stream.fold Fold.toList interleaved
701-- [1,2,3,4,5,5,4,3,2,1]
703-- Note that this is order of magnitude more efficient than "mergeMapWith
704-- interleave" because of fusion.
706{-# INLINE_NORMAL unfoldInterleave #-}
707unfoldInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b
708unfoldInterleave (Unfold istep inject) (Stream ostep ost) =
709 Stream step (ConcatUnfoldInterleaveOuter ost [])
713 {-# INLINE_LATE step #-}
714 step gst (ConcatUnfoldInterleaveOuter o ls) = do
715 r <- ostep (adaptState gst) o
719 i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))
720 Skip o' -> return $ Skip (ConcatUnfoldInterleaveOuter o' ls)
721 Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
723 step _ (ConcatUnfoldInterleaveInner _ []) = undefined
724 step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do
727 Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))
728 Skip s -> Skip (ConcatUnfoldInterleaveInner o (s:ls))
729 Stop -> Skip (ConcatUnfoldInterleaveOuter o ls)
731 step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop
732 step _ (ConcatUnfoldInterleaveInnerL [] rs) =
733 return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)
735 step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do
738 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))
739 Skip s -> Skip (ConcatUnfoldInterleaveInnerL (s:ls) rs)
740 Stop -> Skip (ConcatUnfoldInterleaveInnerL ls rs)
742 step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop
743 step _ (ConcatUnfoldInterleaveInnerR ls []) =
744 return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
746 step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do
749 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)
750 Skip s -> Skip (ConcatUnfoldInterleaveInnerR ls (s:rs))
751 Stop -> Skip (ConcatUnfoldInterleaveInnerR ls rs)
753-- XXX In general we can use different scheduling strategies e.g. how to
754-- schedule the outer vs inner loop or assigning weights to different streams
755-- or outer and inner loops.
757-- This could be inefficient if the tasks are too small.
759-- Compared to unfoldInterleave this one switches streams on Skips.
761-- | 'unfoldInterleave' switches to the next stream whenever a value from a
762-- stream is yielded, it does not switch on a 'Skip'. So if a stream keeps
763-- skipping for long time other streams won't get a chance to run.
764-- 'unfoldRoundRobin' switches on Skip as well. So it basically schedules each
765-- stream fairly irrespective of whether it produces a value or not.
767{-# INLINE_NORMAL unfoldRoundRobin #-}
768unfoldRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b
769unfoldRoundRobin (Unfold istep inject) (Stream ostep ost) =
770 Stream step (ConcatUnfoldInterleaveOuter ost [])
772 {-# INLINE_LATE step #-}
773 step gst (ConcatUnfoldInterleaveOuter o ls) = do
774 r <- ostep (adaptState gst) o
778 i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))
779 Skip o' -> return $ Skip (ConcatUnfoldInterleaveInner o' ls)
780 Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
782 step _ (ConcatUnfoldInterleaveInner o []) =
783 return $ Skip (ConcatUnfoldInterleaveOuter o [])
785 step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do
788 Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))
789 Skip s -> Skip (ConcatUnfoldInterleaveOuter o (s:ls))
790 Stop -> Skip (ConcatUnfoldInterleaveOuter o ls)
792 step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop
793 step _ (ConcatUnfoldInterleaveInnerL [] rs) =
794 return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)
796 step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do
799 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))
800 Skip s -> Skip (ConcatUnfoldInterleaveInnerL ls (s:rs))
801 Stop -> Skip (ConcatUnfoldInterleaveInnerL ls rs)
803 step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop
804 step _ (ConcatUnfoldInterleaveInnerR ls []) =
805 return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
807 step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do
810 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)
811 Skip s -> Skip (ConcatUnfoldInterleaveInnerR (s:ls) rs)
812 Stop -> Skip (ConcatUnfoldInterleaveInnerR ls rs)
814------------------------------------------------------------------------------
815-- Combine N Streams - interpose
816------------------------------------------------------------------------------
818{-# ANN type InterposeSuffixState Fuse #-}
819data InterposeSuffixState s1 i1 =
820 InterposeSuffixFirst s1
821 -- | InterposeSuffixFirstYield s1 i1
822 | InterposeSuffixFirstInner s1 i1
823 | InterposeSuffixSecond s1
825-- Note that if an unfolded layer turns out to be nil we still emit the
826-- separator effect. An alternate behavior could be to emit the separator
827-- effect only if at least one element has been yielded by the unfolding.
828-- However, that becomes a bit complicated, so we have chosen the former
830{-# INLINE_NORMAL interposeSuffixM #-}
833 => m c -> Unfold m b c -> Stream m b -> Stream m c
836 (Unfold istep1 inject1) (Stream step1 state1) =
837 Stream step (InterposeSuffixFirst state1)
841 {-# INLINE_LATE step #-}
842 step gst (InterposeSuffixFirst s1) = do
843 r <- step1 (adaptState gst) s1
847 i `seq` return (Skip (InterposeSuffixFirstInner s i))
848 -- i `seq` return (Skip (InterposeSuffixFirstYield s i))
849 Skip s -> return $ Skip (InterposeSuffixFirst s)
853 step _ (InterposeSuffixFirstYield s1 i1) = do
856 Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')
857 Skip i' -> Skip (InterposeSuffixFirstYield s1 i')
858 Stop -> Skip (InterposeSuffixFirst s1)
861 step _ (InterposeSuffixFirstInner s1 i1) = do
864 Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')
865 Skip i' -> Skip (InterposeSuffixFirstInner s1 i')
866 Stop -> Skip (InterposeSuffixSecond s1)
868 step _ (InterposeSuffixSecond s1) = do
870 return $ Yield r (InterposeSuffixFirst s1)
872-- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x)
874-- | Unfold the elements of a stream, append the given element after each
875-- unfolded stream and then concat them into a single stream.
877-- >>> unlines = Stream.interposeSuffix '\n'
880{-# INLINE interposeSuffix #-}
881interposeSuffix :: Monad m
882 => c -> Unfold m b c -> Stream m b -> Stream m c
883interposeSuffix x = interposeSuffixM (return x)
885{-# ANN type InterposeState Fuse #-}
886data InterposeState s1 i1 a =
888 -- | InterposeFirstYield s1 i1
889 | InterposeFirstInner s1 i1
890 | InterposeFirstInject s1
891 -- | InterposeFirstBuf s1 i1
892 | InterposeSecondYield s1 i1
893 -- -- | InterposeSecondYield s1 i1 a
894 -- -- | InterposeFirstResume s1 i1 a
896-- Note that this only interposes the pure values, we may run many effects to
897-- generate those values as some effects may not generate anything (Skip).
898{-# INLINE_NORMAL interposeM #-}
899interposeM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c
902 (Unfold istep1 inject1) (Stream step1 state1) =
903 Stream step (InterposeFirst state1)
907 {-# INLINE_LATE step #-}
908 step gst (InterposeFirst s1) = do
909 r <- step1 (adaptState gst) s1
913 i `seq` return (Skip (InterposeFirstInner s i))
914 -- i `seq` return (Skip (InterposeFirstYield s i))
915 Skip s -> return $ Skip (InterposeFirst s)
919 step _ (InterposeFirstYield s1 i1) = do
922 Yield x i' -> Yield x (InterposeFirstInner s1 i')
923 Skip i' -> Skip (InterposeFirstYield s1 i')
924 Stop -> Skip (InterposeFirst s1)
927 step _ (InterposeFirstInner s1 i1) = do
930 Yield x i' -> Yield x (InterposeFirstInner s1 i')
931 Skip i' -> Skip (InterposeFirstInner s1 i')
932 Stop -> Skip (InterposeFirstInject s1)
934 step gst (InterposeFirstInject s1) = do
935 r <- step1 (adaptState gst) s1
939 -- i `seq` return (Skip (InterposeFirstBuf s i))
940 i `seq` return (Skip (InterposeSecondYield s i))
941 Skip s -> return $ Skip (InterposeFirstInject s)
945 step _ (InterposeFirstBuf s1 i1) = do
948 Yield x i' -> Skip (InterposeSecondYield s1 i' x)
949 Skip i' -> Skip (InterposeFirstBuf s1 i')
954 step _ (InterposeSecondYield s1 i1 v) = do
956 return $ Yield r (InterposeFirstResume s1 i1 v)
958 step _ (InterposeSecondYield s1 i1) = do
960 return $ Yield r (InterposeFirstInner s1 i1)
963 step _ (InterposeFirstResume s1 i1 v) = do
964 return $ Yield v (InterposeFirstInner s1 i1)
967-- > interpose x unf str = gintercalate unf str UF.identity (repeat x)
969-- | Unfold the elements of a stream, intersperse the given element between the
970-- unfolded streams and then concat them into a single stream.
972-- >>> unwords = Stream.interpose ' '
975{-# INLINE interpose #-}
977 => c -> Unfold m b c -> Stream m b -> Stream m c
978interpose x = interposeM (return x)
980------------------------------------------------------------------------------
981-- Combine N Streams - intercalate
982------------------------------------------------------------------------------
984data ICUState s1 s2 i1 i2 =
989 | ICUFirstInner s1 s2 i1
990 | ICUSecondInner s1 s2 i2
991 | ICUFirstOnlyInner s1 i1
992 | ICUSecondOnlyInner s2 i2
994-- | 'interleaveFstSuffix' followed by unfold and concat.
997{-# INLINE_NORMAL gintercalateSuffix #-}
1000 => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
1002 (Unfold istep1 inject1) (Stream step1 state1)
1003 (Unfold istep2 inject2) (Stream step2 state2) =
1004 Stream step (ICUFirst state1 state2)
1008 {-# INLINE_LATE step #-}
1009 step gst (ICUFirst s1 s2) = do
1010 r <- step1 (adaptState gst) s1
1014 i `seq` return (Skip (ICUFirstInner s s2 i))
1015 Skip s -> return $ Skip (ICUFirst s s2)
1018 step gst (ICUFirstOnly s1) = do
1019 r <- step1 (adaptState gst) s1
1023 i `seq` return (Skip (ICUFirstOnlyInner s i))
1024 Skip s -> return $ Skip (ICUFirstOnly s)
1027 step _ (ICUFirstInner s1 s2 i1) = do
1030 Yield x i' -> Yield x (ICUFirstInner s1 s2 i')
1031 Skip i' -> Skip (ICUFirstInner s1 s2 i')
1032 Stop -> Skip (ICUSecond s1 s2)
1034 step _ (ICUFirstOnlyInner s1 i1) = do
1037 Yield x i' -> Yield x (ICUFirstOnlyInner s1 i')
1038 Skip i' -> Skip (ICUFirstOnlyInner s1 i')
1039 Stop -> Skip (ICUFirstOnly s1)
1041 step gst (ICUSecond s1 s2) = do
1042 r <- step2 (adaptState gst) s2
1046 i `seq` return (Skip (ICUSecondInner s1 s i))
1047 Skip s -> return $ Skip (ICUSecond s1 s)
1048 Stop -> return $ Skip (ICUFirstOnly s1)
1050 step _ (ICUSecondInner s1 s2 i2) = do
1053 Yield x i' -> Yield x (ICUSecondInner s1 s2 i')
1054 Skip i' -> Skip (ICUSecondInner s1 s2 i')
1055 Stop -> Skip (ICUFirst s1 s2)
1057 step _ (ICUSecondOnly _s2) = undefined
1058 step _ (ICUSecondOnlyInner _s2 _i2) = undefined
1060data ICALState s1 s2 i1 i2 a =
1062 -- | ICALFirstYield s1 s2 i1
1063 | ICALFirstInner s1 s2 i1
1065 | ICALFirstOnlyInner s1 i1
1066 | ICALSecondInject s1 s2
1067 | ICALFirstInject s1 s2 i2
1068 -- | ICALFirstBuf s1 s2 i1 i2
1069 | ICALSecondInner s1 s2 i1 i2
1070 -- -- | ICALSecondInner s1 s2 i1 i2 a
1071 -- -- | ICALFirstResume s1 s2 i1 i2 a
1073-- XXX we can swap the order of arguments to gintercalate so that the
1074-- definition of unfoldMany becomes simpler? The first stream should be
1075-- infixed inside the second one. However, if we change the order in
1076-- "interleave" as well similarly, then that will make it a bit unintuitive.
1078-- > unfoldMany unf str =
1079-- > gintercalate unf str (UF.nilM (\_ -> return ())) (repeat ())
1081-- | 'interleaveFst' followed by unfold and concat.
1084{-# INLINE_NORMAL gintercalate #-}
1087 => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
1089 (Unfold istep1 inject1) (Stream step1 state1)
1090 (Unfold istep2 inject2) (Stream step2 state2) =
1091 Stream step (ICALFirst state1 state2)
1095 {-# INLINE_LATE step #-}
1096 step gst (ICALFirst s1 s2) = do
1097 r <- step1 (adaptState gst) s1
1101 i `seq` return (Skip (ICALFirstInner s s2 i))
1102 -- i `seq` return (Skip (ICALFirstYield s s2 i))
1103 Skip s -> return $ Skip (ICALFirst s s2)
1107 step _ (ICALFirstYield s1 s2 i1) = do
1110 Yield x i' -> Yield x (ICALFirstInner s1 s2 i')
1111 Skip i' -> Skip (ICALFirstYield s1 s2 i')
1112 Stop -> Skip (ICALFirst s1 s2)
1115 step _ (ICALFirstInner s1 s2 i1) = do
1118 Yield x i' -> Yield x (ICALFirstInner s1 s2 i')
1119 Skip i' -> Skip (ICALFirstInner s1 s2 i')
1120 Stop -> Skip (ICALSecondInject s1 s2)
1122 step gst (ICALFirstOnly s1) = do
1123 r <- step1 (adaptState gst) s1
1127 i `seq` return (Skip (ICALFirstOnlyInner s i))
1128 Skip s -> return $ Skip (ICALFirstOnly s)
1131 step _ (ICALFirstOnlyInner s1 i1) = do
1134 Yield x i' -> Yield x (ICALFirstOnlyInner s1 i')
1135 Skip i' -> Skip (ICALFirstOnlyInner s1 i')
1136 Stop -> Skip (ICALFirstOnly s1)
1138 -- We inject the second stream even before checking if the first stream
1139 -- would yield any more elements. There is no clear choice whether we
1140 -- should do this before or after that. Doing it after may make the state
1141 -- machine a bit simpler though.
1142 step gst (ICALSecondInject s1 s2) = do
1143 r <- step2 (adaptState gst) s2
1147 i `seq` return (Skip (ICALFirstInject s1 s i))
1148 Skip s -> return $ Skip (ICALSecondInject s1 s)
1149 Stop -> return $ Skip (ICALFirstOnly s1)
1151 step gst (ICALFirstInject s1 s2 i2) = do
1152 r <- step1 (adaptState gst) s1
1156 i `seq` return (Skip (ICALSecondInner s s2 i i2))
1157 -- i `seq` return (Skip (ICALFirstBuf s s2 i i2))
1158 Skip s -> return $ Skip (ICALFirstInject s s2 i2)
1162 step _ (ICALFirstBuf s1 s2 i1 i2) = do
1165 Yield x i' -> Skip (ICALSecondInner s1 s2 i' i2 x)
1166 Skip i' -> Skip (ICALFirstBuf s1 s2 i' i2)
1169 step _ (ICALSecondInner s1 s2 i1 i2 v) = do
1172 Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i' v)
1173 Skip i' -> Skip (ICALSecondInner s1 s2 i1 i' v)
1174 Stop -> Skip (ICALFirstResume s1 s2 i1 i2 v)
1177 step _ (ICALSecondInner s1 s2 i1 i2) = do
1180 Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i')
1181 Skip i' -> Skip (ICALSecondInner s1 s2 i1 i')
1182 Stop -> Skip (ICALFirstInner s1 s2 i1)
1183 -- Stop -> Skip (ICALFirstResume s1 s2 i1 i2)
1186 step _ (ICALFirstResume s1 s2 i1 i2 x) = do
1187 return $ Yield x (ICALFirstInner s1 s2 i1 i2)
1190-- > intercalateSuffix unf seed str = gintercalateSuffix unf str unf (repeatM seed)
1192-- | 'intersperseMSuffix' followed by unfold and concat.
1194-- >>> intercalateSuffix u a = Stream.unfoldMany u . Stream.intersperseMSuffix a
1195-- >>> intersperseMSuffix = Stream.intercalateSuffix Unfold.identity
1196-- >>> unlines = Stream.intercalateSuffix Unfold.fromList "\n"
1198-- >>> input = Stream.fromList ["abc", "def", "ghi"]
1199-- >>> Stream.fold Fold.toList $ Stream.intercalateSuffix Unfold.fromList "\n" input
1202{-# INLINE intercalateSuffix #-}
1203intercalateSuffix :: Monad m
1204 => Unfold m b c -> b -> Stream m b -> Stream m c
1205intercalateSuffix unf seed = unfoldMany unf . intersperseMSuffix (return seed)
1207-- > intercalate unf seed str = gintercalate unf str unf (repeatM seed)
1209-- | 'intersperse' followed by unfold and concat.
1211-- >>> intercalate u a = Stream.unfoldMany u . Stream.intersperse a
1212-- >>> intersperse = Stream.intercalate Unfold.identity
1213-- >>> unwords = Stream.intercalate Unfold.fromList " "
1215-- >>> input = Stream.fromList ["abc", "def", "ghi"]
1216-- >>> Stream.fold Fold.toList $ Stream.intercalate Unfold.fromList " " input
1219{-# INLINE intercalate #-}
1220intercalate :: Monad m
1221 => Unfold m b c -> b -> Stream m b -> Stream m c
1222intercalate unf seed str = unfoldMany unf $ intersperse seed str
1224------------------------------------------------------------------------------
1226------------------------------------------------------------------------------
1228-- | Apply a stream of folds to an input stream and emit the results in the
1233{-# INLINE foldSequence #-}
1236 Stream m (Fold m a b)
1239foldSequence _f _m = undefined
1241{-# ANN type FIterState Fuse #-}
1242data FIterState s f m a b
1244 | forall fs. FIterStream s (fs -> a -> m (FL.Step fs b)) fs (fs -> m b)
1245 | FIterYield b (FIterState s f m a b)
1248-- | Iterate a fold generator on a stream. The initial value @b@ is used to
1249-- generate the first fold, the fold is applied on the stream and the result of
1250-- the fold is used to generate the next fold and so on.
1252-- >>> import Data.Monoid (Sum(..))
1253-- >>> f x = return (Fold.take 2 (Fold.sconcat x))
1254-- >>> s = fmap Sum $ Stream.fromList [1..10]
1255-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.foldIterateM f (pure 0) s
1256-- [3,10,21,36,55,55]
1258-- This is the streaming equivalent of monad like sequenced application of
1259-- folds where next fold is dependent on the previous fold.
1263{-# INLINE_NORMAL foldIterateM #-}
1265 Monad m => (b -> m (FL.Fold m a b)) -> m b -> Stream m a -> Stream m b
1266foldIterateM func seed0 (Stream step state) =
1267 Stream stepOuter (FIterInit state seed0)
1271 {-# INLINE iterStep #-}
1272 iterStep from st fstep extract = do
1277 FL.Partial fs -> FIterStream st fstep fs extract
1278 FL.Done fb -> FIterYield fb $ FIterInit st (return fb)
1280 {-# INLINE_LATE stepOuter #-}
1281 stepOuter _ (FIterInit st seed) = do
1282 (FL.Fold fstep initial extract) <- seed >>= func
1283 iterStep initial st fstep extract
1284 stepOuter gst (FIterStream st fstep fs extract) = do
1285 r <- step (adaptState gst) st
1288 iterStep (fstep fs x) s fstep extract
1289 Skip s -> return $ Skip $ FIterStream s fstep fs extract
1292 return $ Skip $ FIterYield b FIterStop
1293 stepOuter _ (FIterYield a next) = return $ Yield a next
1294 stepOuter _ FIterStop = return Stop
1296{-# ANN type CIterState Fuse #-}
1297data CIterState s f fs b
1300 | CIterYield b (CIterState s f fs b)
1303-- | Like 'foldIterateM' but using the 'Refold' type instead. This could be
1304-- much more efficient due to stream fusion.
1307{-# INLINE_NORMAL refoldIterateM #-}
1309 Monad m => Refold m b a b -> m b -> Stream m a -> Stream m b
1310refoldIterateM (Refold fstep finject fextract) initial (Stream step state) =
1311 Stream stepOuter (CIterInit state initial)
1315 {-# INLINE iterStep #-}
1316 iterStep st action = do
1321 FL.Partial fs -> CIterConsume st fs
1322 FL.Done fb -> CIterYield fb $ CIterInit st (return fb)
1324 {-# INLINE_LATE stepOuter #-}
1325 stepOuter _ (CIterInit st action) = do
1326 iterStep st (action >>= finject)
1327 stepOuter gst (CIterConsume st fs) = do
1328 r <- step (adaptState gst) st
1330 Yield x s -> iterStep s (fstep fs x)
1331 Skip s -> return $ Skip $ CIterConsume s fs
1334 return $ Skip $ CIterYield b CIterStop
1335 stepOuter _ (CIterYield a next) = return $ Yield a next
1336 stepOuter _ CIterStop = return Stop
1338-- "n" elements at the end are dropped by the fold.
1339{-# INLINE sliceBy #-}
1340sliceBy :: Monad m => Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)
1341sliceBy (Fold step1 initial1 extract1) n = Refold step inject extract
1345 inject (i, len) = do
1348 Partial s -> Partial $ Tuple' (i + len + n) s
1349 Done l -> Done (i, l)
1351 step (Tuple' i s) x = do
1354 Partial s1 -> Partial $ Tuple' i s1
1355 Done len -> Done (i, len)
1357 extract (Tuple' i s) = (i,) <$> extract1 s
1359{-# INLINE sliceOnSuffix #-}
1360sliceOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)
1361sliceOnSuffix predicate =
1362 -- Scan the stream with the given refold
1364 (sliceBy (FL.takeEndBy_ predicate FL.length) 1)
1367------------------------------------------------------------------------------
1369------------------------------------------------------------------------------
1371{-# ANN type ParseChunksState Fuse #-}
1372data ParseChunksState x inpBuf st pst =
1373 ParseChunksInit inpBuf st
1374 | ParseChunksInitBuf inpBuf
1375 | ParseChunksInitLeftOver inpBuf
1376 | ParseChunksStream st inpBuf !pst
1377 | ParseChunksStop inpBuf !pst
1378 | ParseChunksBuf inpBuf st inpBuf !pst
1379 | ParseChunksExtract inpBuf inpBuf !pst
1380 | ParseChunksYield x (ParseChunksState x inpBuf st pst)
1382-- XXX return the remaining stream as part of the error.
1383-- XXX This is in fact parseMany1 (a la foldMany1). Do we need a parseMany as
1385{-# INLINE_NORMAL parseManyD #-}
1390 -> Stream m (Either ParseError b)
1391parseManyD (PRD.Parser pstep initial extract) (Stream step state) =
1392 Stream stepOuter (ParseChunksInit [] state)
1396 {-# INLINE_LATE stepOuter #-}
1397 -- Buffer is empty, get the first element from the stream, initialize the
1398 -- fold and then go to stream processing loop.
1399 stepOuter gst (ParseChunksInit [] st) = do
1400 r <- step (adaptState gst) st
1406 return $ Skip $ ParseChunksBuf [x] s [] ps
1408 let next = ParseChunksInit [x] s
1409 in return $ Skip $ ParseChunksYield (Right pb) next
1414 (Left (ParseError err))
1415 (ParseChunksInitLeftOver [])
1416 Skip s -> return $ Skip $ ParseChunksInit [] s
1419 -- Buffer is not empty, go to buffered processing loop
1420 stepOuter _ (ParseChunksInit src st) = do
1424 return $ Skip $ ParseChunksBuf src st [] ps
1426 let next = ParseChunksInit src st
1427 in return $ Skip $ ParseChunksYield (Right pb) next
1432 (Left (ParseError err))
1433 (ParseChunksInitLeftOver [])
1435 -- This is simplified ParseChunksInit
1436 stepOuter _ (ParseChunksInitBuf src) = do
1440 return $ Skip $ ParseChunksExtract src [] ps
1442 let next = ParseChunksInitBuf src
1443 in return $ Skip $ ParseChunksYield (Right pb) next
1448 (Left (ParseError err))
1449 (ParseChunksInitLeftOver [])
1451 -- XXX we just discard any leftover input at the end
1452 stepOuter _ (ParseChunksInitLeftOver _) = return Stop
1454 -- Buffer is empty, process elements from the stream
1455 stepOuter gst (ParseChunksStream st buf pst) = do
1456 r <- step (adaptState gst) st
1461 PR.Partial 0 pst1 ->
1462 return $ Skip $ ParseChunksStream s [] pst1
1463 PR.Partial n pst1 -> do
1464 assert (n <= length (x:buf)) (return ())
1465 let src0 = Prelude.take n (x:buf)
1466 src = Prelude.reverse src0
1467 return $ Skip $ ParseChunksBuf src s [] pst1
1468 PR.Continue 0 pst1 ->
1469 return $ Skip $ ParseChunksStream s (x:buf) pst1
1470 PR.Continue n pst1 -> do
1471 assert (n <= length (x:buf)) (return ())
1472 let (src0, buf1) = splitAt n (x:buf)
1473 src = Prelude.reverse src0
1474 return $ Skip $ ParseChunksBuf src s buf1 pst1
1477 ParseChunksYield (Right b) (ParseChunksInit [] s)
1479 assert (n <= length (x:buf)) (return ())
1480 let src = Prelude.reverse (Prelude.take n (x:buf))
1482 ParseChunksYield (Right b) (ParseChunksInit src s)
1487 (Left (ParseError err))
1488 (ParseChunksInitLeftOver [])
1489 Skip s -> return $ Skip $ ParseChunksStream s buf pst
1490 Stop -> return $ Skip $ ParseChunksStop buf pst
1492 -- go back to stream processing mode
1493 stepOuter _ (ParseChunksBuf [] s buf pst) =
1494 return $ Skip $ ParseChunksStream s buf pst
1496 -- buffered processing loop
1497 stepOuter _ (ParseChunksBuf (x:xs) s buf pst) = do
1500 PR.Partial 0 pst1 ->
1501 return $ Skip $ ParseChunksBuf xs s [] pst1
1502 PR.Partial n pst1 -> do
1503 assert (n <= length (x:buf)) (return ())
1504 let src0 = Prelude.take n (x:buf)
1505 src = Prelude.reverse src0 ++ xs
1506 return $ Skip $ ParseChunksBuf src s [] pst1
1507 PR.Continue 0 pst1 ->
1508 return $ Skip $ ParseChunksBuf xs s (x:buf) pst1
1509 PR.Continue n pst1 -> do
1510 assert (n <= length (x:buf)) (return ())
1511 let (src0, buf1) = splitAt n (x:buf)
1512 src = Prelude.reverse src0 ++ xs
1513 return $ Skip $ ParseChunksBuf src s buf1 pst1
1517 $ ParseChunksYield (Right b) (ParseChunksInit xs s)
1519 assert (n <= length (x:buf)) (return ())
1520 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1522 $ ParseChunksYield (Right b) (ParseChunksInit src s)
1527 (Left (ParseError err))
1528 (ParseChunksInitLeftOver [])
1530 -- This is simplified ParseChunksBuf
1531 stepOuter _ (ParseChunksExtract [] buf pst) =
1532 return $ Skip $ ParseChunksStop buf pst
1534 stepOuter _ (ParseChunksExtract (x:xs) buf pst) = do
1537 PR.Partial 0 pst1 ->
1538 return $ Skip $ ParseChunksExtract xs [] pst1
1539 PR.Partial n pst1 -> do
1540 assert (n <= length (x:buf)) (return ())
1541 let src0 = Prelude.take n (x:buf)
1542 src = Prelude.reverse src0 ++ xs
1543 return $ Skip $ ParseChunksExtract src [] pst1
1544 PR.Continue 0 pst1 ->
1545 return $ Skip $ ParseChunksExtract xs (x:buf) pst1
1546 PR.Continue n pst1 -> do
1547 assert (n <= length (x:buf)) (return ())
1548 let (src0, buf1) = splitAt n (x:buf)
1549 src = Prelude.reverse src0 ++ xs
1550 return $ Skip $ ParseChunksExtract src buf1 pst1
1554 $ ParseChunksYield (Right b) (ParseChunksInitBuf xs)
1556 assert (n <= length (x:buf)) (return ())
1557 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1560 $ ParseChunksYield (Right b) (ParseChunksInitBuf src)
1565 (Left (ParseError err))
1566 (ParseChunksInitLeftOver [])
1568 -- This is simplified ParseChunksExtract
1569 stepOuter _ (ParseChunksStop buf pst) = do
1572 PR.Partial _ _ -> error "Bug: parseMany: Partial in extract"
1573 PR.Continue 0 pst1 ->
1574 return $ Skip $ ParseChunksStop buf pst1
1575 PR.Continue n pst1 -> do
1576 assert (n <= length buf) (return ())
1577 let (src0, buf1) = splitAt n buf
1578 src = Prelude.reverse src0
1579 return $ Skip $ ParseChunksExtract src buf1 pst1
1582 ParseChunksYield (Right b) (ParseChunksInitLeftOver [])
1584 assert (n <= length buf) (return ())
1585 let src = Prelude.reverse (Prelude.take n buf)
1587 ParseChunksYield (Right b) (ParseChunksInitBuf src)
1592 (Left (ParseError err))
1593 (ParseChunksInitLeftOver [])
1595 stepOuter _ (ParseChunksYield a next) = return $ Yield a next
1597-- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the
1602-- >>> s = Stream.fromList [1..10]
1603-- >>> parser = Parser.takeBetween 0 2 Fold.sum
1604-- >>> Stream.fold Fold.toList $ Stream.parseMany parser s
1605-- [Right 3,Right 7,Right 11,Right 15,Right 19]
1607-- This is the streaming equivalent of the 'Streamly.Data.Parser.many' parse
1610-- Known Issues: When the parser fails there is no way to get the remaining
1613{-# INLINE parseMany #-}
1618 -> Stream m (Either ParseError b)
1619parseMany = parseManyD
1621-- | Apply a stream of parsers to an input stream and emit the results in the
1626{-# INLINE parseSequence #-}
1629 Stream m (PR.Parser a m b)
1632parseSequence _f _m = undefined
1634-- XXX Change the parser arguments' order
1636-- | @parseManyTill collect test stream@ tries the parser @test@ on the input,
1637-- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds
1638-- @test@ is tried again and so on. The parser stops when @test@ succeeds. The
1639-- output of @test@ is discarded and the output of @collect@ is emitted in the
1640-- output stream. The parser fails if @collect@ fails.
1644{-# INLINE parseManyTill #-}
1651parseManyTill = undefined
1653{-# ANN type ConcatParseState Fuse #-}
1654data ConcatParseState c b inpBuf st p m a =
1655 ConcatParseInit inpBuf st p
1656 | ConcatParseInitBuf inpBuf p
1657 | ConcatParseInitLeftOver inpBuf
1658 | forall s. ConcatParseStop
1659 inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1660 | forall s. ConcatParseStream
1661 st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1662 | forall s. ConcatParseBuf
1663 inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1664 | forall s. ConcatParseExtract
1665 inpBuf inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1666 | ConcatParseYield c (ConcatParseState c b inpBuf st p m a)
1668-- XXX Review the changes
1669{-# INLINE_NORMAL parseIterateD #-}
1672 => (b -> PRD.Parser a m b)
1675 -> Stream m (Either ParseError b)
1676parseIterateD func seed (Stream step state) =
1677 Stream stepOuter (ConcatParseInit [] state (func seed))
1681 {-# INLINE_LATE stepOuter #-}
1682 -- Buffer is empty, go to stream processing loop
1683 stepOuter _ (ConcatParseInit [] st (PRD.Parser pstep initial extract)) = do
1687 return $ Skip $ ConcatParseStream st [] pstep ps extract
1689 let next = ConcatParseInit [] st (func pb)
1690 in return $ Skip $ ConcatParseYield (Right pb) next
1695 (Left (ParseError err))
1696 (ConcatParseInitLeftOver [])
1698 -- Buffer is not empty, go to buffered processing loop
1699 stepOuter _ (ConcatParseInit src st
1700 (PRD.Parser pstep initial extract)) = do
1704 return $ Skip $ ConcatParseBuf src st [] pstep ps extract
1706 let next = ConcatParseInit src st (func pb)
1707 in return $ Skip $ ConcatParseYield (Right pb) next
1712 (Left (ParseError err))
1713 (ConcatParseInitLeftOver [])
1715 -- This is simplified ConcatParseInit
1716 stepOuter _ (ConcatParseInitBuf src
1717 (PRD.Parser pstep initial extract)) = do
1721 return $ Skip $ ConcatParseExtract src [] pstep ps extract
1723 let next = ConcatParseInitBuf src (func pb)
1724 in return $ Skip $ ConcatParseYield (Right pb) next
1729 (Left (ParseError err))
1730 (ConcatParseInitLeftOver [])
1732 -- XXX we just discard any leftover input at the end
1733 stepOuter _ (ConcatParseInitLeftOver _) = return Stop
1735 -- Buffer is empty process elements from the stream
1736 stepOuter gst (ConcatParseStream st buf pstep pst extract) = do
1737 r <- step (adaptState gst) st
1742 PR.Partial 0 pst1 ->
1743 return $ Skip $ ConcatParseStream s [] pstep pst1 extract
1744 PR.Partial n pst1 -> do
1745 assert (n <= length (x:buf)) (return ())
1746 let src0 = Prelude.take n (x:buf)
1747 src = Prelude.reverse src0
1748 return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract
1749 -- PR.Continue 0 pst1 ->
1750 -- return $ Skip $ ConcatParseStream s (x:buf) pst1
1751 PR.Continue n pst1 -> do
1752 assert (n <= length (x:buf)) (return ())
1753 let (src0, buf1) = splitAt n (x:buf)
1754 src = Prelude.reverse src0
1755 return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract
1756 -- XXX Specialize for Stop 0 common case?
1758 assert (n <= length (x:buf)) (return ())
1759 let src = Prelude.reverse (Prelude.take n (x:buf))
1761 ConcatParseYield (Right b) (ConcatParseInit src s (func b))
1766 (Left (ParseError err))
1767 (ConcatParseInitLeftOver [])
1768 Skip s -> return $ Skip $ ConcatParseStream s buf pstep pst extract
1769 Stop -> return $ Skip $ ConcatParseStop buf pstep pst extract
1771 -- go back to stream processing mode
1772 stepOuter _ (ConcatParseBuf [] s buf pstep ps extract) =
1773 return $ Skip $ ConcatParseStream s buf pstep ps extract
1775 -- buffered processing loop
1776 stepOuter _ (ConcatParseBuf (x:xs) s buf pstep pst extract) = do
1779 PR.Partial 0 pst1 ->
1780 return $ Skip $ ConcatParseBuf xs s [] pstep pst1 extract
1781 PR.Partial n pst1 -> do
1782 assert (n <= length (x:buf)) (return ())
1783 let src0 = Prelude.take n (x:buf)
1784 src = Prelude.reverse src0 ++ xs
1785 return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract
1786 -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1
1787 PR.Continue n pst1 -> do
1788 assert (n <= length (x:buf)) (return ())
1789 let (src0, buf1) = splitAt n (x:buf)
1790 src = Prelude.reverse src0 ++ xs
1791 return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract
1792 -- XXX Specialize for Stop 0 common case?
1794 assert (n <= length (x:buf)) (return ())
1795 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1796 return $ Skip $ ConcatParseYield (Right b)
1797 (ConcatParseInit src s (func b))
1802 (Left (ParseError err))
1803 (ConcatParseInitLeftOver [])
1805 -- This is simplified ConcatParseBuf
1806 stepOuter _ (ConcatParseExtract [] buf pstep pst extract) =
1807 return $ Skip $ ConcatParseStop buf pstep pst extract
1809 stepOuter _ (ConcatParseExtract (x:xs) buf pstep pst extract) = do
1812 PR.Partial 0 pst1 ->
1813 return $ Skip $ ConcatParseExtract xs [] pstep pst1 extract
1814 PR.Partial n pst1 -> do
1815 assert (n <= length (x:buf)) (return ())
1816 let src0 = Prelude.take n (x:buf)
1817 src = Prelude.reverse src0 ++ xs
1818 return $ Skip $ ConcatParseExtract src [] pstep pst1 extract
1819 PR.Continue 0 pst1 ->
1820 return $ Skip $ ConcatParseExtract xs (x:buf) pstep pst1 extract
1821 PR.Continue n pst1 -> do
1822 assert (n <= length (x:buf)) (return ())
1823 let (src0, buf1) = splitAt n (x:buf)
1824 src = Prelude.reverse src0 ++ xs
1825 return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract
1827 return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf xs (func b))
1829 assert (n <= length (x:buf)) (return ())
1830 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1831 return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))
1836 (Left (ParseError err))
1837 (ConcatParseInitLeftOver [])
1839 -- This is simplified ConcatParseExtract
1840 stepOuter _ (ConcatParseStop buf pstep pst extract) = do
1843 PR.Partial _ _ -> error "Bug: parseIterate: Partial in extract"
1844 PR.Continue 0 pst1 ->
1845 return $ Skip $ ConcatParseStop buf pstep pst1 extract
1846 PR.Continue n pst1 -> do
1847 assert (n <= length buf) (return ())
1848 let (src0, buf1) = splitAt n buf
1849 src = Prelude.reverse src0
1850 return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract
1853 ConcatParseYield (Right b) (ConcatParseInitLeftOver [])
1855 assert (n <= length buf) (return ())
1856 let src = Prelude.reverse (Prelude.take n buf)
1858 ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))
1863 (Left (ParseError err))
1864 (ConcatParseInitLeftOver [])
1866 stepOuter _ (ConcatParseYield a next) = return $ Yield a next
1868-- | Iterate a parser generating function on a stream. The initial value @b@ is
1869-- used to generate the first parser, the parser is applied on the stream and
1870-- the result is used to generate the next parser and so on.
1872-- >>> import Data.Monoid (Sum(..))
1873-- >>> s = Stream.fromList [1..10]
1874-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.catRights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum s
1875-- [3,10,21,36,55,55]
1877-- This is the streaming equivalent of monad like sequenced application of
1878-- parsers where next parser is dependent on the previous parser.
1882{-# INLINE parseIterate #-}
1885 => (b -> PR.Parser a m b)
1888 -> Stream m (Either ParseError b)
1889parseIterate = parseIterateD
1891------------------------------------------------------------------------------
1893------------------------------------------------------------------------------
1895data GroupByState st fs a b
1898 | GroupingInitWith st !a
1899 | GroupingDoWith st !fs !a
1900 | GroupingYield !b (GroupByState st fs a b)
1903-- | The argument order of the comparison function in `groupsWhile` is
1904-- different than that of `groupsBy`.
1906-- In `groupsBy` the comparison function takes the next element as the first
1907-- argument and the previous element as the second argument. In `groupsWhile`
1908-- the first argument is the previous element and second argument is the next
1910{-# INLINE_NORMAL groupsWhile #-}
1911groupsWhile :: Monad m
1917groupsWhile eq fld = parseMany (PRD.groupBy eq fld)
1919groupsWhile cmp (Fold fstep initial done) (Stream step state) =
1920 Stream stepOuter (GroupingInit state)
1924 {-# INLINE_LATE stepOuter #-}
1925 stepOuter _ (GroupingInit st) = do
1926 -- XXX Note that if the stream stops without yielding a single element
1927 -- in the group we discard the "initial" effect.
1931 FL.Partial s -> Skip $ GroupingDo st s
1932 FL.Done b -> Yield b $ GroupingInit st
1933 stepOuter gst (GroupingDo st fs) = do
1934 res <- step (adaptState gst) st
1939 FL.Partial fs1 -> go SPEC x s fs1
1940 FL.Done b -> return $ Yield b (GroupingInit s)
1941 Skip s -> return $ Skip $ GroupingDo s fs
1946 go !_ prev stt !acc = do
1947 res <- step (adaptState gst) stt
1954 FL.Partial fs1 -> go SPEC prev s fs1
1955 FL.Done b -> return $ Yield b (GroupingInit s)
1958 return $ Yield r (GroupingInitWith s x)
1959 Skip s -> go SPEC prev s acc
1960 Stop -> done acc >>= \r -> return $ Yield r GroupingDone
1961 stepOuter _ (GroupingInitWith st x) = do
1965 FL.Partial s -> Skip $ GroupingDoWith st s x
1966 FL.Done b -> Yield b $ GroupingInitWith st x
1967 stepOuter gst (GroupingDoWith st fs prev) = do
1968 res <- fstep fs prev
1970 FL.Partial fs1 -> go SPEC st fs1
1971 FL.Done b -> return $ Yield b (GroupingInit st)
1975 -- XXX code duplicated from the previous equation
1977 res <- step (adaptState gst) stt
1984 FL.Partial fs1 -> go SPEC s fs1
1985 FL.Done b -> return $ Yield b (GroupingInit s)
1988 return $ Yield r (GroupingInitWith s x)
1989 Skip s -> go SPEC s acc
1990 Stop -> done acc >>= \r -> return $ Yield r GroupingDone
1991 stepOuter _ (GroupingYield _ _) = error "groupsWhile: Unreachable"
1992 stepOuter _ GroupingDone = return Stop
1994{-# DEPRECATED groupsBy "Please use groupsWhile instead. Please note the change in the argument order of the comparison function." #-}
1995{-# INLINE_NORMAL groupsBy #-}
2001groupsBy cmp = groupsWhile (flip cmp)
2003{-# INLINE_NORMAL groupsRollingBy #-}
2004groupsRollingBy :: Monad m
2010groupsRollingBy eq fld = parseMany (PRD.groupByRolling eq fld)
2012groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =
2013 Stream stepOuter (GroupingInit state)
2017 {-# INLINE_LATE stepOuter #-}
2018 stepOuter _ (GroupingInit st) = do
2019 -- XXX Note that if the stream stops without yielding a single element
2020 -- in the group we discard the "initial" effect.
2024 FL.Partial fs -> Skip $ GroupingDo st fs
2025 FL.Done fb -> Yield fb $ GroupingInit st
2026 stepOuter gst (GroupingDo st fs) = do
2027 res <- step (adaptState gst) st
2032 FL.Partial fs1 -> go SPEC x s fs1
2033 FL.Done fb -> return $ Yield fb (GroupingInit s)
2034 Skip s -> return $ Skip $ GroupingDo s fs
2039 go !_ prev stt !acc = do
2040 res <- step (adaptState gst) stt
2047 FL.Partial fs1 -> go SPEC x s fs1
2048 FL.Done b -> return $ Yield b (GroupingInit s)
2051 return $ Yield r (GroupingInitWith s x)
2052 Skip s -> go SPEC prev s acc
2053 Stop -> done acc >>= \r -> return $ Yield r GroupingDone
2054 stepOuter _ (GroupingInitWith st x) = do
2058 FL.Partial s -> Skip $ GroupingDoWith st s x
2059 FL.Done b -> Yield b $ GroupingInitWith st x
2060 stepOuter gst (GroupingDoWith st fs previous) = do
2061 res <- fstep fs previous
2063 FL.Partial s -> go SPEC previous st s
2064 FL.Done b -> return $ Yield b (GroupingInit st)
2068 -- XXX GHC: groupsWhile has one less parameter in this go loop and it
2069 -- fuses. However, groupsRollingBy does not fuse, removing the prev
2070 -- parameter makes it fuse. Something needs to be fixed in GHC. The
2071 -- workaround for this is noted in the comments below.
2072 go !_ prev !stt !acc = do
2073 res <- step (adaptState gst) stt
2080 FL.Partial fs1 -> go SPEC x s fs1
2081 FL.Done b -> return $ Yield b (GroupingInit st)
2085 return $ Yield r (GroupingInitWith s x)
2087 -- The code above does not let groupBy fuse. We use the
2088 -- alternative code below instead. Instead of jumping
2089 -- to GroupingInitWith state, we unroll the code of
2090 -- GroupingInitWith state here to help GHC with stream
2097 FL.Partial fsi -> GroupingDoWith s fsi x
2098 FL.Done b -> GroupingYield b (GroupingInit s)
2099 Skip s -> go SPEC prev s acc
2100 Stop -> done acc >>= \r -> return $ Yield r GroupingDone
2101 stepOuter _ (GroupingYield r next) = return $ Yield r next
2102 stepOuter _ GroupingDone = return Stop
2104------------------------------------------------------------------------------
2105-- Splitting - by a predicate
2106------------------------------------------------------------------------------
2108data WordsByState st fs b
2112 | WordsByYield !b (WordsByState st fs b)
2114-- | Split the stream after stripping leading, trailing, and repeated separators
2115-- as per the fold supplied.
2116-- Therefore, @".a..b."@ with '.' as the separator would be parsed as
2117-- @["a","b"]@. In other words, its like parsing words from whitespace
2120{-# INLINE_NORMAL wordsBy #-}
2121wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
2122wordsBy predicate (Fold fstep initial done) (Stream step state) =
2123 Stream stepOuter (WordsByInit state)
2127 {-# INLINE_LATE stepOuter #-}
2128 stepOuter _ (WordsByInit st) = do
2132 FL.Partial s -> Skip $ WordsByDo st s
2133 FL.Done b -> Yield b (WordsByInit st)
2135 stepOuter gst (WordsByDo st fs) = do
2136 res <- step (adaptState gst) st
2144 FL.Partial fs1 -> Skip $ WordsByDo s fs1
2145 FL.Done b -> Yield b (WordsByInit s)
2149 FL.Partial fs1 -> go SPEC s fs1
2150 FL.Done b -> return $ Yield b (WordsByInit s)
2151 Skip s -> return $ Skip $ WordsByDo s fs
2157 res <- step (adaptState gst) stt
2164 return $ Yield r (WordsByInit s)
2166 -- The above code does not fuse well. Need to check why
2167 -- GHC is not able to simplify it well. Using the code
2168 -- below, instead of jumping through the WordsByInit
2169 -- state always, we directly go to WordsByDo state in
2170 -- the common case of Partial.
2176 FL.Partial fs1 -> WordsByDo s fs1
2177 FL.Done b -> WordsByYield b (WordsByInit s)
2181 FL.Partial fs1 -> go SPEC s fs1
2182 FL.Done b -> return $ Yield b (WordsByInit s)
2183 Skip s -> go SPEC s acc
2184 Stop -> done acc >>= \r -> return $ Yield r WordsByDone
2186 stepOuter _ WordsByDone = return Stop
2188 stepOuter _ (WordsByYield b next) = return $ Yield b next
2190------------------------------------------------------------------------------
2191-- Splitting on a sequence
2192------------------------------------------------------------------------------
2194-- String search algorithms:
2195-- http://www-igm.univ-mlv.fr/~lecroq/string/index.html
2198-- TODO can we unify the splitting operations using a splitting configuration
2199-- like in the split package.
2201data SplitStyle = Infix | Suffix | Prefix deriving (Eq, Show)
2202data SplitOptions = SplitOptions
2203 { style :: SplitStyle
2204 , withSep :: Bool -- ^ keep the separators in output
2205 -- , compact :: Bool -- ^ treat multiple consecutive separators as one
2206 -- , trimHead :: Bool -- ^ drop blank at head
2207 -- , trimTail :: Bool -- ^ drop blank at tail
2211-- XXX using "fs" as the last arg in Constructors may simplify the code a bit,
2212-- because we can use the constructor directly without having to create "jump"
2214{-# ANN type SplitOnSeqState Fuse #-}
2215data SplitOnSeqState rb rh ck w fs s b x =
2217 | SplitOnSeqYield b (SplitOnSeqState rb rh ck w fs s b x)
2220 | SplitOnSeqEmpty !fs s
2222 | SplitOnSeqSingle !fs s x
2224 | SplitOnSeqWordInit !fs s
2225 | SplitOnSeqWordLoop !w s !fs
2226 | SplitOnSeqWordDone Int !fs !w
2228 | SplitOnSeqKRInit Int !fs s rb !rh
2229 | SplitOnSeqKRLoop fs s rb !rh !ck
2230 | SplitOnSeqKRCheck fs s rb !rh
2231 | SplitOnSeqKRDone Int !fs rb !rh
2233 | SplitOnSeqReinit (fs -> SplitOnSeqState rb rh ck w fs s b x)
2235{-# INLINE_NORMAL splitOnSeq #-}
2237 :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)
2242splitOnSeq patArr (Fold fstep initial done) (Stream step state) =
2243 Stream stepOuter SplitOnSeqInit
2247 patLen = A.length patArr
2248 maxIndex = patLen - 1
2249 elemBits = SIZE_OF(a) * 8
2251 -- For word pattern case
2253 wordMask = (1 `shiftL` (elemBits * patLen)) - 1
2256 elemMask = (1 `shiftL` elemBits) - 1
2259 wordPat = wordMask .&. A.foldl' addToWord 0 patArr
2261 addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)
2263 -- For Rabin-Karp search
2264 k = 2891336453 :: Word32
2267 addCksum cksum a = cksum * k + fromIntegral (fromEnum a)
2269 deltaCksum cksum old new =
2270 addCksum cksum new - coeff * fromIntegral (fromEnum old)
2272 -- XXX shall we use a random starting hash or 1 instead of 0?
2273 patHash = A.foldl' addCksum 0 patArr
2275 skip = return . Skip
2277 nextAfterInit nextGen stepRes =
2279 FL.Partial s -> nextGen s
2280 FL.Done b -> SplitOnSeqYield b (SplitOnSeqReinit nextGen)
2282 {-# INLINE yieldProceed #-}
2283 yieldProceed nextGen fs =
2284 initial >>= skip . SplitOnSeqYield fs . nextAfterInit nextGen
2286 {-# INLINE_LATE stepOuter #-}
2287 stepOuter _ SplitOnSeqInit = do
2292 then return $ Skip $ SplitOnSeqEmpty acc state
2295 pat <- liftIO $ A.unsafeIndexIO 0 patArr
2296 return $ Skip $ SplitOnSeqSingle acc state pat
2297 else if SIZE_OF(a) * patLen
2298 <= sizeOf (Proxy :: Proxy Word)
2299 then return $ Skip $ SplitOnSeqWordInit acc state
2301 (rb, rhead) <- liftIO $ RB.new patLen
2302 skip $ SplitOnSeqKRInit 0 acc state rb rhead
2303 FL.Done b -> skip $ SplitOnSeqYield b SplitOnSeqInit
2305 stepOuter _ (SplitOnSeqYield x next) = return $ Yield x next
2307 ---------------------------
2309 ---------------------------
2311 stepOuter _ (SplitOnSeqReinit nextGen) =
2312 initial >>= skip . nextAfterInit nextGen
2314 ---------------------------
2316 ---------------------------
2318 stepOuter gst (SplitOnSeqEmpty acc st) = do
2319 res <- step (adaptState gst) st
2325 FL.Partial acc1 -> done acc1
2326 FL.Done b -> return b
2327 let jump c = SplitOnSeqEmpty c s
2328 in yieldProceed jump b1
2329 Skip s -> skip (SplitOnSeqEmpty acc s)
2336 stepOuter _ SplitOnSeqDone = return Stop
2342 stepOuter gst (SplitOnSeqSingle fs st pat) = do
2343 res <- step (adaptState gst) st
2346 let jump c = SplitOnSeqSingle c s pat
2348 then done fs >>= yieldProceed jump
2352 FL.Partial fs1 -> skip $ jump fs1
2353 FL.Done b -> yieldProceed jump b
2354 Skip s -> return $ Skip $ SplitOnSeqSingle fs s pat
2357 return $ Skip $ SplitOnSeqYield r SplitOnSeqDone
2359 ---------------------------
2360 -- Short Pattern - Shift Or
2361 ---------------------------
2363 stepOuter _ (SplitOnSeqWordDone 0 fs _) = do
2365 skip $ SplitOnSeqYield r SplitOnSeqDone
2366 stepOuter _ (SplitOnSeqWordDone n fs wrd) = do
2367 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))
2368 r <- fstep fs (toEnum $ fromIntegral old)
2370 FL.Partial fs1 -> skip $ SplitOnSeqWordDone (n - 1) fs1 wrd
2372 let jump c = SplitOnSeqWordDone (n - 1) c wrd
2375 stepOuter gst (SplitOnSeqWordInit fs st0) =
2381 go !_ !idx !wrd !st = do
2382 res <- step (adaptState gst) st
2385 let wrd1 = addToWord wrd x
2388 if wrd1 .&. wordMask == wordPat
2390 let jump c = SplitOnSeqWordInit c s
2391 done fs >>= yieldProceed jump
2392 else skip $ SplitOnSeqWordLoop wrd1 s fs
2393 else go SPEC (idx + 1) wrd1 s
2394 Skip s -> go SPEC idx wrd s
2397 then skip $ SplitOnSeqWordDone idx fs wrd
2400 skip $ SplitOnSeqYield r SplitOnSeqDone
2402 stepOuter gst (SplitOnSeqWordLoop wrd0 st0 fs0) =
2403 go SPEC wrd0 st0 fs0
2408 go !_ !wrd !st !fs = do
2409 res <- step (adaptState gst) st
2412 let jump c = SplitOnSeqWordInit c s
2413 wrd1 = addToWord wrd x
2414 old = (wordMask .&. wrd)
2415 `shiftR` (elemBits * (patLen - 1))
2416 r <- fstep fs (toEnum $ fromIntegral old)
2418 FL.Partial fs1 -> do
2419 if wrd1 .&. wordMask == wordPat
2420 then done fs1 >>= yieldProceed jump
2421 else go SPEC wrd1 s fs1
2422 FL.Done b -> yieldProceed jump b
2423 Skip s -> go SPEC wrd s fs
2424 Stop -> skip $ SplitOnSeqWordDone patLen fs wrd
2426 -------------------------------
2427 -- General Pattern - Karp Rabin
2428 -------------------------------
2430 stepOuter gst (SplitOnSeqKRInit idx fs st rb rh) = do
2431 res <- step (adaptState gst) st
2434 rh1 <- liftIO $ RB.unsafeInsert rb rh x
2437 let fld = RB.unsafeFoldRing (RB.ringBound rb)
2438 let !ringHash = fld addCksum 0 rb
2439 if ringHash == patHash
2440 then skip $ SplitOnSeqKRCheck fs s rb rh1
2441 else skip $ SplitOnSeqKRLoop fs s rb rh1 ringHash
2442 else skip $ SplitOnSeqKRInit (idx + 1) fs s rb rh1
2443 Skip s -> skip $ SplitOnSeqKRInit idx fs s rb rh
2445 skip $ SplitOnSeqKRDone idx fs rb (RB.startOf rb)
2447 -- XXX The recursive "go" is more efficient than the state based recursion
2448 -- code commented out below. Perhaps its more efficient because of
2449 -- factoring out "rb" outside the loop.
2451 stepOuter gst (SplitOnSeqKRLoop fs0 st0 rb rh0 cksum0) =
2452 go SPEC fs0 st0 rh0 cksum0
2456 go !_ !fs !st !rh !cksum = do
2457 res <- step (adaptState gst) st
2460 old <- liftIO $ peek rh
2461 let cksum1 = deltaCksum cksum old x
2464 FL.Partial fs1 -> do
2465 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2466 if cksum1 == patHash
2467 then skip $ SplitOnSeqKRCheck fs1 s rb rh1
2468 else go SPEC fs1 s rh1 cksum1
2470 let rst = RB.startOf rb
2471 jump c = SplitOnSeqKRInit 0 c s rb rst
2473 Skip s -> go SPEC fs s rh cksum
2474 Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh
2476 -- XXX The following code is 5 times slower compared to the recursive loop
2477 -- based code above. Need to investigate why. One possibility is that the
2478 -- go loop above does not thread around the ring buffer (rb). This code may
2479 -- be causing the state to bloat and getting allocated on each iteration.
2480 -- We can check the cmm/asm code to confirm. If so a good GHC solution to
2481 -- such problem is needed. One way to avoid this could be to use unboxed
2484 stepOuter gst (SplitOnSeqKRLoop fs st rb rh cksum) = do
2485 res <- step (adaptState gst) st
2488 old <- liftIO $ peek rh
2489 let cksum1 = deltaCksum cksum old x
2491 if (cksum1 == patHash)
2494 skip $ SplitOnSeqYield r $ SplitOnSeqKRInit 0 s rb rh
2496 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2497 skip $ SplitOnSeqKRLoop fs1 s rb rh1 cksum1
2498 Skip s -> skip $ SplitOnSeqKRLoop fs s rb rh cksum
2499 Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh
2502 stepOuter _ (SplitOnSeqKRCheck fs st rb rh) = do
2503 if RB.unsafeEqArray rb rh patArr
2506 let rst = RB.startOf rb
2507 jump c = SplitOnSeqKRInit 0 c st rb rst
2509 else skip $ SplitOnSeqKRLoop fs st rb rh patHash
2511 stepOuter _ (SplitOnSeqKRDone 0 fs _ _) = do
2513 skip $ SplitOnSeqYield r SplitOnSeqDone
2514 stepOuter _ (SplitOnSeqKRDone n fs rb rh) = do
2515 old <- liftIO $ peek rh
2516 let rh1 = RB.advance rb rh
2519 FL.Partial fs1 -> skip $ SplitOnSeqKRDone (n - 1) fs1 rb rh1
2521 let jump c = SplitOnSeqKRDone (n - 1) c rb rh1
2524{-# ANN type SplitOnSuffixSeqState Fuse #-}
2525data SplitOnSuffixSeqState rb rh ck w fs s b x =
2526 SplitOnSuffixSeqInit
2527 | SplitOnSuffixSeqYield b (SplitOnSuffixSeqState rb rh ck w fs s b x)
2528 | SplitOnSuffixSeqDone
2530 | SplitOnSuffixSeqEmpty !fs s
2532 | SplitOnSuffixSeqSingleInit !fs s x
2533 | SplitOnSuffixSeqSingle !fs s x
2535 | SplitOnSuffixSeqWordInit !fs s
2536 | SplitOnSuffixSeqWordLoop !w s !fs
2537 | SplitOnSuffixSeqWordDone Int !fs !w
2539 | SplitOnSuffixSeqKRInit Int !fs s rb !rh
2540 | SplitOnSuffixSeqKRInit1 !fs s rb !rh
2541 | SplitOnSuffixSeqKRLoop fs s rb !rh !ck
2542 | SplitOnSuffixSeqKRCheck fs s rb !rh
2543 | SplitOnSuffixSeqKRDone Int !fs rb !rh
2545 | SplitOnSuffixSeqReinit
2546 (fs -> SplitOnSuffixSeqState rb rh ck w fs s b x)
2548{-# INLINE_NORMAL splitOnSuffixSeq #-}
2550 :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)
2556splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =
2557 Stream stepOuter SplitOnSuffixSeqInit
2561 patLen = A.length patArr
2562 maxIndex = patLen - 1
2563 elemBits = SIZE_OF(a) * 8
2565 -- For word pattern case
2567 wordMask = (1 `shiftL` (elemBits * patLen)) - 1
2570 elemMask = (1 `shiftL` elemBits) - 1
2573 wordPat = wordMask .&. A.foldl' addToWord 0 patArr
2575 addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)
2577 nextAfterInit nextGen stepRes =
2579 FL.Partial s -> nextGen s
2581 SplitOnSuffixSeqYield b (SplitOnSuffixSeqReinit nextGen)
2583 {-# INLINE yieldProceed #-}
2584 yieldProceed nextGen fs =
2585 initial >>= skip . SplitOnSuffixSeqYield fs . nextAfterInit nextGen
2587 -- For single element pattern case
2588 {-# INLINE processYieldSingle #-}
2589 processYieldSingle pat x s fs = do
2590 let jump c = SplitOnSuffixSeqSingleInit c s pat
2593 r <- if withSep then fstep fs x else return $ FL.Partial fs
2596 FL.Partial fs1 -> done fs1
2597 FL.Done b -> return b
2598 yieldProceed jump b1
2602 FL.Partial fs1 -> skip $ SplitOnSuffixSeqSingle fs1 s pat
2603 FL.Done b -> yieldProceed jump b
2605 -- For Rabin-Karp search
2606 k = 2891336453 :: Word32
2609 addCksum cksum a = cksum * k + fromIntegral (fromEnum a)
2611 deltaCksum cksum old new =
2612 addCksum cksum new - coeff * fromIntegral (fromEnum old)
2614 -- XXX shall we use a random starting hash or 1 instead of 0?
2615 patHash = A.foldl' addCksum 0 patArr
2617 skip = return . Skip
2619 {-# INLINE_LATE stepOuter #-}
2620 stepOuter _ SplitOnSuffixSeqInit = do
2625 then skip $ SplitOnSuffixSeqEmpty fs state
2628 pat <- liftIO $ A.unsafeIndexIO 0 patArr
2629 skip $ SplitOnSuffixSeqSingleInit fs state pat
2630 else if SIZE_OF(a) * patLen
2631 <= sizeOf (Proxy :: Proxy Word)
2632 then skip $ SplitOnSuffixSeqWordInit fs state
2634 (rb, rhead) <- liftIO $ RB.new patLen
2635 skip $ SplitOnSuffixSeqKRInit 0 fs state rb rhead
2636 FL.Done fb -> skip $ SplitOnSuffixSeqYield fb SplitOnSuffixSeqInit
2638 stepOuter _ (SplitOnSuffixSeqYield x next) = return $ Yield x next
2640 ---------------------------
2642 ---------------------------
2644 stepOuter _ (SplitOnSuffixSeqReinit nextGen) =
2645 initial >>= skip . nextAfterInit nextGen
2647 ---------------------------
2649 ---------------------------
2651 stepOuter gst (SplitOnSuffixSeqEmpty acc st) = do
2652 res <- step (adaptState gst) st
2655 let jump c = SplitOnSuffixSeqEmpty c s
2659 FL.Partial fs -> done fs
2660 FL.Done b -> return b
2661 yieldProceed jump b1
2662 Skip s -> skip (SplitOnSuffixSeqEmpty acc s)
2669 stepOuter _ SplitOnSuffixSeqDone = return Stop
2675 stepOuter gst (SplitOnSuffixSeqSingleInit fs st pat) = do
2676 res <- step (adaptState gst) st
2678 Yield x s -> processYieldSingle pat x s fs
2679 Skip s -> skip $ SplitOnSuffixSeqSingleInit fs s pat
2682 stepOuter gst (SplitOnSuffixSeqSingle fs st pat) = do
2683 res <- step (adaptState gst) st
2685 Yield x s -> processYieldSingle pat x s fs
2686 Skip s -> skip $ SplitOnSuffixSeqSingle fs s pat
2689 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2691 ---------------------------
2692 -- Short Pattern - Shift Or
2693 ---------------------------
2695 stepOuter _ (SplitOnSuffixSeqWordDone 0 fs _) = do
2697 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2698 stepOuter _ (SplitOnSuffixSeqWordDone n fs wrd) = do
2699 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))
2700 r <- fstep fs (toEnum $ fromIntegral old)
2702 FL.Partial fs1 -> skip $ SplitOnSuffixSeqWordDone (n - 1) fs1 wrd
2704 let jump c = SplitOnSuffixSeqWordDone (n - 1) c wrd
2707 stepOuter gst (SplitOnSuffixSeqWordInit fs0 st0) = do
2708 res <- step (adaptState gst) st0
2711 let wrd = addToWord 0 x
2712 r <- if withSep then fstep fs0 x else return $ FL.Partial fs0
2714 FL.Partial fs1 -> go SPEC 1 wrd s fs1
2716 let jump c = SplitOnSuffixSeqWordInit c s
2718 Skip s -> skip (SplitOnSuffixSeqWordInit fs0 s)
2724 go !_ !idx !wrd !st !fs = do
2725 res <- step (adaptState gst) st
2728 let jump c = SplitOnSuffixSeqWordInit c s
2729 let wrd1 = addToWord wrd x
2730 r <- if withSep then fstep fs x else return $ FL.Partial fs
2734 then go SPEC (idx + 1) wrd1 s fs1
2735 else if wrd1 .&. wordMask /= wordPat
2736 then skip $ SplitOnSuffixSeqWordLoop wrd1 s fs1
2737 else do done fs >>= yieldProceed jump
2738 FL.Done b -> yieldProceed jump b
2739 Skip s -> go SPEC idx wrd s fs
2740 Stop -> skip $ SplitOnSuffixSeqWordDone idx fs wrd
2742 stepOuter gst (SplitOnSuffixSeqWordLoop wrd0 st0 fs0) =
2743 go SPEC wrd0 st0 fs0
2748 go !_ !wrd !st !fs = do
2749 res <- step (adaptState gst) st
2752 let jump c = SplitOnSuffixSeqWordInit c s
2753 wrd1 = addToWord wrd x
2754 old = (wordMask .&. wrd)
2755 `shiftR` (elemBits * (patLen - 1))
2759 else fstep fs (toEnum $ fromIntegral old)
2762 if wrd1 .&. wordMask == wordPat
2763 then done fs1 >>= yieldProceed jump
2764 else go SPEC wrd1 s fs1
2765 FL.Done b -> yieldProceed jump b
2766 Skip s -> go SPEC wrd s fs
2768 if wrd .&. wordMask == wordPat
2773 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2774 else skip $ SplitOnSuffixSeqWordDone patLen fs wrd
2776 -------------------------------
2777 -- General Pattern - Karp Rabin
2778 -------------------------------
2780 stepOuter gst (SplitOnSuffixSeqKRInit idx0 fs st0 rb rh0) = do
2781 res <- step (adaptState gst) st0
2784 rh1 <- liftIO $ RB.unsafeInsert rb rh0 x
2785 r <- if withSep then fstep fs x else return $ FL.Partial fs
2788 skip $ SplitOnSuffixSeqKRInit1 fs1 s rb rh1
2790 let rst = RB.startOf rb
2791 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst
2793 Skip s -> skip $ SplitOnSuffixSeqKRInit idx0 fs s rb rh0
2796 stepOuter gst (SplitOnSuffixSeqKRInit1 fs0 st0 rb rh0) = do
2797 go SPEC 1 rh0 st0 fs0
2801 go !_ !idx !rh st !fs = do
2802 res <- step (adaptState gst) st
2805 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2806 r <- if withSep then fstep fs x else return $ FL.Partial fs
2810 then go SPEC (idx + 1) rh1 s fs1
2812 let fld = RB.unsafeFoldRing (RB.ringBound rb)
2813 !ringHash = fld addCksum 0 rb
2814 in if ringHash == patHash
2815 then SplitOnSuffixSeqKRCheck fs1 s rb rh1
2816 else SplitOnSuffixSeqKRLoop
2817 fs1 s rb rh1 ringHash
2819 let rst = RB.startOf rb
2820 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst
2822 Skip s -> go SPEC idx rh s fs
2824 -- do not issue a blank segment when we end at pattern
2825 if (idx == maxIndex) && RB.unsafeEqArray rb rh patArr
2830 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2831 else skip $ SplitOnSuffixSeqKRDone idx fs rb (RB.startOf rb)
2833 stepOuter gst (SplitOnSuffixSeqKRLoop fs0 st0 rb rh0 cksum0) =
2834 go SPEC fs0 st0 rh0 cksum0
2838 go !_ !fs !st !rh !cksum = do
2839 res <- step (adaptState gst) st
2842 old <- liftIO $ peek rh
2843 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2844 let cksum1 = deltaCksum cksum old x
2845 r <- if withSep then fstep fs x else fstep fs old
2848 if cksum1 /= patHash
2849 then go SPEC fs1 s rh1 cksum1
2850 else skip $ SplitOnSuffixSeqKRCheck fs1 s rb rh1
2852 let rst = RB.startOf rb
2853 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst
2855 Skip s -> go SPEC fs s rh cksum
2857 if RB.unsafeEqArray rb rh patArr
2862 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2863 else skip $ SplitOnSuffixSeqKRDone patLen fs rb rh
2865 stepOuter _ (SplitOnSuffixSeqKRCheck fs st rb rh) = do
2866 if RB.unsafeEqArray rb rh patArr
2869 let rst = RB.startOf rb
2870 jump c = SplitOnSuffixSeqKRInit 0 c st rb rst
2872 else skip $ SplitOnSuffixSeqKRLoop fs st rb rh patHash
2874 stepOuter _ (SplitOnSuffixSeqKRDone 0 fs _ _) = do
2876 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2877 stepOuter _ (SplitOnSuffixSeqKRDone n fs rb rh) = do
2878 old <- liftIO $ peek rh
2879 let rh1 = RB.advance rb rh
2882 FL.Partial fs1 -> skip $ SplitOnSuffixSeqKRDone (n - 1) fs1 rb rh1
2884 let jump c = SplitOnSuffixSeqKRDone (n - 1) c rb rh1
2887-- Implement this as a fold or a parser instead.
2888-- This can be implemented easily using Rabin Karp
2889-- | Split post any one of the given patterns.
2892{-# INLINE splitOnSuffixSeqAny #-}
2893splitOnSuffixSeqAny :: -- (Monad m, Unboxed a, Integral a) =>
2894 [Array a] -> Fold m a b -> Stream m a -> Stream m b
2895splitOnSuffixSeqAny _subseq _f _m = undefined
2896 -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m)
2898-- | Split on a prefixed separator element, dropping the separator. The
2899-- supplied 'Fold' is applied on the split segments.
2902-- > splitOnPrefix' p xs = Stream.toList $ Stream.splitOnPrefix p (Fold.toList) (Stream.fromList xs)
2903-- > splitOnPrefix' (== '.') ".a.b"
2907-- An empty stream results in an empty output stream:
2909-- > splitOnPrefix' (== '.') ""
2913-- An empty segment consisting of only a prefix is folded to the default output
2917-- > splitOnPrefix' (== '.') "."
2920-- > splitOnPrefix' (== '.') ".a.b."
2923-- > splitOnPrefix' (== '.') ".a..b"
2928-- A prefix is optional at the beginning of the stream:
2931-- > splitOnPrefix' (== '.') "a"
2934-- > splitOnPrefix' (== '.') "a.b"
2938-- 'splitOnPrefix' is an inverse of 'intercalatePrefix' with a single element:
2940-- > Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList . Stream.splitOnPrefix (== '.') Fold.toList === id
2942-- Assuming the input stream does not contain the separator:
2944-- > Stream.splitOnPrefix (== '.') Fold.toList . Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList === id
2947{-# INLINE splitOnPrefix #-}
2948splitOnPrefix :: -- (IsStream t, MonadCatch m) =>
2949 (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
2950splitOnPrefix _predicate _f = undefined
2951 -- parseMany (Parser.sliceBeginBy predicate f)
2953-- Int list examples for splitOn:
2955-- >>> splitList [] [1,2,3,3,4]
2956-- > [[1],[2],[3],[3],[4]]
2958-- >>> splitList [5] [1,2,3,3,4]
2961-- >>> splitList [1] [1,2,3,3,4]
2964-- >>> splitList [4] [1,2,3,3,4]
2967-- >>> splitList [2] [1,2,3,3,4]
2970-- >>> splitList [3] [1,2,3,3,4]
2973-- >>> splitList [3,3] [1,2,3,3,4]
2976-- >>> splitList [1,2,3,3,4] [1,2,3,3,4]
2979-- This can be implemented easily using Rabin Karp
2980-- | Split on any one of the given patterns.
2984{-# INLINE splitOnAny #-}
2985splitOnAny :: -- (Monad m, Unboxed a, Integral a) =>
2986 [Array a] -> Fold m a b -> Stream m a -> Stream m b
2987splitOnAny _subseq _f _m =
2988 undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m)
2990------------------------------------------------------------------------------
2991-- Nested Container Transformation
2992------------------------------------------------------------------------------
2994{-# ANN type SplitState Fuse #-}
2995data SplitState s arr
2997 | SplitBuffering s arr
2998 | SplitSplitting s arr
2999 | SplitYielding arr (SplitState s arr)
3002-- XXX An alternative approach would be to use a partial fold (Fold m a b) to
3003-- split using a splitBy like combinator. The Fold would consume upto the
3004-- separator and return any leftover which can then be fed to the next fold.
3006-- We can revisit this once we have partial folds/parsers.
3008-- | Performs infix separator style splitting.
3009{-# INLINE_NORMAL splitInnerBy #-}
3012 => (f a -> m (f a, Maybe (f a))) -- splitter
3013 -> (f a -> f a -> m (f a)) -- joiner
3016splitInnerBy splitter joiner (Stream step1 state1) =
3017 Stream step (SplitInitial state1)
3021 {-# INLINE_LATE step #-}
3022 step gst (SplitInitial st) = do
3026 (x1, mx2) <- splitter x
3027 return $ case mx2 of
3028 Nothing -> Skip (SplitBuffering s x1)
3029 Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))
3030 Skip s -> return $ Skip (SplitInitial s)
3033 step gst (SplitBuffering st buf) = do
3037 (x1, mx2) <- splitter x
3038 buf' <- joiner buf x1
3039 return $ case mx2 of
3040 Nothing -> Skip (SplitBuffering s buf')
3041 Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))
3042 Skip s -> return $ Skip (SplitBuffering s buf)
3043 Stop -> return $ Skip (SplitYielding buf SplitFinishing)
3045 step _ (SplitSplitting st buf) = do
3046 (x1, mx2) <- splitter buf
3047 return $ case mx2 of
3048 Nothing -> Skip $ SplitBuffering st x1
3049 Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)
3051 step _ (SplitYielding x next) = return $ Yield x next
3052 step _ SplitFinishing = return Stop
3054-- | Performs infix separator style splitting.
3055{-# INLINE_NORMAL splitInnerBySuffix #-}
3057 :: (Monad m, Eq (f a), Monoid (f a))
3058 => (f a -> m (f a, Maybe (f a))) -- splitter
3059 -> (f a -> f a -> m (f a)) -- joiner
3062splitInnerBySuffix splitter joiner (Stream step1 state1) =
3063 Stream step (SplitInitial state1)
3067 {-# INLINE_LATE step #-}
3068 step gst (SplitInitial st) = do
3072 (x1, mx2) <- splitter x
3073 return $ case mx2 of
3074 Nothing -> Skip (SplitBuffering s x1)
3075 Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))
3076 Skip s -> return $ Skip (SplitInitial s)
3079 step gst (SplitBuffering st buf) = do
3083 (x1, mx2) <- splitter x
3084 buf' <- joiner buf x1
3085 return $ case mx2 of
3086 Nothing -> Skip (SplitBuffering s buf')
3087 Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))
3088 Skip s -> return $ Skip (SplitBuffering s buf)
3092 else Skip (SplitYielding buf SplitFinishing)
3094 step _ (SplitSplitting st buf) = do
3095 (x1, mx2) <- splitter buf
3096 return $ case mx2 of
3097 Nothing -> Skip $ SplitBuffering st x1
3098 Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)
3100 step _ (SplitYielding x next) = return $ Yield x next
3101 step _ SplitFinishing = return Stop
3103------------------------------------------------------------------------------
3105------------------------------------------------------------------------------
3107-- | Drop prefix from the input stream if present.
3112{-# INLINE dropPrefix #-}
3114 -- (Monad m, Eq a) =>
3115 Stream m a -> Stream m a -> Stream m a
3116dropPrefix = error "Not implemented yet!"
3118-- | Drop all matching infix from the input stream if present. Infix stream
3119-- may be consumed multiple times.
3121-- Space: @O(n)@ where n is the length of the infix.
3124{-# INLINE dropInfix #-}
3126 -- (Monad m, Eq a) =>
3127 Stream m a -> Stream m a -> Stream m a
3128dropInfix = error "Not implemented yet!"
3130-- | Drop suffix from the input stream if present. Suffix stream may be
3131-- consumed multiple times.
3133-- Space: @O(n)@ where n is the length of the suffix.
3136{-# INLINE dropSuffix #-}
3138 -- (Monad m, Eq a) =>
3139 Stream m a -> Stream m a -> Stream m a
3140dropSuffix = 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