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 -- | Interleave elements from two streams based on a condition.
65 -- ** Combine N Streams
66 -- | Functions generally ending in these shapes:
69 -- concat: f (t m a) -> t m a
70 -- concatMap: (a -> t m b) -> t m a -> t m b
71 -- unfoldMany: Unfold m a b -> t m a -> t m b
75 -- | Generate streams by using an unfold on each element of an input
76 -- stream, append the resulting streams and flatten. A special case of
78 , ConcatUnfoldInterleaveState (..)
83 -- | Like unfoldMany but intersperses an effect between the streams. A
84 -- special case of gintercalate.
91 -- | Like unfoldMany but intersperses streams from another source between
92 -- the streams from the first source.
99 -- | Folding and Parsing chunks of streams to eliminate nested streams.
100 -- Functions generally ending in these shapes:
103 -- f (Fold m a b) -> t m a -> t m b
104 -- f (Parser a m b) -> t m a -> t m b
108 -- | Apply folds on a stream.
113 -- | Parsing is opposite to flattening. 'parseMany' is dual to concatMap or
114 -- unfoldMany. concatMap generates a stream from single values in a
115 -- stream and flattens, parseMany does the opposite of flattening by
116 -- splitting the stream and then folds each such split to single value in
117 -- the output stream.
126 -- | Group segments of a stream and fold. Special case of parsing.
132 -- | A special case of parsing.
134 , splitOnSeq -- XXX splitOnSeg
135 , splitOnSuffixSeq -- XXX splitOnSegSuffix, splitOnTrailer
137 -- XXX Implement these as folds or parsers instead.
138 , splitOnSuffixSeqAny
142 -- * Transform (Nested Containers)
143 -- | Opposite to compact in ArrayStream
144 , splitInnerBy -- XXX innerSplitOn
145 , splitInnerBySuffix -- XXX innerSplitOnSuffix
147 -- * Reduce By Streams
155#include "ArrayMacros.h"
157import Control.Exception (assert)
158import Control.Monad.IO.Class (MonadIO(..))
159import Data.Bits (shiftR, shiftL, (.|.), (.&.))
160import Data.Proxy (Proxy(..))
161import Data.Word (Word32)
162import Foreign.Storable (Storable, peek)
163import Fusion.Plugin.Types (Fuse(..))
164import GHC.Types (SPEC(..))
166import Streamly.Internal.Data.Array.Type (Array(..))
167import Streamly.Internal.Data.Fold.Type (Fold(..))
168import Streamly.Internal.Data.Parser (ParseError(..))
169import Streamly.Internal.Data.SVar.Type (adaptState)
170import Streamly.Internal.Data.Unbox (Unbox, sizeOf)
171import Streamly.Internal.Data.Unfold.Type (Unfold(..))
173import qualified Streamly.Internal.Data.Array.Type as A
174import qualified Streamly.Internal.Data.Fold as FL
175import qualified Streamly.Internal.Data.Parser as PR
176import qualified Streamly.Internal.Data.Parser as PRD
177import qualified Streamly.Internal.Data.Ring as RB
179import Streamly.Internal.Data.Stream.Transform
180 (intersperse, intersperseMSuffix)
181import Streamly.Internal.Data.Stream.Type
183import Prelude hiding (concatMap, mapM, zipWith)
185#include "DocTestDataStream.hs"
187------------------------------------------------------------------------------
189------------------------------------------------------------------------------
191data AppendState s1 s2 = AppendFirst s1 | AppendSecond s2
193-- From an implementation perspective, StreamK.'Streamly.Data.StreamK.append'
194-- translates into a function call whereas Stream.'append' translates into a
195-- conditional branch (jump). However, the overhead of the function call in
196-- StreamK.append is incurred only once, while the overhead of the conditional
197-- branch in fused append is incurred for each element in the stream. As a
198-- result, StreamK.append has a linear time complexity of O(n), while fused
199-- append has a quadratic time complexity of O(n^2), where @n@ represents the
200-- number of 'append's used.
202-- | WARNING! O(n^2) time complexity wrt number of streams. Suitable for
203-- statically fusing a small number of streams. Use the O(n) complexity
204-- StreamK.'Streamly.Data.StreamK.append' otherwise.
206-- Fuses two streams sequentially, yielding all elements from the first
207-- stream, and then all elements from the second stream.
209-- >>> s1 = Stream.fromList [1,2]
210-- >>> s2 = Stream.fromList [3,4]
211-- >>> Stream.fold Fold.toList $ s1 `Stream.append` s2
214{-# INLINE_NORMAL append #-}
215append :: Monad m => Stream m a -> Stream m a -> Stream m a
216append (Stream step1 state1) (Stream step2 state2) =
217 Stream step (AppendFirst state1)
221 {-# INLINE_LATE step #-}
222 step gst (AppendFirst st) = do
225 Yield a s -> Yield a (AppendFirst s)
226 Skip s -> Skip (AppendFirst s)
227 Stop -> Skip (AppendSecond state2)
229 step gst (AppendSecond st) = do
232 Yield a s -> Yield a (AppendSecond s)
233 Skip s -> Skip (AppendSecond s)
236------------------------------------------------------------------------------
238------------------------------------------------------------------------------
240data InterleaveState s1 s2 = InterleaveFirst s1 s2 | InterleaveSecond s1 s2
241 | InterleaveSecondOnly s2 | InterleaveFirstOnly s1
243-- | WARNING! O(n^2) time complexity wrt number of streams. Suitable for
244-- statically fusing a small number of streams. Use the O(n) complexity
245-- StreamK.'Streamly.Data.StreamK.interleave' otherwise.
247-- Interleaves two streams, yielding one element from each stream alternately.
248-- When one stream stops the rest of the other stream is used in the output
251{-# INLINE_NORMAL interleave #-}
252interleave :: Monad m => Stream m a -> Stream m a -> Stream m a
253interleave (Stream step1 state1) (Stream step2 state2) =
254 Stream step (InterleaveFirst state1 state2)
258 {-# INLINE_LATE step #-}
259 step gst (InterleaveFirst st1 st2) = do
262 Yield a s -> Yield a (InterleaveSecond s st2)
263 Skip s -> Skip (InterleaveFirst s st2)
264 Stop -> Skip (InterleaveSecondOnly st2)
266 step gst (InterleaveSecond st1 st2) = do
269 Yield a s -> Yield a (InterleaveFirst st1 s)
270 Skip s -> Skip (InterleaveSecond st1 s)
271 Stop -> Skip (InterleaveFirstOnly st1)
273 step gst (InterleaveFirstOnly st1) = do
276 Yield a s -> Yield a (InterleaveFirstOnly s)
277 Skip s -> Skip (InterleaveFirstOnly s)
280 step gst (InterleaveSecondOnly st2) = do
283 Yield a s -> Yield a (InterleaveSecondOnly s)
284 Skip s -> Skip (InterleaveSecondOnly s)
287-- | Like `interleave` but stops interleaving as soon as any of the two streams
290{-# INLINE_NORMAL interleaveMin #-}
291interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a
292interleaveMin (Stream step1 state1) (Stream step2 state2) =
293 Stream step (InterleaveFirst state1 state2)
297 {-# INLINE_LATE step #-}
298 step gst (InterleaveFirst st1 st2) = do
301 Yield a s -> Yield a (InterleaveSecond s st2)
302 Skip s -> Skip (InterleaveFirst s st2)
305 step gst (InterleaveSecond st1 st2) = do
308 Yield a s -> Yield a (InterleaveFirst st1 s)
309 Skip s -> Skip (InterleaveSecond st1 s)
312 step _ (InterleaveFirstOnly _) = undefined
313 step _ (InterleaveSecondOnly _) = undefined
315-- | Interleaves the outputs of two streams, yielding elements from each stream
316-- alternately, starting from the first stream. As soon as the first stream
317-- finishes, the output stops, discarding the remaining part of the second
318-- stream. In this case, the last element in the resulting stream would be from
319-- the second stream. If the second stream finishes early then the first stream
320-- still continues to yield elements until it finishes.
322-- >>> :set -XOverloadedStrings
323-- >>> import Data.Functor.Identity (Identity)
324-- >>> Stream.interleaveFstSuffix "abc" ",,,," :: Stream Identity Char
326-- >>> Stream.interleaveFstSuffix "abc" "," :: Stream Identity Char
329-- 'interleaveFstSuffix' is a dual of 'interleaveFst'.
331-- Do not use dynamically.
334{-# INLINE_NORMAL interleaveFstSuffix #-}
335interleaveFstSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a
336interleaveFstSuffix (Stream step1 state1) (Stream step2 state2) =
337 Stream step (InterleaveFirst state1 state2)
341 {-# INLINE_LATE step #-}
342 step gst (InterleaveFirst st1 st2) = do
345 Yield a s -> Yield a (InterleaveSecond s st2)
346 Skip s -> Skip (InterleaveFirst s st2)
349 step gst (InterleaveSecond st1 st2) = do
352 Yield a s -> Yield a (InterleaveFirst st1 s)
353 Skip s -> Skip (InterleaveSecond st1 s)
354 Stop -> Skip (InterleaveFirstOnly st1)
356 step gst (InterleaveFirstOnly st1) = do
359 Yield a s -> Yield a (InterleaveFirstOnly s)
360 Skip s -> Skip (InterleaveFirstOnly s)
363 step _ (InterleaveSecondOnly _) = undefined
365data InterleaveInfixState s1 s2 a
366 = InterleaveInfixFirst s1 s2
367 | InterleaveInfixSecondBuf s1 s2
368 | InterleaveInfixSecondYield s1 s2 a
369 | InterleaveInfixFirstYield s1 s2 a
370 | InterleaveInfixFirstOnly s1
372-- | Interleaves the outputs of two streams, yielding elements from each stream
373-- alternately, starting from the first stream and ending at the first stream.
374-- If the second stream is longer than the first, elements from the second
375-- stream are infixed with elements from the first stream. If the first stream
376-- is longer then it continues yielding elements even after the second stream
379-- >>> :set -XOverloadedStrings
380-- >>> import Data.Functor.Identity (Identity)
381-- >>> Stream.interleaveFst "abc" ",,,," :: Stream Identity Char
383-- >>> Stream.interleaveFst "abc" "," :: Stream Identity Char
386-- 'interleaveFst' is a dual of 'interleaveFstSuffix'.
388-- Do not use dynamically.
391{-# INLINE_NORMAL interleaveFst #-}
392interleaveFst :: Monad m => Stream m a -> Stream m a -> Stream m a
393interleaveFst (Stream step1 state1) (Stream step2 state2) =
394 Stream step (InterleaveInfixFirst state1 state2)
398 {-# INLINE_LATE step #-}
399 step gst (InterleaveInfixFirst st1 st2) = do
402 Yield a s -> Yield a (InterleaveInfixSecondBuf s st2)
403 Skip s -> Skip (InterleaveInfixFirst s st2)
406 step gst (InterleaveInfixSecondBuf st1 st2) = do
409 Yield a s -> Skip (InterleaveInfixSecondYield st1 s a)
410 Skip s -> Skip (InterleaveInfixSecondBuf st1 s)
411 Stop -> Skip (InterleaveInfixFirstOnly st1)
413 step gst (InterleaveInfixSecondYield st1 st2 x) = do
416 Yield a s -> Yield x (InterleaveInfixFirstYield s st2 a)
417 Skip s -> Skip (InterleaveInfixSecondYield s st2 x)
420 step _ (InterleaveInfixFirstYield st1 st2 x) = do
421 return $ Yield x (InterleaveInfixSecondBuf st1 st2)
423 step gst (InterleaveInfixFirstOnly st1) = do
426 Yield a s -> Yield a (InterleaveInfixFirstOnly s)
427 Skip s -> Skip (InterleaveInfixFirstOnly s)
430------------------------------------------------------------------------------
432------------------------------------------------------------------------------
434-- | Schedule the execution of two streams in a fair round-robin manner,
435-- executing each stream once, alternately. Execution of a stream may not
436-- necessarily result in an output, a stream may choose to @Skip@ producing an
437-- element until later giving the other stream a chance to run. Therefore, this
438-- combinator fairly interleaves the execution of two streams rather than
439-- fairly interleaving the output of the two streams. This can be useful in
440-- co-operative multitasking without using explicit threads. This can be used
441-- as an alternative to `async`.
443-- Do not use dynamically.
446{-# INLINE_NORMAL roundRobin #-}
447roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a
448roundRobin (Stream step1 state1) (Stream step2 state2) =
449 Stream step (InterleaveFirst state1 state2)
453 {-# INLINE_LATE step #-}
454 step gst (InterleaveFirst st1 st2) = do
457 Yield a s -> Yield a (InterleaveSecond s st2)
458 Skip s -> Skip (InterleaveSecond s st2)
459 Stop -> Skip (InterleaveSecondOnly st2)
461 step gst (InterleaveSecond st1 st2) = do
464 Yield a s -> Yield a (InterleaveFirst st1 s)
465 Skip s -> Skip (InterleaveFirst st1 s)
466 Stop -> Skip (InterleaveFirstOnly st1)
468 step gst (InterleaveSecondOnly st2) = do
471 Yield a s -> Yield a (InterleaveSecondOnly s)
472 Skip s -> Skip (InterleaveSecondOnly s)
475 step gst (InterleaveFirstOnly st1) = do
478 Yield a s -> Yield a (InterleaveFirstOnly s)
479 Skip s -> Skip (InterleaveFirstOnly s)
482------------------------------------------------------------------------------
484------------------------------------------------------------------------------
486-- | Like 'mergeBy' but with a monadic comparison function.
488-- Example, to merge two streams randomly:
491-- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT
492-- > Stream.toList $ Stream.mergeByM randomly (Stream.fromList [1,1,1,1]) (Stream.fromList [2,2,2,2])
496-- Example, merge two streams in a proportion of 2:1:
500-- let s1 = Stream.fromList [1,1,1,1,1,1]
501-- s2 = Stream.fromList [2,2,2]
502-- let proportionately m n = do
503-- ref <- newIORef $ cycle $ Prelude.concat [Prelude.replicate m LT, Prelude.replicate n GT]
504-- return $ \_ _ -> do
506-- writeIORef ref $ Prelude.tail r
507-- return $ Prelude.head r
508-- f <- proportionately 2 1
509-- xs <- Stream.fold Fold.toList $ Stream.mergeByM f s1 s2
512-- [1,1,2,1,1,2,1,1,2]
514{-# INLINE_NORMAL mergeByM #-}
517 => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
518mergeByM cmp (Stream stepa ta) (Stream stepb tb) =
519 Stream step (Just ta, Just tb, Nothing, Nothing)
521 {-# INLINE_LATE step #-}
523 -- one of the values is missing, and the corresponding stream is running
524 step gst (Just sa, sb, Nothing, b) = do
527 Yield a sa' -> Skip (Just sa', sb, Just a, b)
528 Skip sa' -> Skip (Just sa', sb, Nothing, b)
529 Stop -> Skip (Nothing, sb, Nothing, b)
531 step gst (sa, Just sb, a, Nothing) = do
534 Yield b sb' -> Skip (sa, Just sb', a, Just b)
535 Skip sb' -> Skip (sa, Just sb', a, Nothing)
536 Stop -> Skip (sa, Nothing, a, Nothing)
538 -- both the values are available
539 step _ (sa, sb, Just a, Just b) = do
542 GT -> Yield b (sa, sb, Just a, Nothing)
543 _ -> Yield a (sa, sb, Nothing, Just b)
545 -- one of the values is missing, corresponding stream is done
546 step _ (Nothing, sb, Nothing, Just b) =
547 return $ Yield b (Nothing, sb, Nothing, Nothing)
549 step _ (sa, Nothing, Just a, Nothing) =
550 return $ Yield a (sa, Nothing, Nothing, Nothing)
552 step _ (Nothing, Nothing, Nothing, Nothing) = return Stop
554-- | WARNING! O(n^2) time complexity wrt number of streams. Suitable for
555-- statically fusing a small number of streams. Use the O(n) complexity
556-- StreamK.'Streamly.Data.StreamK.mergeBy' otherwise.
558-- Merge two streams using a comparison function. The head elements of both
559-- the streams are compared and the smaller of the two elements is emitted, if
560-- both elements are equal then the element from the first stream is used
563-- If the streams are sorted in ascending order, the resulting stream would
564-- also remain sorted in ascending order.
566-- >>> s1 = Stream.fromList [1,3,5]
567-- >>> s2 = Stream.fromList [2,4,6,8]
568-- >>> Stream.fold Fold.toList $ Stream.mergeBy compare s1 s2
571{-# INLINE mergeBy #-}
574 => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a
575mergeBy cmp = mergeByM (\a b -> return $ cmp a b)
577-- | Like 'mergeByM' but stops merging as soon as any of the two streams stops.
580{-# INLINABLE mergeMinBy #-}
581mergeMinBy :: -- Monad m =>
582 (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
583mergeMinBy _f _m1 _m2 = undefined
584 -- fromStreamD $ D.mergeMinBy f (toStreamD m1) (toStreamD m2)
586-- | Like 'mergeByM' but stops merging as soon as the first stream stops.
589{-# INLINABLE mergeFstBy #-}
590mergeFstBy :: -- Monad m =>
591 (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
592mergeFstBy _f _m1 _m2 = undefined
593 -- fromStreamK $ D.mergeFstBy f (toStreamD m1) (toStreamD m2)
595------------------------------------------------------------------------------
596-- Combine N Streams - unfoldMany
597------------------------------------------------------------------------------
599data ConcatUnfoldInterleaveState o i =
600 ConcatUnfoldInterleaveOuter o [i]
601 | ConcatUnfoldInterleaveInner o [i]
602 | ConcatUnfoldInterleaveInnerL [i] [i]
603 | ConcatUnfoldInterleaveInnerR [i] [i]
605-- XXX use arrays to store state instead of lists?
607-- XXX In general we can use different scheduling strategies e.g. how to
608-- schedule the outer vs inner loop or assigning weights to different streams
609-- or outer and inner loops.
611-- After a yield, switch to the next stream. Do not switch streams on Skip.
612-- Yield from outer stream switches to the inner stream.
614-- There are two choices here, (1) exhaust the outer stream first and then
615-- start yielding from the inner streams, this is much simpler to implement,
616-- (2) yield at least one element from an inner stream before going back to
617-- outer stream and opening the next stream from it.
619-- Ideally, we need some scheduling bias to inner streams vs outer stream.
620-- Maybe we can configure the behavior.
622-- XXX Instead of using "concatPairsWith wSerial" we can implement an N-way
623-- interleaving CPS combinator which behaves like unfoldInterleave. Instead
624-- of pairing up the streams we just need to go yielding one element from each
625-- stream and storing the remaining streams and then keep doing rounds through
626-- those in a round robin fashion. This would be much like wAsync.
628-- | This does not pair streams like mergeMapWith, instead, it goes through
629-- each stream one by one and yields one element from each stream. After it
630-- goes to the last stream it reverses the traversal to come back to the first
631-- stream yielding elements from each stream on its way back to the first
634-- >>> lists = Stream.fromList [[1,1],[2,2],[3,3],[4,4],[5,5]]
635-- >>> interleaved = Stream.unfoldInterleave Unfold.fromList lists
636-- >>> Stream.fold Fold.toList interleaved
637-- [1,2,3,4,5,5,4,3,2,1]
639-- Note that this is order of magnitude more efficient than "mergeMapWith
640-- interleave" because of fusion.
642{-# INLINE_NORMAL unfoldInterleave #-}
643unfoldInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b
644unfoldInterleave (Unfold istep inject) (Stream ostep ost) =
645 Stream step (ConcatUnfoldInterleaveOuter ost [])
649 {-# INLINE_LATE step #-}
650 step gst (ConcatUnfoldInterleaveOuter o ls) = do
651 r <- ostep (adaptState gst) o
655 i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))
656 Skip o' -> return $ Skip (ConcatUnfoldInterleaveOuter o' ls)
657 Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
659 step _ (ConcatUnfoldInterleaveInner _ []) = undefined
660 step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do
663 Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))
664 Skip s -> Skip (ConcatUnfoldInterleaveInner o (s:ls))
665 Stop -> Skip (ConcatUnfoldInterleaveOuter o ls)
667 step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop
668 step _ (ConcatUnfoldInterleaveInnerL [] rs) =
669 return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)
671 step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do
674 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))
675 Skip s -> Skip (ConcatUnfoldInterleaveInnerL (s:ls) rs)
676 Stop -> Skip (ConcatUnfoldInterleaveInnerL ls rs)
678 step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop
679 step _ (ConcatUnfoldInterleaveInnerR ls []) =
680 return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
682 step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do
685 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)
686 Skip s -> Skip (ConcatUnfoldInterleaveInnerR ls (s:rs))
687 Stop -> Skip (ConcatUnfoldInterleaveInnerR ls rs)
689-- XXX In general we can use different scheduling strategies e.g. how to
690-- schedule the outer vs inner loop or assigning weights to different streams
691-- or outer and inner loops.
693-- This could be inefficient if the tasks are too small.
695-- Compared to unfoldInterleave this one switches streams on Skips.
697-- | 'unfoldInterleave' switches to the next stream whenever a value from a
698-- stream is yielded, it does not switch on a 'Skip'. So if a stream keeps
699-- skipping for long time other streams won't get a chance to run.
700-- 'unfoldRoundRobin' switches on Skip as well. So it basically schedules each
701-- stream fairly irrespective of whether it produces a value or not.
703{-# INLINE_NORMAL unfoldRoundRobin #-}
704unfoldRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b
705unfoldRoundRobin (Unfold istep inject) (Stream ostep ost) =
706 Stream step (ConcatUnfoldInterleaveOuter ost [])
708 {-# INLINE_LATE step #-}
709 step gst (ConcatUnfoldInterleaveOuter o ls) = do
710 r <- ostep (adaptState gst) o
714 i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))
715 Skip o' -> return $ Skip (ConcatUnfoldInterleaveInner o' ls)
716 Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
718 step _ (ConcatUnfoldInterleaveInner o []) =
719 return $ Skip (ConcatUnfoldInterleaveOuter o [])
721 step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do
724 Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))
725 Skip s -> Skip (ConcatUnfoldInterleaveOuter o (s:ls))
726 Stop -> Skip (ConcatUnfoldInterleaveOuter o ls)
728 step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop
729 step _ (ConcatUnfoldInterleaveInnerL [] rs) =
730 return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)
732 step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do
735 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))
736 Skip s -> Skip (ConcatUnfoldInterleaveInnerL ls (s:rs))
737 Stop -> Skip (ConcatUnfoldInterleaveInnerL ls rs)
739 step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop
740 step _ (ConcatUnfoldInterleaveInnerR ls []) =
741 return $ Skip (ConcatUnfoldInterleaveInnerL ls [])
743 step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do
746 Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)
747 Skip s -> Skip (ConcatUnfoldInterleaveInnerR (s:ls) rs)
748 Stop -> Skip (ConcatUnfoldInterleaveInnerR ls rs)
750------------------------------------------------------------------------------
751-- Combine N Streams - interpose
752------------------------------------------------------------------------------
754{-# ANN type InterposeSuffixState Fuse #-}
755data InterposeSuffixState s1 i1 =
756 InterposeSuffixFirst s1
757 -- | InterposeSuffixFirstYield s1 i1
758 | InterposeSuffixFirstInner s1 i1
759 | InterposeSuffixSecond s1
761-- Note that if an unfolded layer turns out to be nil we still emit the
762-- separator effect. An alternate behavior could be to emit the separator
763-- effect only if at least one element has been yielded by the unfolding.
764-- However, that becomes a bit complicated, so we have chosen the former
766{-# INLINE_NORMAL interposeSuffixM #-}
769 => m c -> Unfold m b c -> Stream m b -> Stream m c
772 (Unfold istep1 inject1) (Stream step1 state1) =
773 Stream step (InterposeSuffixFirst state1)
777 {-# INLINE_LATE step #-}
778 step gst (InterposeSuffixFirst s1) = do
779 r <- step1 (adaptState gst) s1
783 i `seq` return (Skip (InterposeSuffixFirstInner s i))
784 -- i `seq` return (Skip (InterposeSuffixFirstYield s i))
785 Skip s -> return $ Skip (InterposeSuffixFirst s)
789 step _ (InterposeSuffixFirstYield s1 i1) = do
792 Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')
793 Skip i' -> Skip (InterposeSuffixFirstYield s1 i')
794 Stop -> Skip (InterposeSuffixFirst s1)
797 step _ (InterposeSuffixFirstInner s1 i1) = do
800 Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')
801 Skip i' -> Skip (InterposeSuffixFirstInner s1 i')
802 Stop -> Skip (InterposeSuffixSecond s1)
804 step _ (InterposeSuffixSecond s1) = do
806 return $ Yield r (InterposeSuffixFirst s1)
808-- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x)
810-- | Unfold the elements of a stream, append the given element after each
811-- unfolded stream and then concat them into a single stream.
813-- >>> unlines = Stream.interposeSuffix '\n'
816{-# INLINE interposeSuffix #-}
817interposeSuffix :: Monad m
818 => c -> Unfold m b c -> Stream m b -> Stream m c
819interposeSuffix x = interposeSuffixM (return x)
821{-# ANN type InterposeState Fuse #-}
822data InterposeState s1 i1 a =
824 -- | InterposeFirstYield s1 i1
825 | InterposeFirstInner s1 i1
826 | InterposeFirstInject s1
827 -- | InterposeFirstBuf s1 i1
828 | InterposeSecondYield s1 i1
829 -- -- | InterposeSecondYield s1 i1 a
830 -- -- | InterposeFirstResume s1 i1 a
832-- Note that this only interposes the pure values, we may run many effects to
833-- generate those values as some effects may not generate anything (Skip).
834{-# INLINE_NORMAL interposeM #-}
835interposeM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c
838 (Unfold istep1 inject1) (Stream step1 state1) =
839 Stream step (InterposeFirst state1)
843 {-# INLINE_LATE step #-}
844 step gst (InterposeFirst s1) = do
845 r <- step1 (adaptState gst) s1
849 i `seq` return (Skip (InterposeFirstInner s i))
850 -- i `seq` return (Skip (InterposeFirstYield s i))
851 Skip s -> return $ Skip (InterposeFirst s)
855 step _ (InterposeFirstYield s1 i1) = do
858 Yield x i' -> Yield x (InterposeFirstInner s1 i')
859 Skip i' -> Skip (InterposeFirstYield s1 i')
860 Stop -> Skip (InterposeFirst s1)
863 step _ (InterposeFirstInner s1 i1) = do
866 Yield x i' -> Yield x (InterposeFirstInner s1 i')
867 Skip i' -> Skip (InterposeFirstInner s1 i')
868 Stop -> Skip (InterposeFirstInject s1)
870 step gst (InterposeFirstInject s1) = do
871 r <- step1 (adaptState gst) s1
875 -- i `seq` return (Skip (InterposeFirstBuf s i))
876 i `seq` return (Skip (InterposeSecondYield s i))
877 Skip s -> return $ Skip (InterposeFirstInject s)
881 step _ (InterposeFirstBuf s1 i1) = do
884 Yield x i' -> Skip (InterposeSecondYield s1 i' x)
885 Skip i' -> Skip (InterposeFirstBuf s1 i')
890 step _ (InterposeSecondYield s1 i1 v) = do
892 return $ Yield r (InterposeFirstResume s1 i1 v)
894 step _ (InterposeSecondYield s1 i1) = do
896 return $ Yield r (InterposeFirstInner s1 i1)
899 step _ (InterposeFirstResume s1 i1 v) = do
900 return $ Yield v (InterposeFirstInner s1 i1)
903-- > interpose x unf str = gintercalate unf str UF.identity (repeat x)
905-- | Unfold the elements of a stream, intersperse the given element between the
906-- unfolded streams and then concat them into a single stream.
908-- >>> unwords = Stream.interpose ' '
911{-# INLINE interpose #-}
913 => c -> Unfold m b c -> Stream m b -> Stream m c
914interpose x = interposeM (return x)
916------------------------------------------------------------------------------
917-- Combine N Streams - intercalate
918------------------------------------------------------------------------------
920data ICUState s1 s2 i1 i2 =
925 | ICUFirstInner s1 s2 i1
926 | ICUSecondInner s1 s2 i2
927 | ICUFirstOnlyInner s1 i1
928 | ICUSecondOnlyInner s2 i2
930-- | 'interleaveFstSuffix' followed by unfold and concat.
933{-# INLINE_NORMAL gintercalateSuffix #-}
936 => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
938 (Unfold istep1 inject1) (Stream step1 state1)
939 (Unfold istep2 inject2) (Stream step2 state2) =
940 Stream step (ICUFirst state1 state2)
944 {-# INLINE_LATE step #-}
945 step gst (ICUFirst s1 s2) = do
946 r <- step1 (adaptState gst) s1
950 i `seq` return (Skip (ICUFirstInner s s2 i))
951 Skip s -> return $ Skip (ICUFirst s s2)
954 step gst (ICUFirstOnly s1) = do
955 r <- step1 (adaptState gst) s1
959 i `seq` return (Skip (ICUFirstOnlyInner s i))
960 Skip s -> return $ Skip (ICUFirstOnly s)
963 step _ (ICUFirstInner s1 s2 i1) = do
966 Yield x i' -> Yield x (ICUFirstInner s1 s2 i')
967 Skip i' -> Skip (ICUFirstInner s1 s2 i')
968 Stop -> Skip (ICUSecond s1 s2)
970 step _ (ICUFirstOnlyInner s1 i1) = do
973 Yield x i' -> Yield x (ICUFirstOnlyInner s1 i')
974 Skip i' -> Skip (ICUFirstOnlyInner s1 i')
975 Stop -> Skip (ICUFirstOnly s1)
977 step gst (ICUSecond s1 s2) = do
978 r <- step2 (adaptState gst) s2
982 i `seq` return (Skip (ICUSecondInner s1 s i))
983 Skip s -> return $ Skip (ICUSecond s1 s)
984 Stop -> return $ Skip (ICUFirstOnly s1)
986 step _ (ICUSecondInner s1 s2 i2) = do
989 Yield x i' -> Yield x (ICUSecondInner s1 s2 i')
990 Skip i' -> Skip (ICUSecondInner s1 s2 i')
991 Stop -> Skip (ICUFirst s1 s2)
993 step _ (ICUSecondOnly _s2) = undefined
994 step _ (ICUSecondOnlyInner _s2 _i2) = undefined
996data ICALState s1 s2 i1 i2 a =
998 -- | ICALFirstYield s1 s2 i1
999 | ICALFirstInner s1 s2 i1
1001 | ICALFirstOnlyInner s1 i1
1002 | ICALSecondInject s1 s2
1003 | ICALFirstInject s1 s2 i2
1004 -- | ICALFirstBuf s1 s2 i1 i2
1005 | ICALSecondInner s1 s2 i1 i2
1006 -- -- | ICALSecondInner s1 s2 i1 i2 a
1007 -- -- | ICALFirstResume s1 s2 i1 i2 a
1009-- XXX we can swap the order of arguments to gintercalate so that the
1010-- definition of unfoldMany becomes simpler? The first stream should be
1011-- infixed inside the second one. However, if we change the order in
1012-- "interleave" as well similarly, then that will make it a bit unintuitive.
1014-- > unfoldMany unf str =
1015-- > gintercalate unf str (UF.nilM (\_ -> return ())) (repeat ())
1017-- | 'interleaveFst' followed by unfold and concat.
1020{-# INLINE_NORMAL gintercalate #-}
1023 => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
1025 (Unfold istep1 inject1) (Stream step1 state1)
1026 (Unfold istep2 inject2) (Stream step2 state2) =
1027 Stream step (ICALFirst state1 state2)
1031 {-# INLINE_LATE step #-}
1032 step gst (ICALFirst s1 s2) = do
1033 r <- step1 (adaptState gst) s1
1037 i `seq` return (Skip (ICALFirstInner s s2 i))
1038 -- i `seq` return (Skip (ICALFirstYield s s2 i))
1039 Skip s -> return $ Skip (ICALFirst s s2)
1043 step _ (ICALFirstYield s1 s2 i1) = do
1046 Yield x i' -> Yield x (ICALFirstInner s1 s2 i')
1047 Skip i' -> Skip (ICALFirstYield s1 s2 i')
1048 Stop -> Skip (ICALFirst s1 s2)
1051 step _ (ICALFirstInner s1 s2 i1) = do
1054 Yield x i' -> Yield x (ICALFirstInner s1 s2 i')
1055 Skip i' -> Skip (ICALFirstInner s1 s2 i')
1056 Stop -> Skip (ICALSecondInject s1 s2)
1058 step gst (ICALFirstOnly s1) = do
1059 r <- step1 (adaptState gst) s1
1063 i `seq` return (Skip (ICALFirstOnlyInner s i))
1064 Skip s -> return $ Skip (ICALFirstOnly s)
1067 step _ (ICALFirstOnlyInner s1 i1) = do
1070 Yield x i' -> Yield x (ICALFirstOnlyInner s1 i')
1071 Skip i' -> Skip (ICALFirstOnlyInner s1 i')
1072 Stop -> Skip (ICALFirstOnly s1)
1074 -- We inject the second stream even before checking if the first stream
1075 -- would yield any more elements. There is no clear choice whether we
1076 -- should do this before or after that. Doing it after may make the state
1077 -- machine a bit simpler though.
1078 step gst (ICALSecondInject s1 s2) = do
1079 r <- step2 (adaptState gst) s2
1083 i `seq` return (Skip (ICALFirstInject s1 s i))
1084 Skip s -> return $ Skip (ICALSecondInject s1 s)
1085 Stop -> return $ Skip (ICALFirstOnly s1)
1087 step gst (ICALFirstInject s1 s2 i2) = do
1088 r <- step1 (adaptState gst) s1
1092 i `seq` return (Skip (ICALSecondInner s s2 i i2))
1093 -- i `seq` return (Skip (ICALFirstBuf s s2 i i2))
1094 Skip s -> return $ Skip (ICALFirstInject s s2 i2)
1098 step _ (ICALFirstBuf s1 s2 i1 i2) = do
1101 Yield x i' -> Skip (ICALSecondInner s1 s2 i' i2 x)
1102 Skip i' -> Skip (ICALFirstBuf s1 s2 i' i2)
1105 step _ (ICALSecondInner s1 s2 i1 i2 v) = do
1108 Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i' v)
1109 Skip i' -> Skip (ICALSecondInner s1 s2 i1 i' v)
1110 Stop -> Skip (ICALFirstResume s1 s2 i1 i2 v)
1113 step _ (ICALSecondInner s1 s2 i1 i2) = do
1116 Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i')
1117 Skip i' -> Skip (ICALSecondInner s1 s2 i1 i')
1118 Stop -> Skip (ICALFirstInner s1 s2 i1)
1119 -- Stop -> Skip (ICALFirstResume s1 s2 i1 i2)
1122 step _ (ICALFirstResume s1 s2 i1 i2 x) = do
1123 return $ Yield x (ICALFirstInner s1 s2 i1 i2)
1126-- > intercalateSuffix unf seed str = gintercalateSuffix unf str unf (repeatM seed)
1128-- | 'intersperseMSuffix' followed by unfold and concat.
1130-- >>> intercalateSuffix u a = Stream.unfoldMany u . Stream.intersperseMSuffix a
1131-- >>> intersperseMSuffix = Stream.intercalateSuffix Unfold.identity
1132-- >>> unlines = Stream.intercalateSuffix Unfold.fromList "\n"
1134-- >>> input = Stream.fromList ["abc", "def", "ghi"]
1135-- >>> Stream.fold Fold.toList $ Stream.intercalateSuffix Unfold.fromList "\n" input
1138{-# INLINE intercalateSuffix #-}
1139intercalateSuffix :: Monad m
1140 => Unfold m b c -> b -> Stream m b -> Stream m c
1141intercalateSuffix unf seed = unfoldMany unf . intersperseMSuffix (return seed)
1143-- > intercalate unf seed str = gintercalate unf str unf (repeatM seed)
1145-- | 'intersperse' followed by unfold and concat.
1147-- >>> intercalate u a = Stream.unfoldMany u . Stream.intersperse a
1148-- >>> intersperse = Stream.intercalate Unfold.identity
1149-- >>> unwords = Stream.intercalate Unfold.fromList " "
1151-- >>> input = Stream.fromList ["abc", "def", "ghi"]
1152-- >>> Stream.fold Fold.toList $ Stream.intercalate Unfold.fromList " " input
1155{-# INLINE intercalate #-}
1156intercalate :: Monad m
1157 => Unfold m b c -> b -> Stream m b -> Stream m c
1158intercalate unf seed str = unfoldMany unf $ intersperse seed str
1160------------------------------------------------------------------------------
1162------------------------------------------------------------------------------
1164-- | Apply a stream of folds to an input stream and emit the results in the
1169{-# INLINE foldSequence #-}
1172 Stream m (Fold m a b)
1175foldSequence _f _m = undefined
1177{-# ANN type FIterState Fuse #-}
1178data FIterState s f m a b
1180 | forall fs. FIterStream s (fs -> a -> m (FL.Step fs b)) fs (fs -> m b)
1182 | FIterYield b (FIterState s f m a b)
1185-- | Iterate a fold generator on a stream. The initial value @b@ is used to
1186-- generate the first fold, the fold is applied on the stream and the result of
1187-- the fold is used to generate the next fold and so on.
1189-- >>> import Data.Monoid (Sum(..))
1190-- >>> f x = return (Fold.take 2 (Fold.sconcat x))
1191-- >>> s = fmap Sum $ Stream.fromList [1..10]
1192-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.foldIterateM f (pure 0) s
1193-- [3,10,21,36,55,55]
1195-- This is the streaming equivalent of monad like sequenced application of
1196-- folds where next fold is dependent on the previous fold.
1200{-# INLINE_NORMAL foldIterateM #-}
1202 Monad m => (b -> m (FL.Fold m a b)) -> m b -> Stream m a -> Stream m b
1203foldIterateM func seed0 (Stream step state) =
1204 Stream stepOuter (FIterInit state seed0)
1208 {-# INLINE iterStep #-}
1209 iterStep from st fstep extract final = do
1214 FL.Partial fs -> FIterStream st fstep fs extract final
1215 FL.Done fb -> FIterYield fb $ FIterInit st (return fb)
1217 {-# INLINE_LATE stepOuter #-}
1218 stepOuter _ (FIterInit st seed) = do
1219 (FL.Fold fstep initial extract final) <- seed >>= func
1220 iterStep initial st fstep extract final
1221 stepOuter gst (FIterStream st fstep fs extract final) = do
1222 r <- step (adaptState gst) st
1225 iterStep (fstep fs x) s fstep extract final
1226 Skip s -> return $ Skip $ FIterStream s fstep fs extract final
1229 return $ Skip $ FIterYield b FIterStop
1230 stepOuter _ (FIterYield a next) = return $ Yield a next
1231 stepOuter _ FIterStop = return Stop
1233------------------------------------------------------------------------------
1235------------------------------------------------------------------------------
1237{-# ANN type ParseChunksState Fuse #-}
1238data ParseChunksState x inpBuf st pst =
1239 ParseChunksInit inpBuf st
1240 | ParseChunksInitBuf inpBuf
1241 | ParseChunksInitLeftOver inpBuf
1242 | ParseChunksStream st inpBuf !pst
1243 | ParseChunksStop inpBuf !pst
1244 | ParseChunksBuf inpBuf st inpBuf !pst
1245 | ParseChunksExtract inpBuf inpBuf !pst
1246 | ParseChunksYield x (ParseChunksState x inpBuf st pst)
1248-- XXX return the remaining stream as part of the error.
1249-- XXX This is in fact parseMany1 (a la foldMany1). Do we need a parseMany as
1251{-# INLINE_NORMAL parseManyD #-}
1256 -> Stream m (Either ParseError b)
1257parseManyD (PRD.Parser pstep initial extract) (Stream step state) =
1258 Stream stepOuter (ParseChunksInit [] state)
1262 {-# INLINE_LATE stepOuter #-}
1263 -- Buffer is empty, get the first element from the stream, initialize the
1264 -- fold and then go to stream processing loop.
1265 stepOuter gst (ParseChunksInit [] st) = do
1266 r <- step (adaptState gst) st
1272 return $ Skip $ ParseChunksBuf [x] s [] ps
1274 let next = ParseChunksInit [x] s
1275 in return $ Skip $ ParseChunksYield (Right pb) next
1280 (Left (ParseError err))
1281 (ParseChunksInitLeftOver [])
1282 Skip s -> return $ Skip $ ParseChunksInit [] s
1285 -- Buffer is not empty, go to buffered processing loop
1286 stepOuter _ (ParseChunksInit src st) = do
1290 return $ Skip $ ParseChunksBuf src st [] ps
1292 let next = ParseChunksInit src st
1293 in return $ Skip $ ParseChunksYield (Right pb) next
1298 (Left (ParseError err))
1299 (ParseChunksInitLeftOver [])
1301 -- This is simplified ParseChunksInit
1302 stepOuter _ (ParseChunksInitBuf src) = do
1306 return $ Skip $ ParseChunksExtract src [] ps
1308 let next = ParseChunksInitBuf src
1309 in return $ Skip $ ParseChunksYield (Right pb) next
1314 (Left (ParseError err))
1315 (ParseChunksInitLeftOver [])
1317 -- XXX we just discard any leftover input at the end
1318 stepOuter _ (ParseChunksInitLeftOver _) = return Stop
1320 -- Buffer is empty, process elements from the stream
1321 stepOuter gst (ParseChunksStream st buf pst) = do
1322 r <- step (adaptState gst) st
1327 PR.Partial 0 pst1 ->
1328 return $ Skip $ ParseChunksStream s [] pst1
1329 PR.Partial n pst1 -> do
1330 assert (n <= length (x:buf)) (return ())
1331 let src0 = Prelude.take n (x:buf)
1332 src = Prelude.reverse src0
1333 return $ Skip $ ParseChunksBuf src s [] pst1
1334 PR.Continue 0 pst1 ->
1335 return $ Skip $ ParseChunksStream s (x:buf) pst1
1336 PR.Continue n pst1 -> do
1337 assert (n <= length (x:buf)) (return ())
1338 let (src0, buf1) = splitAt n (x:buf)
1339 src = Prelude.reverse src0
1340 return $ Skip $ ParseChunksBuf src s buf1 pst1
1343 ParseChunksYield (Right b) (ParseChunksInit [] s)
1345 assert (n <= length (x:buf)) (return ())
1346 let src = Prelude.reverse (Prelude.take n (x:buf))
1348 ParseChunksYield (Right b) (ParseChunksInit src s)
1353 (Left (ParseError err))
1354 (ParseChunksInitLeftOver [])
1355 Skip s -> return $ Skip $ ParseChunksStream s buf pst
1356 Stop -> return $ Skip $ ParseChunksStop buf pst
1358 -- go back to stream processing mode
1359 stepOuter _ (ParseChunksBuf [] s buf pst) =
1360 return $ Skip $ ParseChunksStream s buf pst
1362 -- buffered processing loop
1363 stepOuter _ (ParseChunksBuf (x:xs) s buf pst) = do
1366 PR.Partial 0 pst1 ->
1367 return $ Skip $ ParseChunksBuf xs s [] pst1
1368 PR.Partial n pst1 -> do
1369 assert (n <= length (x:buf)) (return ())
1370 let src0 = Prelude.take n (x:buf)
1371 src = Prelude.reverse src0 ++ xs
1372 return $ Skip $ ParseChunksBuf src s [] pst1
1373 PR.Continue 0 pst1 ->
1374 return $ Skip $ ParseChunksBuf xs s (x:buf) pst1
1375 PR.Continue n pst1 -> do
1376 assert (n <= length (x:buf)) (return ())
1377 let (src0, buf1) = splitAt n (x:buf)
1378 src = Prelude.reverse src0 ++ xs
1379 return $ Skip $ ParseChunksBuf src s buf1 pst1
1383 $ ParseChunksYield (Right b) (ParseChunksInit xs s)
1385 assert (n <= length (x:buf)) (return ())
1386 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1388 $ ParseChunksYield (Right b) (ParseChunksInit src s)
1393 (Left (ParseError err))
1394 (ParseChunksInitLeftOver [])
1396 -- This is simplified ParseChunksBuf
1397 stepOuter _ (ParseChunksExtract [] buf pst) =
1398 return $ Skip $ ParseChunksStop buf pst
1400 stepOuter _ (ParseChunksExtract (x:xs) buf pst) = do
1403 PR.Partial 0 pst1 ->
1404 return $ Skip $ ParseChunksExtract xs [] pst1
1405 PR.Partial n pst1 -> do
1406 assert (n <= length (x:buf)) (return ())
1407 let src0 = Prelude.take n (x:buf)
1408 src = Prelude.reverse src0 ++ xs
1409 return $ Skip $ ParseChunksExtract src [] pst1
1410 PR.Continue 0 pst1 ->
1411 return $ Skip $ ParseChunksExtract xs (x:buf) pst1
1412 PR.Continue n pst1 -> do
1413 assert (n <= length (x:buf)) (return ())
1414 let (src0, buf1) = splitAt n (x:buf)
1415 src = Prelude.reverse src0 ++ xs
1416 return $ Skip $ ParseChunksExtract src buf1 pst1
1420 $ ParseChunksYield (Right b) (ParseChunksInitBuf xs)
1422 assert (n <= length (x:buf)) (return ())
1423 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1426 $ ParseChunksYield (Right b) (ParseChunksInitBuf src)
1431 (Left (ParseError err))
1432 (ParseChunksInitLeftOver [])
1434 -- This is simplified ParseChunksExtract
1435 stepOuter _ (ParseChunksStop buf pst) = do
1438 PR.Partial _ _ -> error "Bug: parseMany: Partial in extract"
1439 PR.Continue 0 pst1 ->
1440 return $ Skip $ ParseChunksStop buf pst1
1441 PR.Continue n pst1 -> do
1442 assert (n <= length buf) (return ())
1443 let (src0, buf1) = splitAt n buf
1444 src = Prelude.reverse src0
1445 return $ Skip $ ParseChunksExtract src buf1 pst1
1448 ParseChunksYield (Right b) (ParseChunksInitLeftOver [])
1450 assert (n <= length buf) (return ())
1451 let src = Prelude.reverse (Prelude.take n buf)
1453 ParseChunksYield (Right b) (ParseChunksInitBuf src)
1458 (Left (ParseError err))
1459 (ParseChunksInitLeftOver [])
1461 stepOuter _ (ParseChunksYield a next) = return $ Yield a next
1463-- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the
1468-- >>> s = Stream.fromList [1..10]
1469-- >>> parser = Parser.takeBetween 0 2 Fold.sum
1470-- >>> Stream.fold Fold.toList $ Stream.parseMany parser s
1471-- [Right 3,Right 7,Right 11,Right 15,Right 19]
1473-- This is the streaming equivalent of the 'Streamly.Data.Parser.many' parse
1476-- Known Issues: When the parser fails there is no way to get the remaining
1479{-# INLINE parseMany #-}
1484 -> Stream m (Either ParseError b)
1485parseMany = parseManyD
1487-- | Apply a stream of parsers to an input stream and emit the results in the
1492{-# INLINE parseSequence #-}
1495 Stream m (PR.Parser a m b)
1498parseSequence _f _m = undefined
1500-- XXX Change the parser arguments' order
1502-- | @parseManyTill collect test stream@ tries the parser @test@ on the input,
1503-- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds
1504-- @test@ is tried again and so on. The parser stops when @test@ succeeds. The
1505-- output of @test@ is discarded and the output of @collect@ is emitted in the
1506-- output stream. The parser fails if @collect@ fails.
1510{-# INLINE parseManyTill #-}
1517parseManyTill = undefined
1519{-# ANN type ConcatParseState Fuse #-}
1520data ConcatParseState c b inpBuf st p m a =
1521 ConcatParseInit inpBuf st p
1522 | ConcatParseInitBuf inpBuf p
1523 | ConcatParseInitLeftOver inpBuf
1524 | forall s. ConcatParseStop
1525 inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1526 | forall s. ConcatParseStream
1527 st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1528 | forall s. ConcatParseBuf
1529 inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1530 | forall s. ConcatParseExtract
1531 inpBuf inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))
1532 | ConcatParseYield c (ConcatParseState c b inpBuf st p m a)
1534-- XXX Review the changes
1535{-# INLINE_NORMAL parseIterateD #-}
1538 => (b -> PRD.Parser a m b)
1541 -> Stream m (Either ParseError b)
1542parseIterateD func seed (Stream step state) =
1543 Stream stepOuter (ConcatParseInit [] state (func seed))
1547 {-# INLINE_LATE stepOuter #-}
1548 -- Buffer is empty, go to stream processing loop
1549 stepOuter _ (ConcatParseInit [] st (PRD.Parser pstep initial extract)) = do
1553 return $ Skip $ ConcatParseStream st [] pstep ps extract
1555 let next = ConcatParseInit [] st (func pb)
1556 in return $ Skip $ ConcatParseYield (Right pb) next
1561 (Left (ParseError err))
1562 (ConcatParseInitLeftOver [])
1564 -- Buffer is not empty, go to buffered processing loop
1565 stepOuter _ (ConcatParseInit src st
1566 (PRD.Parser pstep initial extract)) = do
1570 return $ Skip $ ConcatParseBuf src st [] pstep ps extract
1572 let next = ConcatParseInit src st (func pb)
1573 in return $ Skip $ ConcatParseYield (Right pb) next
1578 (Left (ParseError err))
1579 (ConcatParseInitLeftOver [])
1581 -- This is simplified ConcatParseInit
1582 stepOuter _ (ConcatParseInitBuf src
1583 (PRD.Parser pstep initial extract)) = do
1587 return $ Skip $ ConcatParseExtract src [] pstep ps extract
1589 let next = ConcatParseInitBuf src (func pb)
1590 in return $ Skip $ ConcatParseYield (Right pb) next
1595 (Left (ParseError err))
1596 (ConcatParseInitLeftOver [])
1598 -- XXX we just discard any leftover input at the end
1599 stepOuter _ (ConcatParseInitLeftOver _) = return Stop
1601 -- Buffer is empty process elements from the stream
1602 stepOuter gst (ConcatParseStream st buf pstep pst extract) = do
1603 r <- step (adaptState gst) st
1608 PR.Partial 0 pst1 ->
1609 return $ Skip $ ConcatParseStream s [] pstep pst1 extract
1610 PR.Partial n pst1 -> do
1611 assert (n <= length (x:buf)) (return ())
1612 let src0 = Prelude.take n (x:buf)
1613 src = Prelude.reverse src0
1614 return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract
1615 -- PR.Continue 0 pst1 ->
1616 -- return $ Skip $ ConcatParseStream s (x:buf) pst1
1617 PR.Continue n pst1 -> do
1618 assert (n <= length (x:buf)) (return ())
1619 let (src0, buf1) = splitAt n (x:buf)
1620 src = Prelude.reverse src0
1621 return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract
1622 -- XXX Specialize for Stop 0 common case?
1624 assert (n <= length (x:buf)) (return ())
1625 let src = Prelude.reverse (Prelude.take n (x:buf))
1627 ConcatParseYield (Right b) (ConcatParseInit src s (func b))
1632 (Left (ParseError err))
1633 (ConcatParseInitLeftOver [])
1634 Skip s -> return $ Skip $ ConcatParseStream s buf pstep pst extract
1635 Stop -> return $ Skip $ ConcatParseStop buf pstep pst extract
1637 -- go back to stream processing mode
1638 stepOuter _ (ConcatParseBuf [] s buf pstep ps extract) =
1639 return $ Skip $ ConcatParseStream s buf pstep ps extract
1641 -- buffered processing loop
1642 stepOuter _ (ConcatParseBuf (x:xs) s buf pstep pst extract) = do
1645 PR.Partial 0 pst1 ->
1646 return $ Skip $ ConcatParseBuf xs s [] pstep pst1 extract
1647 PR.Partial n pst1 -> do
1648 assert (n <= length (x:buf)) (return ())
1649 let src0 = Prelude.take n (x:buf)
1650 src = Prelude.reverse src0 ++ xs
1651 return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract
1652 -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1
1653 PR.Continue n pst1 -> do
1654 assert (n <= length (x:buf)) (return ())
1655 let (src0, buf1) = splitAt n (x:buf)
1656 src = Prelude.reverse src0 ++ xs
1657 return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract
1658 -- XXX Specialize for Stop 0 common case?
1660 assert (n <= length (x:buf)) (return ())
1661 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1662 return $ Skip $ ConcatParseYield (Right b)
1663 (ConcatParseInit src s (func b))
1668 (Left (ParseError err))
1669 (ConcatParseInitLeftOver [])
1671 -- This is simplified ConcatParseBuf
1672 stepOuter _ (ConcatParseExtract [] buf pstep pst extract) =
1673 return $ Skip $ ConcatParseStop buf pstep pst extract
1675 stepOuter _ (ConcatParseExtract (x:xs) buf pstep pst extract) = do
1678 PR.Partial 0 pst1 ->
1679 return $ Skip $ ConcatParseExtract xs [] pstep pst1 extract
1680 PR.Partial n pst1 -> do
1681 assert (n <= length (x:buf)) (return ())
1682 let src0 = Prelude.take n (x:buf)
1683 src = Prelude.reverse src0 ++ xs
1684 return $ Skip $ ConcatParseExtract src [] pstep pst1 extract
1685 PR.Continue 0 pst1 ->
1686 return $ Skip $ ConcatParseExtract xs (x:buf) pstep pst1 extract
1687 PR.Continue n pst1 -> do
1688 assert (n <= length (x:buf)) (return ())
1689 let (src0, buf1) = splitAt n (x:buf)
1690 src = Prelude.reverse src0 ++ xs
1691 return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract
1693 return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf xs (func b))
1695 assert (n <= length (x:buf)) (return ())
1696 let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs
1697 return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))
1702 (Left (ParseError err))
1703 (ConcatParseInitLeftOver [])
1705 -- This is simplified ConcatParseExtract
1706 stepOuter _ (ConcatParseStop buf pstep pst extract) = do
1709 PR.Partial _ _ -> error "Bug: parseIterate: Partial in extract"
1710 PR.Continue 0 pst1 ->
1711 return $ Skip $ ConcatParseStop buf pstep pst1 extract
1712 PR.Continue n pst1 -> do
1713 assert (n <= length buf) (return ())
1714 let (src0, buf1) = splitAt n buf
1715 src = Prelude.reverse src0
1716 return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract
1719 ConcatParseYield (Right b) (ConcatParseInitLeftOver [])
1721 assert (n <= length buf) (return ())
1722 let src = Prelude.reverse (Prelude.take n buf)
1724 ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))
1729 (Left (ParseError err))
1730 (ConcatParseInitLeftOver [])
1732 stepOuter _ (ConcatParseYield a next) = return $ Yield a next
1734-- | Iterate a parser generating function on a stream. The initial value @b@ is
1735-- used to generate the first parser, the parser is applied on the stream and
1736-- the result is used to generate the next parser and so on.
1738-- >>> import Data.Monoid (Sum(..))
1739-- >>> s = Stream.fromList [1..10]
1740-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.catRights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum s
1741-- [3,10,21,36,55,55]
1743-- This is the streaming equivalent of monad like sequenced application of
1744-- parsers where next parser is dependent on the previous parser.
1748{-# INLINE parseIterate #-}
1751 => (b -> PR.Parser a m b)
1754 -> Stream m (Either ParseError b)
1755parseIterate = parseIterateD
1757------------------------------------------------------------------------------
1759------------------------------------------------------------------------------
1761data GroupByState st fs a b
1764 | GroupingInitWith st !a
1765 | GroupingDoWith st !fs !a
1766 | GroupingYield !b (GroupByState st fs a b)
1769-- | The argument order of the comparison function in `groupsWhile` is
1770-- different than that of `groupsBy`.
1772-- In `groupsBy` the comparison function takes the next element as the first
1773-- argument and the previous element as the second argument. In `groupsWhile`
1774-- the first argument is the previous element and second argument is the next
1776{-# INLINE_NORMAL groupsWhile #-}
1777groupsWhile :: Monad m
1783groupsWhile eq fld = parseMany (PRD.groupBy eq fld)
1785groupsWhile cmp (Fold fstep initial _ final) (Stream step state) =
1786 Stream stepOuter (GroupingInit state)
1790 {-# INLINE_LATE stepOuter #-}
1791 stepOuter _ (GroupingInit st) = do
1792 -- XXX Note that if the stream stops without yielding a single element
1793 -- in the group we discard the "initial" effect.
1797 FL.Partial s -> Skip $ GroupingDo st s
1798 FL.Done b -> Yield b $ GroupingInit st
1799 stepOuter gst (GroupingDo st fs) = do
1800 res <- step (adaptState gst) st
1805 FL.Partial fs1 -> go SPEC x s fs1
1806 FL.Done b -> return $ Yield b (GroupingInit s)
1807 Skip s -> return $ Skip $ GroupingDo s fs
1808 Stop -> final fs >> return Stop
1812 go !_ prev stt !acc = do
1813 res <- step (adaptState gst) stt
1820 FL.Partial fs1 -> go SPEC prev s fs1
1821 FL.Done b -> return $ Yield b (GroupingInit s)
1824 return $ Yield r (GroupingInitWith s x)
1825 Skip s -> go SPEC prev s acc
1828 return $ Yield r GroupingDone
1829 stepOuter _ (GroupingInitWith st x) = do
1833 FL.Partial s -> Skip $ GroupingDoWith st s x
1834 FL.Done b -> Yield b $ GroupingInitWith st x
1835 stepOuter gst (GroupingDoWith st fs prev) = do
1836 res <- fstep fs prev
1838 FL.Partial fs1 -> go SPEC st fs1
1839 FL.Done b -> return $ Yield b (GroupingInit st)
1843 -- XXX code duplicated from the previous equation
1845 res <- step (adaptState gst) stt
1852 FL.Partial fs1 -> go SPEC s fs1
1853 FL.Done b -> return $ Yield b (GroupingInit s)
1856 return $ Yield r (GroupingInitWith s x)
1857 Skip s -> go SPEC s acc
1860 return $ Yield r GroupingDone
1861 stepOuter _ (GroupingYield _ _) = error "groupsWhile: Unreachable"
1862 stepOuter _ GroupingDone = return Stop
1864{-# DEPRECATED groupsBy "Please use groupsWhile instead. Please note the change in the argument order of the comparison function." #-}
1865{-# INLINE_NORMAL groupsBy #-}
1871groupsBy cmp = groupsWhile (flip cmp)
1873{-# INLINE_NORMAL groupsRollingBy #-}
1874groupsRollingBy :: Monad m
1880groupsRollingBy eq fld = parseMany (PRD.groupByRolling eq fld)
1882groupsRollingBy cmp (Fold fstep initial _ final) (Stream step state) =
1883 Stream stepOuter (GroupingInit state)
1887 {-# INLINE_LATE stepOuter #-}
1888 stepOuter _ (GroupingInit st) = do
1889 -- XXX Note that if the stream stops without yielding a single element
1890 -- in the group we discard the "initial" effect.
1894 FL.Partial fs -> Skip $ GroupingDo st fs
1895 FL.Done fb -> Yield fb $ GroupingInit st
1896 stepOuter gst (GroupingDo st fs) = do
1897 res <- step (adaptState gst) st
1902 FL.Partial fs1 -> go SPEC x s fs1
1903 FL.Done fb -> return $ Yield fb (GroupingInit s)
1904 Skip s -> return $ Skip $ GroupingDo s fs
1905 Stop -> final fs >> return Stop
1909 go !_ prev stt !acc = do
1910 res <- step (adaptState gst) stt
1917 FL.Partial fs1 -> go SPEC x s fs1
1918 FL.Done b -> return $ Yield b (GroupingInit s)
1921 return $ Yield r (GroupingInitWith s x)
1922 Skip s -> go SPEC prev s acc
1925 return $ Yield r GroupingDone
1926 stepOuter _ (GroupingInitWith st x) = do
1930 FL.Partial s -> Skip $ GroupingDoWith st s x
1931 FL.Done b -> Yield b $ GroupingInitWith st x
1932 stepOuter gst (GroupingDoWith st fs previous) = do
1933 res <- fstep fs previous
1935 FL.Partial s -> go SPEC previous st s
1936 FL.Done b -> return $ Yield b (GroupingInit st)
1940 -- XXX GHC: groupsWhile has one less parameter in this go loop and it
1941 -- fuses. However, groupsRollingBy does not fuse, removing the prev
1942 -- parameter makes it fuse. Something needs to be fixed in GHC. The
1943 -- workaround for this is noted in the comments below.
1944 go !_ prev !stt !acc = do
1945 res <- step (adaptState gst) stt
1952 FL.Partial fs1 -> go SPEC x s fs1
1953 FL.Done b -> return $ Yield b (GroupingInit st)
1957 return $ Yield r (GroupingInitWith s x)
1959 -- The code above does not let groupBy fuse. We use the
1960 -- alternative code below instead. Instead of jumping
1961 -- to GroupingInitWith state, we unroll the code of
1962 -- GroupingInitWith state here to help GHC with stream
1969 FL.Partial fsi -> GroupingDoWith s fsi x
1970 FL.Done b -> GroupingYield b (GroupingInit s)
1971 Skip s -> go SPEC prev s acc
1974 return $ Yield r GroupingDone
1975 stepOuter _ (GroupingYield r next) = return $ Yield r next
1976 stepOuter _ GroupingDone = return Stop
1978------------------------------------------------------------------------------
1979-- Splitting - by a predicate
1980------------------------------------------------------------------------------
1982data WordsByState st fs b
1986 | WordsByYield !b (WordsByState st fs b)
1988-- | Split the stream after stripping leading, trailing, and repeated separators
1989-- as per the fold supplied.
1990-- Therefore, @".a..b."@ with '.' as the separator would be parsed as
1991-- @["a","b"]@. In other words, its like parsing words from whitespace
1994{-# INLINE_NORMAL wordsBy #-}
1995wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
1996wordsBy predicate (Fold fstep initial _ final) (Stream step state) =
1997 Stream stepOuter (WordsByInit state)
2001 {-# INLINE_LATE stepOuter #-}
2002 stepOuter _ (WordsByInit st) = do
2006 FL.Partial s -> Skip $ WordsByDo st s
2007 FL.Done b -> Yield b (WordsByInit st)
2009 stepOuter gst (WordsByDo st fs) = do
2010 res <- step (adaptState gst) st
2018 FL.Partial fs1 -> Skip $ WordsByDo s fs1
2019 FL.Done b -> Yield b (WordsByInit s)
2023 FL.Partial fs1 -> go SPEC s fs1
2024 FL.Done b -> return $ Yield b (WordsByInit s)
2025 Skip s -> return $ Skip $ WordsByDo s fs
2026 Stop -> final fs >> return Stop
2031 res <- step (adaptState gst) stt
2038 return $ Yield r (WordsByInit s)
2040 -- The above code does not fuse well. Need to check why
2041 -- GHC is not able to simplify it well. Using the code
2042 -- below, instead of jumping through the WordsByInit
2043 -- state always, we directly go to WordsByDo state in
2044 -- the common case of Partial.
2050 FL.Partial fs1 -> WordsByDo s fs1
2051 FL.Done b -> WordsByYield b (WordsByInit s)
2055 FL.Partial fs1 -> go SPEC s fs1
2056 FL.Done b -> return $ Yield b (WordsByInit s)
2057 Skip s -> go SPEC s acc
2060 return $ Yield r WordsByDone
2062 stepOuter _ WordsByDone = return Stop
2064 stepOuter _ (WordsByYield b next) = return $ Yield b next
2066------------------------------------------------------------------------------
2067-- Splitting on a sequence
2068------------------------------------------------------------------------------
2070-- String search algorithms:
2071-- http://www-igm.univ-mlv.fr/~lecroq/string/index.html
2074-- TODO can we unify the splitting operations using a splitting configuration
2075-- like in the split package.
2077data SplitStyle = Infix | Suffix | Prefix deriving (Eq, Show)
2078data SplitOptions = SplitOptions
2079 { style :: SplitStyle
2080 , withSep :: Bool -- ^ keep the separators in output
2081 -- , compact :: Bool -- ^ treat multiple consecutive separators as one
2082 -- , trimHead :: Bool -- ^ drop blank at head
2083 -- , trimTail :: Bool -- ^ drop blank at tail
2087-- XXX using "fs" as the last arg in Constructors may simplify the code a bit,
2088-- because we can use the constructor directly without having to create "jump"
2090{-# ANN type SplitOnSeqState Fuse #-}
2091data SplitOnSeqState rb rh ck w fs s b x =
2093 | SplitOnSeqYield b (SplitOnSeqState rb rh ck w fs s b x)
2096 | SplitOnSeqEmpty !fs s
2098 | SplitOnSeqSingle !fs s x
2100 | SplitOnSeqWordInit !fs s
2101 | SplitOnSeqWordLoop !w s !fs
2102 | SplitOnSeqWordDone Int !fs !w
2104 | SplitOnSeqKRInit Int !fs s rb !rh
2105 | SplitOnSeqKRLoop fs s rb !rh !ck
2106 | SplitOnSeqKRCheck fs s rb !rh
2107 | SplitOnSeqKRDone Int !fs rb !rh
2109 | SplitOnSeqReinit (fs -> SplitOnSeqState rb rh ck w fs s b x)
2111{-# INLINE_NORMAL splitOnSeq #-}
2113 :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)
2118splitOnSeq patArr (Fold fstep initial _ final) (Stream step state) =
2119 Stream stepOuter SplitOnSeqInit
2123 patLen = A.length patArr
2124 maxIndex = patLen - 1
2125 elemBits = SIZE_OF(a) * 8
2127 -- For word pattern case
2129 wordMask = (1 `shiftL` (elemBits * patLen)) - 1
2132 elemMask = (1 `shiftL` elemBits) - 1
2135 wordPat = wordMask .&. A.foldl' addToWord 0 patArr
2137 addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)
2139 -- For Rabin-Karp search
2140 k = 2891336453 :: Word32
2143 addCksum cksum a = cksum * k + fromIntegral (fromEnum a)
2145 deltaCksum cksum old new =
2146 addCksum cksum new - coeff * fromIntegral (fromEnum old)
2148 -- XXX shall we use a random starting hash or 1 instead of 0?
2149 patHash = A.foldl' addCksum 0 patArr
2151 skip = return . Skip
2153 nextAfterInit nextGen stepRes =
2155 FL.Partial s -> nextGen s
2156 FL.Done b -> SplitOnSeqYield b (SplitOnSeqReinit nextGen)
2158 {-# INLINE yieldProceed #-}
2159 yieldProceed nextGen fs =
2160 initial >>= skip . SplitOnSeqYield fs . nextAfterInit nextGen
2162 {-# INLINE_LATE stepOuter #-}
2163 stepOuter _ SplitOnSeqInit = do
2168 then return $ Skip $ SplitOnSeqEmpty acc state
2171 pat <- liftIO $ A.unsafeIndexIO 0 patArr
2172 return $ Skip $ SplitOnSeqSingle acc state pat
2173 else if SIZE_OF(a) * patLen
2174 <= sizeOf (Proxy :: Proxy Word)
2175 then return $ Skip $ SplitOnSeqWordInit acc state
2177 (rb, rhead) <- liftIO $ RB.new patLen
2178 skip $ SplitOnSeqKRInit 0 acc state rb rhead
2179 FL.Done b -> skip $ SplitOnSeqYield b SplitOnSeqInit
2181 stepOuter _ (SplitOnSeqYield x next) = return $ Yield x next
2183 ---------------------------
2185 ---------------------------
2187 stepOuter _ (SplitOnSeqReinit nextGen) =
2188 initial >>= skip . nextAfterInit nextGen
2190 ---------------------------
2192 ---------------------------
2194 stepOuter gst (SplitOnSeqEmpty acc st) = do
2195 res <- step (adaptState gst) st
2201 FL.Partial acc1 -> final acc1
2202 FL.Done b -> return b
2203 let jump c = SplitOnSeqEmpty c s
2204 in yieldProceed jump b1
2205 Skip s -> skip (SplitOnSeqEmpty acc s)
2206 Stop -> final acc >> return Stop
2212 stepOuter _ SplitOnSeqDone = return Stop
2218 stepOuter gst (SplitOnSeqSingle fs st pat) = do
2219 res <- step (adaptState gst) st
2222 let jump c = SplitOnSeqSingle c s pat
2224 then final fs >>= yieldProceed jump
2228 FL.Partial fs1 -> skip $ jump fs1
2229 FL.Done b -> yieldProceed jump b
2230 Skip s -> return $ Skip $ SplitOnSeqSingle fs s pat
2233 return $ Skip $ SplitOnSeqYield r SplitOnSeqDone
2235 ---------------------------
2236 -- Short Pattern - Shift Or
2237 ---------------------------
2239 stepOuter _ (SplitOnSeqWordDone 0 fs _) = do
2241 skip $ SplitOnSeqYield r SplitOnSeqDone
2242 stepOuter _ (SplitOnSeqWordDone n fs wrd) = do
2243 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))
2244 r <- fstep fs (toEnum $ fromIntegral old)
2246 FL.Partial fs1 -> skip $ SplitOnSeqWordDone (n - 1) fs1 wrd
2248 let jump c = SplitOnSeqWordDone (n - 1) c wrd
2251 stepOuter gst (SplitOnSeqWordInit fs st0) =
2257 go !_ !idx !wrd !st = do
2258 res <- step (adaptState gst) st
2261 let wrd1 = addToWord wrd x
2264 if wrd1 .&. wordMask == wordPat
2266 let jump c = SplitOnSeqWordInit c s
2267 final fs >>= yieldProceed jump
2268 else skip $ SplitOnSeqWordLoop wrd1 s fs
2269 else go SPEC (idx + 1) wrd1 s
2270 Skip s -> go SPEC idx wrd s
2273 then skip $ SplitOnSeqWordDone idx fs wrd
2276 skip $ SplitOnSeqYield r SplitOnSeqDone
2278 stepOuter gst (SplitOnSeqWordLoop wrd0 st0 fs0) =
2279 go SPEC wrd0 st0 fs0
2284 go !_ !wrd !st !fs = do
2285 res <- step (adaptState gst) st
2288 let jump c = SplitOnSeqWordInit c s
2289 wrd1 = addToWord wrd x
2290 old = (wordMask .&. wrd)
2291 `shiftR` (elemBits * (patLen - 1))
2292 r <- fstep fs (toEnum $ fromIntegral old)
2294 FL.Partial fs1 -> do
2295 if wrd1 .&. wordMask == wordPat
2296 then final fs1 >>= yieldProceed jump
2297 else go SPEC wrd1 s fs1
2298 FL.Done b -> yieldProceed jump b
2299 Skip s -> go SPEC wrd s fs
2300 Stop -> skip $ SplitOnSeqWordDone patLen fs wrd
2302 -------------------------------
2303 -- General Pattern - Karp Rabin
2304 -------------------------------
2306 stepOuter gst (SplitOnSeqKRInit idx fs st rb rh) = do
2307 res <- step (adaptState gst) st
2310 rh1 <- liftIO $ RB.unsafeInsert rb rh x
2313 let fld = RB.unsafeFoldRing (RB.ringBound rb)
2314 let !ringHash = fld addCksum 0 rb
2315 if ringHash == patHash
2316 then skip $ SplitOnSeqKRCheck fs s rb rh1
2317 else skip $ SplitOnSeqKRLoop fs s rb rh1 ringHash
2318 else skip $ SplitOnSeqKRInit (idx + 1) fs s rb rh1
2319 Skip s -> skip $ SplitOnSeqKRInit idx fs s rb rh
2321 skip $ SplitOnSeqKRDone idx fs rb (RB.startOf rb)
2323 -- XXX The recursive "go" is more efficient than the state based recursion
2324 -- code commented out below. Perhaps its more efficient because of
2325 -- factoring out "rb" outside the loop.
2327 stepOuter gst (SplitOnSeqKRLoop fs0 st0 rb rh0 cksum0) =
2328 go SPEC fs0 st0 rh0 cksum0
2332 go !_ !fs !st !rh !cksum = do
2333 res <- step (adaptState gst) st
2336 old <- liftIO $ peek rh
2337 let cksum1 = deltaCksum cksum old x
2340 FL.Partial fs1 -> do
2341 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2342 if cksum1 == patHash
2343 then skip $ SplitOnSeqKRCheck fs1 s rb rh1
2344 else go SPEC fs1 s rh1 cksum1
2346 let rst = RB.startOf rb
2347 jump c = SplitOnSeqKRInit 0 c s rb rst
2349 Skip s -> go SPEC fs s rh cksum
2350 Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh
2352 -- XXX The following code is 5 times slower compared to the recursive loop
2353 -- based code above. Need to investigate why. One possibility is that the
2354 -- go loop above does not thread around the ring buffer (rb). This code may
2355 -- be causing the state to bloat and getting allocated on each iteration.
2356 -- We can check the cmm/asm code to confirm. If so a good GHC solution to
2357 -- such problem is needed. One way to avoid this could be to use unboxed
2360 stepOuter gst (SplitOnSeqKRLoop fs st rb rh cksum) = do
2361 res <- step (adaptState gst) st
2364 old <- liftIO $ peek rh
2365 let cksum1 = deltaCksum cksum old x
2367 if (cksum1 == patHash)
2370 skip $ SplitOnSeqYield r $ SplitOnSeqKRInit 0 s rb rh
2372 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2373 skip $ SplitOnSeqKRLoop fs1 s rb rh1 cksum1
2374 Skip s -> skip $ SplitOnSeqKRLoop fs s rb rh cksum
2375 Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh
2378 stepOuter _ (SplitOnSeqKRCheck fs st rb rh) = do
2379 if RB.unsafeEqArray rb rh patArr
2382 let rst = RB.startOf rb
2383 jump c = SplitOnSeqKRInit 0 c st rb rst
2385 else skip $ SplitOnSeqKRLoop fs st rb rh patHash
2387 stepOuter _ (SplitOnSeqKRDone 0 fs _ _) = do
2389 skip $ SplitOnSeqYield r SplitOnSeqDone
2390 stepOuter _ (SplitOnSeqKRDone n fs rb rh) = do
2391 old <- liftIO $ peek rh
2392 let rh1 = RB.advance rb rh
2395 FL.Partial fs1 -> skip $ SplitOnSeqKRDone (n - 1) fs1 rb rh1
2397 let jump c = SplitOnSeqKRDone (n - 1) c rb rh1
2400{-# ANN type SplitOnSuffixSeqState Fuse #-}
2401data SplitOnSuffixSeqState rb rh ck w fs s b x =
2402 SplitOnSuffixSeqInit
2403 | SplitOnSuffixSeqYield b (SplitOnSuffixSeqState rb rh ck w fs s b x)
2404 | SplitOnSuffixSeqDone
2406 | SplitOnSuffixSeqEmpty !fs s
2408 | SplitOnSuffixSeqSingleInit !fs s x
2409 | SplitOnSuffixSeqSingle !fs s x
2411 | SplitOnSuffixSeqWordInit !fs s
2412 | SplitOnSuffixSeqWordLoop !w s !fs
2413 | SplitOnSuffixSeqWordDone Int !fs !w
2415 | SplitOnSuffixSeqKRInit Int !fs s rb !rh
2416 | SplitOnSuffixSeqKRInit1 !fs s rb !rh
2417 | SplitOnSuffixSeqKRLoop fs s rb !rh !ck
2418 | SplitOnSuffixSeqKRCheck fs s rb !rh
2419 | SplitOnSuffixSeqKRDone Int !fs rb !rh
2421 | SplitOnSuffixSeqReinit
2422 (fs -> SplitOnSuffixSeqState rb rh ck w fs s b x)
2424{-# INLINE_NORMAL splitOnSuffixSeq #-}
2426 :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)
2432splitOnSuffixSeq withSep patArr (Fold fstep initial _ final) (Stream step state) =
2433 Stream stepOuter SplitOnSuffixSeqInit
2437 patLen = A.length patArr
2438 maxIndex = patLen - 1
2439 elemBits = SIZE_OF(a) * 8
2441 -- For word pattern case
2443 wordMask = (1 `shiftL` (elemBits * patLen)) - 1
2446 elemMask = (1 `shiftL` elemBits) - 1
2449 wordPat = wordMask .&. A.foldl' addToWord 0 patArr
2451 addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)
2453 nextAfterInit nextGen stepRes =
2455 FL.Partial s -> nextGen s
2457 SplitOnSuffixSeqYield b (SplitOnSuffixSeqReinit nextGen)
2459 {-# INLINE yieldProceed #-}
2460 yieldProceed nextGen fs =
2461 initial >>= skip . SplitOnSuffixSeqYield fs . nextAfterInit nextGen
2463 -- For single element pattern case
2464 {-# INLINE processYieldSingle #-}
2465 processYieldSingle pat x s fs = do
2466 let jump c = SplitOnSuffixSeqSingleInit c s pat
2469 r <- if withSep then fstep fs x else return $ FL.Partial fs
2472 FL.Partial fs1 -> final fs1
2473 FL.Done b -> return b
2474 yieldProceed jump b1
2478 FL.Partial fs1 -> skip $ SplitOnSuffixSeqSingle fs1 s pat
2479 FL.Done b -> yieldProceed jump b
2481 -- For Rabin-Karp search
2482 k = 2891336453 :: Word32
2485 addCksum cksum a = cksum * k + fromIntegral (fromEnum a)
2487 deltaCksum cksum old new =
2488 addCksum cksum new - coeff * fromIntegral (fromEnum old)
2490 -- XXX shall we use a random starting hash or 1 instead of 0?
2491 patHash = A.foldl' addCksum 0 patArr
2493 skip = return . Skip
2495 {-# INLINE_LATE stepOuter #-}
2496 stepOuter _ SplitOnSuffixSeqInit = do
2501 then skip $ SplitOnSuffixSeqEmpty fs state
2504 pat <- liftIO $ A.unsafeIndexIO 0 patArr
2505 skip $ SplitOnSuffixSeqSingleInit fs state pat
2506 else if SIZE_OF(a) * patLen
2507 <= sizeOf (Proxy :: Proxy Word)
2508 then skip $ SplitOnSuffixSeqWordInit fs state
2510 (rb, rhead) <- liftIO $ RB.new patLen
2511 skip $ SplitOnSuffixSeqKRInit 0 fs state rb rhead
2512 FL.Done fb -> skip $ SplitOnSuffixSeqYield fb SplitOnSuffixSeqInit
2514 stepOuter _ (SplitOnSuffixSeqYield x next) = return $ Yield x next
2516 ---------------------------
2518 ---------------------------
2520 stepOuter _ (SplitOnSuffixSeqReinit nextGen) =
2521 initial >>= skip . nextAfterInit nextGen
2523 ---------------------------
2525 ---------------------------
2527 stepOuter gst (SplitOnSuffixSeqEmpty acc st) = do
2528 res <- step (adaptState gst) st
2531 let jump c = SplitOnSuffixSeqEmpty c s
2535 FL.Partial fs -> final fs
2536 FL.Done b -> return b
2537 yieldProceed jump b1
2538 Skip s -> skip (SplitOnSuffixSeqEmpty acc s)
2539 Stop -> final acc >> return Stop
2545 stepOuter _ SplitOnSuffixSeqDone = return Stop
2551 stepOuter gst (SplitOnSuffixSeqSingleInit fs st pat) = do
2552 res <- step (adaptState gst) st
2554 Yield x s -> processYieldSingle pat x s fs
2555 Skip s -> skip $ SplitOnSuffixSeqSingleInit fs s pat
2556 Stop -> final fs >> return Stop
2558 stepOuter gst (SplitOnSuffixSeqSingle fs st pat) = do
2559 res <- step (adaptState gst) st
2561 Yield x s -> processYieldSingle pat x s fs
2562 Skip s -> skip $ SplitOnSuffixSeqSingle fs s pat
2565 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2567 ---------------------------
2568 -- Short Pattern - Shift Or
2569 ---------------------------
2571 stepOuter _ (SplitOnSuffixSeqWordDone 0 fs _) = do
2573 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2574 stepOuter _ (SplitOnSuffixSeqWordDone n fs wrd) = do
2575 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))
2576 r <- fstep fs (toEnum $ fromIntegral old)
2578 FL.Partial fs1 -> skip $ SplitOnSuffixSeqWordDone (n - 1) fs1 wrd
2580 let jump c = SplitOnSuffixSeqWordDone (n - 1) c wrd
2583 stepOuter gst (SplitOnSuffixSeqWordInit fs0 st0) = do
2584 res <- step (adaptState gst) st0
2587 let wrd = addToWord 0 x
2588 r <- if withSep then fstep fs0 x else return $ FL.Partial fs0
2590 FL.Partial fs1 -> go SPEC 1 wrd s fs1
2592 let jump c = SplitOnSuffixSeqWordInit c s
2594 Skip s -> skip (SplitOnSuffixSeqWordInit fs0 s)
2595 Stop -> final fs0 >> return Stop
2600 go !_ !idx !wrd !st !fs = do
2601 res <- step (adaptState gst) st
2604 let jump c = SplitOnSuffixSeqWordInit c s
2605 let wrd1 = addToWord wrd x
2606 r <- if withSep then fstep fs x else return $ FL.Partial fs
2610 then go SPEC (idx + 1) wrd1 s fs1
2611 else if wrd1 .&. wordMask /= wordPat
2612 then skip $ SplitOnSuffixSeqWordLoop wrd1 s fs1
2613 else do final fs >>= yieldProceed jump
2614 FL.Done b -> yieldProceed jump b
2615 Skip s -> go SPEC idx wrd s fs
2616 Stop -> skip $ SplitOnSuffixSeqWordDone idx fs wrd
2618 stepOuter gst (SplitOnSuffixSeqWordLoop wrd0 st0 fs0) =
2619 go SPEC wrd0 st0 fs0
2624 go !_ !wrd !st !fs = do
2625 res <- step (adaptState gst) st
2628 let jump c = SplitOnSuffixSeqWordInit c s
2629 wrd1 = addToWord wrd x
2630 old = (wordMask .&. wrd)
2631 `shiftR` (elemBits * (patLen - 1))
2635 else fstep fs (toEnum $ fromIntegral old)
2638 if wrd1 .&. wordMask == wordPat
2639 then final fs1 >>= yieldProceed jump
2640 else go SPEC wrd1 s fs1
2641 FL.Done b -> yieldProceed jump b
2642 Skip s -> go SPEC wrd s fs
2644 if wrd .&. wordMask == wordPat
2645 then final fs >> return Stop
2649 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2650 else skip $ SplitOnSuffixSeqWordDone patLen fs wrd
2652 -------------------------------
2653 -- General Pattern - Karp Rabin
2654 -------------------------------
2656 stepOuter gst (SplitOnSuffixSeqKRInit idx0 fs st0 rb rh0) = do
2657 res <- step (adaptState gst) st0
2660 rh1 <- liftIO $ RB.unsafeInsert rb rh0 x
2661 r <- if withSep then fstep fs x else return $ FL.Partial fs
2664 skip $ SplitOnSuffixSeqKRInit1 fs1 s rb rh1
2666 let rst = RB.startOf rb
2667 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst
2669 Skip s -> skip $ SplitOnSuffixSeqKRInit idx0 fs s rb rh0
2670 Stop -> final fs >> return Stop
2672 stepOuter gst (SplitOnSuffixSeqKRInit1 fs0 st0 rb rh0) = do
2673 go SPEC 1 rh0 st0 fs0
2677 go !_ !idx !rh st !fs = do
2678 res <- step (adaptState gst) st
2681 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2682 r <- if withSep then fstep fs x else return $ FL.Partial fs
2686 then go SPEC (idx + 1) rh1 s fs1
2688 let fld = RB.unsafeFoldRing (RB.ringBound rb)
2689 !ringHash = fld addCksum 0 rb
2690 in if ringHash == patHash
2691 then SplitOnSuffixSeqKRCheck fs1 s rb rh1
2692 else SplitOnSuffixSeqKRLoop
2693 fs1 s rb rh1 ringHash
2695 let rst = RB.startOf rb
2696 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst
2698 Skip s -> go SPEC idx rh s fs
2700 -- do not issue a blank segment when we end at pattern
2701 if (idx == maxIndex) && RB.unsafeEqArray rb rh patArr
2702 then final fs >> return Stop
2706 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2707 else skip $ SplitOnSuffixSeqKRDone idx fs rb (RB.startOf rb)
2709 stepOuter gst (SplitOnSuffixSeqKRLoop fs0 st0 rb rh0 cksum0) =
2710 go SPEC fs0 st0 rh0 cksum0
2714 go !_ !fs !st !rh !cksum = do
2715 res <- step (adaptState gst) st
2718 old <- liftIO $ peek rh
2719 rh1 <- liftIO (RB.unsafeInsert rb rh x)
2720 let cksum1 = deltaCksum cksum old x
2721 r <- if withSep then fstep fs x else fstep fs old
2724 if cksum1 /= patHash
2725 then go SPEC fs1 s rh1 cksum1
2726 else skip $ SplitOnSuffixSeqKRCheck fs1 s rb rh1
2728 let rst = RB.startOf rb
2729 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst
2731 Skip s -> go SPEC fs s rh cksum
2733 if RB.unsafeEqArray rb rh patArr
2734 then final fs >> return Stop
2738 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2739 else skip $ SplitOnSuffixSeqKRDone patLen fs rb rh
2741 stepOuter _ (SplitOnSuffixSeqKRCheck fs st rb rh) = do
2742 if RB.unsafeEqArray rb rh patArr
2745 let rst = RB.startOf rb
2746 jump c = SplitOnSuffixSeqKRInit 0 c st rb rst
2748 else skip $ SplitOnSuffixSeqKRLoop fs st rb rh patHash
2750 stepOuter _ (SplitOnSuffixSeqKRDone 0 fs _ _) = do
2752 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone
2753 stepOuter _ (SplitOnSuffixSeqKRDone n fs rb rh) = do
2754 old <- liftIO $ peek rh
2755 let rh1 = RB.advance rb rh
2758 FL.Partial fs1 -> skip $ SplitOnSuffixSeqKRDone (n - 1) fs1 rb rh1
2760 let jump c = SplitOnSuffixSeqKRDone (n - 1) c rb rh1
2763-- Implement this as a fold or a parser instead.
2764-- This can be implemented easily using Rabin Karp
2765-- | Split post any one of the given patterns.
2768{-# INLINE splitOnSuffixSeqAny #-}
2769splitOnSuffixSeqAny :: -- (Monad m, Unboxed a, Integral a) =>
2770 [Array a] -> Fold m a b -> Stream m a -> Stream m b
2771splitOnSuffixSeqAny _subseq _f _m = undefined
2772 -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m)
2774-- | Split on a prefixed separator element, dropping the separator. The
2775-- supplied 'Fold' is applied on the split segments.
2778-- > splitOnPrefix' p xs = Stream.toList $ Stream.splitOnPrefix p (Fold.toList) (Stream.fromList xs)
2779-- > splitOnPrefix' (== '.') ".a.b"
2783-- An empty stream results in an empty output stream:
2785-- > splitOnPrefix' (== '.') ""
2789-- An empty segment consisting of only a prefix is folded to the default output
2793-- > splitOnPrefix' (== '.') "."
2796-- > splitOnPrefix' (== '.') ".a.b."
2799-- > splitOnPrefix' (== '.') ".a..b"
2804-- A prefix is optional at the beginning of the stream:
2807-- > splitOnPrefix' (== '.') "a"
2810-- > splitOnPrefix' (== '.') "a.b"
2814-- 'splitOnPrefix' is an inverse of 'intercalatePrefix' with a single element:
2816-- > Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList . Stream.splitOnPrefix (== '.') Fold.toList === id
2818-- Assuming the input stream does not contain the separator:
2820-- > Stream.splitOnPrefix (== '.') Fold.toList . Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList === id
2823{-# INLINE splitOnPrefix #-}
2824splitOnPrefix :: -- (IsStream t, MonadCatch m) =>
2825 (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
2826splitOnPrefix _predicate _f = undefined
2827 -- parseMany (Parser.sliceBeginBy predicate f)
2829-- Int list examples for splitOn:
2831-- >>> splitList [] [1,2,3,3,4]
2832-- > [[1],[2],[3],[3],[4]]
2834-- >>> splitList [5] [1,2,3,3,4]
2837-- >>> splitList [1] [1,2,3,3,4]
2840-- >>> splitList [4] [1,2,3,3,4]
2843-- >>> splitList [2] [1,2,3,3,4]
2846-- >>> splitList [3] [1,2,3,3,4]
2849-- >>> splitList [3,3] [1,2,3,3,4]
2852-- >>> splitList [1,2,3,3,4] [1,2,3,3,4]
2855-- This can be implemented easily using Rabin Karp
2856-- | Split on any one of the given patterns.
2860{-# INLINE splitOnAny #-}
2861splitOnAny :: -- (Monad m, Unboxed a, Integral a) =>
2862 [Array a] -> Fold m a b -> Stream m a -> Stream m b
2863splitOnAny _subseq _f _m =
2864 undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m)
2866------------------------------------------------------------------------------
2867-- Nested Container Transformation
2868------------------------------------------------------------------------------
2870{-# ANN type SplitState Fuse #-}
2871data SplitState s arr
2873 | SplitBuffering s arr
2874 | SplitSplitting s arr
2875 | SplitYielding arr (SplitState s arr)
2878-- XXX An alternative approach would be to use a partial fold (Fold m a b) to
2879-- split using a splitBy like combinator. The Fold would consume upto the
2880-- separator and return any leftover which can then be fed to the next fold.
2882-- We can revisit this once we have partial folds/parsers.
2884-- | Performs infix separator style splitting.
2885{-# INLINE_NORMAL splitInnerBy #-}
2888 => (f a -> m (f a, Maybe (f a))) -- splitter
2889 -> (f a -> f a -> m (f a)) -- joiner
2892splitInnerBy splitter joiner (Stream step1 state1) =
2893 Stream step (SplitInitial state1)
2897 {-# INLINE_LATE step #-}
2898 step gst (SplitInitial st) = do
2902 (x1, mx2) <- splitter x
2903 return $ case mx2 of
2904 Nothing -> Skip (SplitBuffering s x1)
2905 Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))
2906 Skip s -> return $ Skip (SplitInitial s)
2909 step gst (SplitBuffering st buf) = do
2913 (x1, mx2) <- splitter x
2914 buf' <- joiner buf x1
2915 return $ case mx2 of
2916 Nothing -> Skip (SplitBuffering s buf')
2917 Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))
2918 Skip s -> return $ Skip (SplitBuffering s buf)
2919 Stop -> return $ Skip (SplitYielding buf SplitFinishing)
2921 step _ (SplitSplitting st buf) = do
2922 (x1, mx2) <- splitter buf
2923 return $ case mx2 of
2924 Nothing -> Skip $ SplitBuffering st x1
2925 Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)
2927 step _ (SplitYielding x next) = return $ Yield x next
2928 step _ SplitFinishing = return Stop
2930-- | Performs infix separator style splitting.
2931{-# INLINE_NORMAL splitInnerBySuffix #-}
2934 => (f a -> Bool) -- isEmpty?
2935 -> (f a -> m (f a, Maybe (f a))) -- splitter
2936 -> (f a -> f a -> m (f a)) -- joiner
2939splitInnerBySuffix isEmpty splitter joiner (Stream step1 state1) =
2940 Stream step (SplitInitial state1)
2944 {-# INLINE_LATE step #-}
2945 step gst (SplitInitial st) = do
2949 (x1, mx2) <- splitter x
2950 return $ case mx2 of
2951 Nothing -> Skip (SplitBuffering s x1)
2952 Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))
2953 Skip s -> return $ Skip (SplitInitial s)
2956 step gst (SplitBuffering st buf) = do
2960 (x1, mx2) <- splitter x
2961 buf' <- joiner buf x1
2962 return $ case mx2 of
2963 Nothing -> Skip (SplitBuffering s buf')
2964 Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))
2965 Skip s -> return $ Skip (SplitBuffering s buf)
2970 else Skip (SplitYielding buf SplitFinishing)
2972 step _ (SplitSplitting st buf) = do
2973 (x1, mx2) <- splitter buf
2974 return $ case mx2 of
2975 Nothing -> Skip $ SplitBuffering st x1
2976 Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)
2978 step _ (SplitYielding x next) = return $ Yield x next
2979 step _ SplitFinishing = return Stop
2981------------------------------------------------------------------------------
2983------------------------------------------------------------------------------
2985-- | Drop prefix from the input stream if present.
2989-- See also stripPrefix.
2992{-# INLINE dropPrefix #-}
2994 -- (Monad m, Eq a) =>
2995 Stream m a -> Stream m a -> Stream m a
2996dropPrefix = error "Not implemented yet!"
2998-- | Drop all matching infix from the input stream if present. Infix stream
2999-- may be consumed multiple times.
3001-- Space: @O(n)@ where n is the length of the infix.
3003-- See also stripInfix.
3006{-# INLINE dropInfix #-}
3008 -- (Monad m, Eq a) =>
3009 Stream m a -> Stream m a -> Stream m a
3010dropInfix = error "Not implemented yet!"
3012-- | Drop suffix from the input stream if present. Suffix stream may be
3013-- consumed multiple times.
3015-- Space: @O(n)@ where n is the length of the suffix.
3017-- See also stripSuffix.
3020{-# INLINE dropSuffix #-}
3022 -- (Monad m, Eq a) =>
3023 Stream m a -> Stream m a -> Stream m a
3024dropSuffix = 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