@@ -16,2583 +16,20 @@ module Streamly.Internal.Data.Fold
1616 -- * Imports
1717 -- $setup
1818
19− -- * Fold Type
20− Step (..)
21− , Fold (..)
22− , Tee (..)
23−
24− -- * Constructors
25− -- | Which constructor to use?
26− --
27− -- * @foldl*@: If the fold never terminates i.e. does not use the 'Done'
28− -- constructor otherwise use the @foldt*@ variants.
29− -- * @*M@: Use the @M@ suffix variants if any of the step, initial, or
30− -- extract function is monadic, otherwise use the pure variants.
31− --
32− , foldl'
33− , foldlM'
34− , foldl1'
35− , foldlM1'
36− , foldt'
37− , foldtM'
38− , foldr'
39− , foldrM'
40−
41− -- * Mappers
42− -- | Monadic functions useful with mapM/lmapM on folds or streams.
43− , tracing
44− , trace
45−
46− -- * Folds
47−
48− -- ** Accumulators
49− -- *** Semigroups and Monoids
50− , sconcat
51− , mconcat
52− , foldMap
53− , foldMapM
54−
55− -- *** Reducers
56− , drain
57− , drainMapM
58− , the
59− , length
60− , lengthGeneric
61− , mean
62− , rollingHash
63− , defaultSalt
64− , rollingHashWithSalt
65− , rollingHashFirstN
66− -- , rollingHashLastN
67−
68− -- *** Saturating Reducers
69− -- | 'product' terminates if it becomes 0. Other folds can theoretically
70− -- saturate on bounded types, and therefore terminate, however, they will
71− -- run forever on unbounded types like Integer/Double.
72− , sum
73− , product
74− , maximumBy
75− , maximum
76− , minimumBy
77− , minimum
78−
79− -- *** Collectors
80− -- | Avoid using these folds in scalable or performance critical
81− -- applications, they buffer all the input in GC memory which can be
82− -- detrimental to performance if the input is large.
83− , toList
84− , toListRev
85− -- $toListRev
86− , toStream
87− , toStreamRev
88− , toStreamK
89− , toStreamKRev
90− , topBy
91− , top
92− , bottomBy
93− , bottom
94−
95− -- *** Scanners
96− -- | Stateful transformation of the elements. Useful in combination with
97− -- the 'scanMaybe' combinator. For scanners the result of the fold is
98− -- usually a transformation of the current element rather than an
99− -- aggregation of all elements till now.
100− , latest
101− -- , nthLast -- using Ring array
102− , indexingWith
103− , indexing
104− , indexingRev
105− , rollingMapM
106−
107− -- *** Filters
108− -- | Useful in combination with the 'scanMaybe' combinator.
109− , filtering
110− , deleteBy
111− , uniqBy
112− , uniq
113− , repeated
114− , findIndices
115− , elemIndices
116−
117− -- ** Terminating Folds
118− -- *** Empty folds
119− -- | Folds that return a result without consuming any input.
120− , fromPure
121− , fromEffect
122− , fromRefold
123−
124− -- *** Singleton folds
125− -- | Folds that terminate after consuming exactly one input element. All
126− -- these can be implemented in terms of the 'maybe' fold.
127− , one
128− , null -- XXX not very useful and could be problematic, remove it?
129− , satisfy
130− , maybe
131−
132− -- *** Multi folds
133− -- | Terminate after consuming one or more elements.
134− , drainN
135− -- , lastN
136− -- , (!!)
137− , indexGeneric
138− , index
139− , findM
140− , find
141− , lookup
142− , findIndex
143− , elemIndex
144− , elem
145− , notElem
146− , all
147− , any
148− , and
149− , or
150−
151− -- ** Trimmers
152− -- | Useful in combination with the 'scanMaybe' combinator.
153− , taking
154− , dropping
155− , takingEndByM
156− , takingEndBy
157− , takingEndByM_
158− , takingEndBy_
159− , droppingWhileM
160− , droppingWhile
161− , prune
162−
163− -- * Running A Fold
164− , drive
165− -- , breakStream
166−
167− -- * Building Incrementally
168− , extractM
169− , reduce
170− , close
171− , isClosed
172− , snoc
173− , snocl
174− , snocM
175− , snoclM
176−
177− , addOne
178− , addStream
179−
180− -- * Combinators
181− -- ** Utilities
182− , with
183−
184− -- ** Transforming the Monad
185− , morphInner
186− , generalizeInner
187−
188− -- ** Mapping on output
189− , rmapM
190−
191− -- ** Mapping on Input
192− , transform
193− , lmap
194− --, lsequence
195− , lmapM
196−
197− -- ** Sliding Window
198− , slide2
199−
200− -- ** Scanning Input
201− , scan
202− , scanMany
203− , postscan
204− , indexed
205−
206− -- ** Zipping Input
207− , zipStreamWithM
208− , zipStream
209−
210− -- ** Filtering Input
211− , catMaybes
212− , mapMaybeM
213− , mapMaybe
214− , scanMaybe
215− , filter
216− , filterM
217− , sampleFromthen
218−
219− -- Either streams
220− , catLefts
221− , catRights
222− , catEithers
223−
224− {-
225− -- ** Insertion
226− -- | Insertion adds more elements to the stream.
227−
228− , insertBy
229− , intersperseM
230−
231− -- ** Reordering
232− , reverse
233− -}
234−
235− -- ** Trimming
236− , take
237−
238− -- By elements
239− , takeEndBy
240− , takeEndBy_
241− , takeEndBySeq
242− , takeEndBySeq_
243− {-
244− , drop
245− , dropWhile
246− , dropWhileM
247− -}
248−
249− -- ** Serial Append
250− , splitWith
251− , split_
252− -- , tail
253− -- , init
254− , splitAt -- spanN
255− -- , splitIn -- sessionN
256−
257− -- ** Parallel Distribution
258− , teeWith
259− , tee
260− , teeWithFst
261− , teeWithMin
262− , distribute
263− -- , distributeFst
264− -- , distributeMin
265−
266− -- ** Unzipping
267− , unzip
268− -- These two can be expressed using lmap/lmapM and unzip
269− , unzipWith
270− , unzipWithM
271− , unzipWithFstM
272− , unzipWithMinM
273−
274− -- ** Parallel Alternative
275− , shortest
276− , longest
277−
278− -- ** Partitioning
279− , partitionByM
280− , partitionByFstM
281− , partitionByMinM
282− , partitionBy
283− , partition
284−
285− -- ** Splitting
286− , many
287− , manyPost
288− , groupsOf
289− , chunksBetween
290− , refoldMany
291− , refoldMany1
292− , intersperseWithQuotes
293−
294− -- ** Nesting
295− , unfoldMany
296− , concatSequence
297− , concatMap
298− , duplicate
299− , refold
300−
301− -- * Deprecated
302− , foldr
303− , drainBy
304− , last
305− , head
306− , sequence
307− , mapM
308− , variance
309− , stdDev
310− , serialWith
19+ module Streamly.Internal.Data.Fold.Step
20+ , module Streamly.Internal.Data.Fold.Type
21+ , module Streamly.Internal.Data.Fold.Tee
22+ , module Streamly.Internal.Data.Fold.Combinators
23+ , module Streamly.Internal.Data.Fold.Container
24+ -- , module Streamly.Internal.Data.Fold.Window
31125 )
31226where
31327
314−#include "inline.hs"
315−#include "ArrayMacros.h"
316−
317−import Control.Monad (void)
318−import Control.Monad.IO.Class (MonadIO(..))
319−import Data.Bifunctor (first)
320−import Data.Bits (shiftL, shiftR, (.|.), (.&.))
321−import Data.Either (isLeft, isRight, fromLeft, fromRight)
322−import Data.Int (Int64)
323−import Data.Proxy (Proxy(..))
324−import Data.Word (Word32)
325−import Foreign.Storable (Storable, peek)
326−import Streamly.Internal.Data.MutArray.Type (MutArray(..))
327−import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)
328−import Streamly.Internal.Data.Pipe.Type (Pipe (..), PipeState(..))
329−import Streamly.Internal.Data.Unbox (Unbox, sizeOf)
330−import Streamly.Internal.Data.Unfold.Type (Unfold(..))
331−import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))
332−import Streamly.Internal.Data.Stream.StreamD.Type (Stream)
333−
334−import qualified Prelude
335−import qualified Streamly.Internal.Data.MutArray.Type as MA
336−import qualified Streamly.Internal.Data.Array.Type as Array
337−import qualified Streamly.Internal.Data.Fold.Window as FoldW
338−import qualified Streamly.Internal.Data.Pipe.Type as Pipe
339−import qualified Streamly.Internal.Data.Ring.Unboxed as Ring
340−import qualified Streamly.Internal.Data.Stream.StreamD.Type as StreamD
341−
342−import Prelude hiding
343− ( Foldable(..), filter, drop, dropWhile, take, takeWhile, zipWith
344− , map, mapM_, sequence, all, any
345− , notElem, head, last, tail
346− , reverse, iterate, init, and, or, lookup, (!!)
347− , scanl, scanl1, replicate, concatMap, mconcat, unzip
348− , span, splitAt, break, mapM, zip, maybe)
349−import Streamly.Internal.Data.Fold.Type
28+import Streamly.Internal.Data.Fold.Combinators
29+import Streamly.Internal.Data.Fold.Container
30+import Streamly.Internal.Data.Fold.Step
35031import Streamly.Internal.Data.Fold.Tee
32+import Streamly.Internal.Data.Fold.Type
33+-- import Streamly.Internal.Data.Fold.Window
35134
35235#include "DocTestDataFold.hs"
353−
354−------------------------------------------------------------------------------
355−-- Running
356−------------------------------------------------------------------------------
357−
358−-- | Drive a fold using the supplied 'Stream', reducing the resulting
359−-- expression strictly at each step.
360−--
361−-- Definition:
362−--
363−-- >>> drive = flip Stream.fold
364−--
365−-- Example:
366−--
367−-- >>> Fold.drive (Stream.enumerateFromTo 1 100) Fold.sum
368−-- 5050
369−--
370−{-# INLINE drive #-}
371−drive :: Monad m => Stream m a -> Fold m a b -> m b
372−drive = flip StreamD.fold
373−
374−{-
375−-- | Like 'drive' but also returns the remaining stream. The resulting stream
376−-- would be 'Stream.nil' if the stream finished before the fold.
377−--
378−-- Definition:
379−--
380−-- >>> breakStream = flip Stream.foldBreak
381−--
382−-- /CPS/
383−--
384−{-# INLINE breakStreamK #-}
385−breakStreamK :: Monad m => StreamK m a -> Fold m a b -> m (b, StreamK m a)
386−breakStreamK strm fl = fmap f $ K.foldBreak fl (Stream.toStreamK strm)
387−
388− where
389−
390− f (b, str) = (b, Stream.fromStreamK str)
391−-}
392−
393−-- | Append a stream to a fold to build the fold accumulator incrementally. We
394−-- can repeatedly call 'addStream' on the same fold to continue building the
395−-- fold and finally use 'drive' to finish the fold and extract the result. Also
396−-- see the 'Streamly.Data.Fold.addOne' operation which is a singleton version
397−-- of 'addStream'.
398−--
399−-- Definitions:
400−--
401−-- >>> addStream stream = Fold.drive stream . Fold.duplicate
402−--
403−-- Example, build a list incrementally:
404−--
405−-- >>> :{
406−-- pure (Fold.toList :: Fold IO Int [Int])
407−-- >>= Fold.addOne 1
408−-- >>= Fold.addStream (Stream.enumerateFromTo 2 4)
409−-- >>= Fold.drive Stream.nil
410−-- >>= print
411−-- :}
412−-- [1,2,3,4]
413−--
414−-- This can be used as an O(n) list append compared to the O(n^2) @++@ when
415−-- used for incrementally building a list.
416−--
417−-- Example, build a stream incrementally:
418−--
419−-- >>> :{
420−-- pure (Fold.toStream :: Fold IO Int (Stream Identity Int))
421−-- >>= Fold.addOne 1
422−-- >>= Fold.addStream (Stream.enumerateFromTo 2 4)
423−-- >>= Fold.drive Stream.nil
424−-- >>= print
425−-- :}
426−-- fromList [1,2,3,4]
427−--
428−-- This can be used as an O(n) stream append compared to the O(n^2) @<>@ when
429−-- used for incrementally building a stream.
430−--
431−-- Example, build an array incrementally:
432−--
433−-- >>> :{
434−-- pure (Array.write :: Fold IO Int (Array Int))
435−-- >>= Fold.addOne 1
436−-- >>= Fold.addStream (Stream.enumerateFromTo 2 4)
437−-- >>= Fold.drive Stream.nil
438−-- >>= print
439−-- :}
440−-- fromList [1,2,3,4]
441−--
442−-- Example, build an array stream incrementally:
443−--
444−-- >>> :{
445−-- let f :: Fold IO Int (Stream Identity (Array Int))
446−-- f = Fold.groupsOf 2 (Array.writeN 3) Fold.toStream
447−-- in pure f
448−-- >>= Fold.addOne 1
449−-- >>= Fold.addStream (Stream.enumerateFromTo 2 4)
450−-- >>= Fold.drive Stream.nil
451−-- >>= print
452−-- :}
453−-- fromList [fromList [1,2],fromList [3,4]]
454−--
455−addStream :: Monad m => Stream m a -> Fold m a b -> m (Fold m a b)
456−addStream stream = drive stream . duplicate
457−
458−------------------------------------------------------------------------------
459−-- Transformations on fold inputs
460−------------------------------------------------------------------------------
461−
462−-- | Flatten the monadic output of a fold to pure output.
463−--
464−{-# DEPRECATED sequence "Use \"rmapM id\" instead" #-}
465−{-# INLINE sequence #-}
466−sequence :: Monad m => Fold m a (m b) -> Fold m a b
467−sequence = rmapM id
468−
469−-- | Map a monadic function on the output of a fold.
470−--
471−{-# DEPRECATED mapM "Use rmapM instead" #-}
472−{-# INLINE mapM #-}
473−mapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c
474−mapM = rmapM
475−
476−-- |
477−-- >>> mapMaybeM f = Fold.lmapM f . Fold.catMaybes
478−--
479−{-# INLINE mapMaybeM #-}
480−mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Fold m b r -> Fold m a r
481−mapMaybeM f = lmapM f . catMaybes
482−
483−-- | @mapMaybe f fold@ maps a 'Maybe' returning function @f@ on the input of
484−-- the fold, filters out 'Nothing' elements, and return the values extracted
485−-- from 'Just'.
486−--
487−-- >>> mapMaybe f = Fold.lmap f . Fold.catMaybes
488−-- >>> mapMaybe f = Fold.mapMaybeM (return . f)
489−--
490−-- >>> f x = if even x then Just x else Nothing
491−-- >>> fld = Fold.mapMaybe f Fold.toList
492−-- >>> Stream.fold fld (Stream.enumerateFromTo 1 10)
493−-- [2,4,6,8,10]
494−--
495−{-# INLINE mapMaybe #-}
496−mapMaybe :: Monad m => (a -> Maybe b) -> Fold m b r -> Fold m a r
497−mapMaybe f = lmap f . catMaybes
498−
499−------------------------------------------------------------------------------
500−-- Transformations on fold inputs
501−------------------------------------------------------------------------------
502−
503−-- | Apply a monadic function on the input and return the input.
504−--
505−-- >>> Stream.fold (Fold.lmapM (Fold.tracing print) Fold.drain) $ (Stream.enumerateFromTo (1 :: Int) 2)
506−-- 1
507−-- 2
508−--
509−-- /Pre-release/
510−--
511−{-# INLINE tracing #-}
512−tracing :: Monad m => (a -> m b) -> (a -> m a)
513−tracing f x = void (f x) >> return x
514−
515−-- | Apply a monadic function to each element flowing through and discard the
516−-- results.
517−--
518−-- >>> Stream.fold (Fold.trace print Fold.drain) $ (Stream.enumerateFromTo (1 :: Int) 2)
519−-- 1
520−-- 2
521−--
522−-- >>> trace f = Fold.lmapM (Fold.tracing f)
523−--
524−-- /Pre-release/
525−{-# INLINE trace #-}
526−trace :: Monad m => (a -> m b) -> Fold m a r -> Fold m a r
527−trace f = lmapM (tracing f)
528−
529−-- rename to lpipe?
530−--
531−-- | Apply a transformation on a 'Fold' using a 'Pipe'.
532−--
533−-- /Pre-release/
534−{-# INLINE transform #-}
535−transform :: Monad m => Pipe m a b -> Fold m b c -> Fold m a c
536−transform (Pipe pstep1 pstep2 pinitial) (Fold fstep finitial fextract) =
537− Fold step initial extract
538−
539− where
540−
541− initial = first (Tuple' pinitial) <$> finitial
542−
543− step (Tuple' ps fs) x = do
544− r <- pstep1 ps x
545− go fs r
546−
547− where
548−
549− -- XXX use SPEC?
550− go acc (Pipe.Yield b (Consume ps')) = do
551− acc' <- fstep acc b
552− return
553− $ case acc' of
554− Partial s -> Partial $ Tuple' ps' s
555− Done b2 -> Done b2
556− go acc (Pipe.Yield b (Produce ps')) = do
557− acc' <- fstep acc b
558− r <- pstep2 ps'
559− case acc' of
560− Partial s -> go s r
561− Done b2 -> return $ Done b2
562− go acc (Pipe.Continue (Consume ps')) =
563− return $ Partial $ Tuple' ps' acc
564− go acc (Pipe.Continue (Produce ps')) = do
565− r <- pstep2 ps'
566− go acc r
567−
568− extract (Tuple' _ fs) = fextract fs
569−
570−{-# INLINE scanWith #-}
571−scanWith :: Monad m => Bool -> Fold m a b -> Fold m b c -> Fold m a c
572−scanWith isMany (Fold stepL initialL extractL) (Fold stepR initialR extractR) =
573− Fold step initial extract
574−
575− where
576−
577− {-# INLINE runStep #-}
578− runStep actionL sR = do
579− rL <- actionL
580− case rL of
581− Done bL -> do
582− rR <- stepR sR bL
583− case rR of
584− Partial sR1 ->
585− if isMany
586− then runStep initialL sR1
587− else Done <$> extractR sR1
588− Done bR -> return $ Done bR
589− Partial sL -> do
590− !b <- extractL sL
591− rR <- stepR sR b
592− return
593− $ case rR of
594− Partial sR1 -> Partial (sL, sR1)
595− Done bR -> Done bR
596−
597− initial = do
598− r <- initialR
599− case r of
600− Partial sR -> runStep initialL sR
601− Done b -> return $ Done b
602−
603− step (sL, sR) x = runStep (stepL sL x) sR
604−
605− extract = extractR . snd
606−
607−-- | Scan the input of a 'Fold' to change it in a stateful manner using another
608−-- 'Fold'. The scan stops as soon as the fold terminates.
609−--
610−-- /Pre-release/
611−{-# INLINE scan #-}
612−scan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c
613−scan = scanWith False
614−
615−-- XXX This does not fuse beacuse of the recursive step. Need to investigate.
616−--
617−-- | Scan the input of a 'Fold' to change it in a stateful manner using another
618−-- 'Fold'. The scan restarts with a fresh state if the fold terminates.
619−--
620−-- /Pre-release/
621−{-# INLINE scanMany #-}
622−scanMany :: Monad m => Fold m a b -> Fold m b c -> Fold m a c
623−scanMany = scanWith True
624−
625−------------------------------------------------------------------------------
626−-- Filters
627−------------------------------------------------------------------------------
628−
629−-- | Returns the latest element omitting the first occurrence that satisfies
630−-- the given equality predicate.
631−--
632−-- Example:
633−--
634−-- >>> input = Stream.fromList [1,3,3,5]
635−-- >>> Stream.fold Fold.toList $ Stream.scanMaybe (Fold.deleteBy (==) 3) input
636−-- [1,3,5]
637−--
638−{-# INLINE_NORMAL deleteBy #-}
639−deleteBy :: Monad m => (a -> a -> Bool) -> a -> Fold m a (Maybe a)
640−deleteBy eq x0 = fmap extract $ foldl' step (Tuple' False Nothing)
641−
642− where
643−
644− step (Tuple' False _) x =
645− if eq x x0
646− then Tuple' True Nothing
647− else Tuple' False (Just x)
648− step (Tuple' True _) x = Tuple' True (Just x)
649−
650− extract (Tuple' _ x) = x
651−
652−-- | Provide a sliding window of length 2 elements.
653−--
654−-- See "Streamly.Internal.Data.Fold.Window".
655−--
656−{-# INLINE slide2 #-}
657−slide2 :: Monad m => Fold m (a, Maybe a) b -> Fold m a b
658−slide2 (Fold step1 initial1 extract1) = Fold step initial extract
659−
660− where
661−
662− initial =
663− first (Tuple' Nothing) <$> initial1
664−
665− step (Tuple' prev s) cur =
666− first (Tuple' (Just cur)) <$> step1 s (cur, prev)
667−
668− extract (Tuple' _ s) = extract1 s
669−
670−-- | Return the latest unique element using the supplied comparison function.
671−-- Returns 'Nothing' if the current element is same as the last element
672−-- otherwise returns 'Just'.
673−--
674−-- Example, strip duplicate path separators:
675−--
676−-- >>> input = Stream.fromList "//a//b"
677−-- >>> f x y = x == '/' && y == '/'
678−-- >>> Stream.fold Fold.toList $ Stream.scanMaybe (Fold.uniqBy f) input
679−-- "/a/b"
680−--
681−-- Space: @O(1)@
682−--
683−-- /Pre-release/
684−--
685−{-# INLINE uniqBy #-}
686−uniqBy :: Monad m => (a -> a -> Bool) -> Fold m a (Maybe a)
687−uniqBy eq = rollingMap f
688−
689− where
690−
691− f pre curr =
692− case pre of
693− Nothing -> Just curr
694− Just x -> if x `eq` curr then Nothing else Just curr
695−
696−-- | See 'uniqBy'.
697−--
698−-- Definition:
699−--
700−-- >>> uniq = Fold.uniqBy (==)
701−--
702−{-# INLINE uniq #-}
703−uniq :: (Monad m, Eq a) => Fold m a (Maybe a)
704−uniq = uniqBy (==)
705−
706−-- | Strip all leading and trailing occurrences of an element passing a
707−-- predicate and make all other consecutive occurrences uniq.
708−--
709−-- >> prune p = Stream.dropWhileAround p $ Stream.uniqBy (x y -> p x && p y)
710−--
711−-- @
712−-- > Stream.prune isSpace (Stream.fromList " hello world! ")
713−-- "hello world!"
714−--
715−-- @
716−--
717−-- Space: @O(1)@
718−--
719−-- /Unimplemented/
720−{-# INLINE prune #-}
721−prune ::
722− -- (Monad m, Eq a) =>
723− (a -> Bool) -> Fold m a (Maybe a)
724−prune = error "Not implemented yet!"
725−
726−-- | Emit only repeated elements, once.
727−--
728−-- /Unimplemented/
729−repeated :: -- (Monad m, Eq a) =>
730− Fold m a (Maybe a)
731−repeated = error "Not implemented yet!"
732−
733−------------------------------------------------------------------------------
734−-- Left folds
735−------------------------------------------------------------------------------
736−
737−------------------------------------------------------------------------------
738−-- Run Effects
739−------------------------------------------------------------------------------
740−
741−-- |
742−-- Definitions:
743−--
744−-- >>> drainMapM f = Fold.lmapM f Fold.drain
745−-- >>> drainMapM f = Fold.foldMapM (void . f)
746−--
747−-- Drain all input after passing it through a monadic function. This is the
748−-- dual of mapM_ on stream producers.
749−--
750−{-# INLINE drainMapM #-}
751−drainMapM :: Monad m => (a -> m b) -> Fold m a ()
752−drainMapM f = lmapM f drain
753−
754−{-# DEPRECATED drainBy "Please use 'drainMapM' instead." #-}
755−{-# INLINE drainBy #-}
756−drainBy :: Monad m => (a -> m b) -> Fold m a ()
757−drainBy = drainMapM
758−
759−-- | Returns the latest element of the input stream, if any.
760−--
761−-- >>> latest = Fold.foldl1' (\_ x -> x)
762−-- >>> latest = fmap getLast $ Fold.foldMap (Last . Just)
763−--
764−{-# INLINE latest #-}
765−latest :: Monad m => Fold m a (Maybe a)
766−latest = foldl1' (\_ x -> x)
767−
768−{-# DEPRECATED last "Please use 'latest' instead." #-}
769−{-# INLINE last #-}
770−last :: Monad m => Fold m a (Maybe a)
771−last = latest
772−
773−-- | Terminates with 'Nothing' as soon as it finds an element different than
774−-- the previous one, returns 'the' element if the entire input consists of the
775−-- same element.
776−--
777−{-# INLINE the #-}
778−the :: (Monad m, Eq a) => Fold m a (Maybe a)
779−the = foldt' step initial id
780−
781− where
782−
783− initial = Partial Nothing
784−
785− step Nothing x = Partial (Just x)
786− step old@(Just x0) x =
787− if x0 == x
788− then Partial old
789− else Done Nothing
790−
791−------------------------------------------------------------------------------
792−-- To Summary
793−------------------------------------------------------------------------------
794−
795−-- | Like 'length', except with a more general 'Num' return value
796−--
797−-- Definition:
798−--
799−-- >>> lengthGeneric = fmap getSum $ Fold.foldMap (Sum . const 1)
800−-- >>> lengthGeneric = Fold.foldl' (\n _ -> n + 1) 0
801−--
802−-- /Pre-release/
803−{-# INLINE lengthGeneric #-}
804−lengthGeneric :: (Monad m, Num b) => Fold m a b
805−lengthGeneric = foldl' (\n _ -> n + 1) 0
806−
807−-- | Determine the length of the input stream.
808−--
809−-- Definition:
810−--
811−-- >>> length = Fold.lengthGeneric
812−-- >>> length = fmap getSum $ Fold.foldMap (Sum . const 1)
813−--
814−{-# INLINE length #-}
815−length :: Monad m => Fold m a Int
816−length = lengthGeneric
817−
818−
819−-- | Determine the sum of all elements of a stream of numbers. Returns additive
820−-- identity (@0@) when the stream is empty. Note that this is not numerically
821−-- stable for floating point numbers.
822−--
823−-- >>> sum = FoldW.cumulative FoldW.sum
824−--
825−-- Same as following but numerically stable:
826−--
827−-- >>> sum = Fold.foldl' (+) 0
828−-- >>> sum = fmap Data.Monoid.getSum $ Fold.foldMap Data.Monoid.Sum
829−--
830−{-# INLINE sum #-}
831−sum :: (Monad m, Num a) => Fold m a a
832−sum = FoldW.cumulative FoldW.sum
833−
834−-- | Determine the product of all elements of a stream of numbers. Returns
835−-- multiplicative identity (@1@) when the stream is empty. The fold terminates
836−-- when it encounters (@0@) in its input.
837−--
838−-- Same as the following but terminates on multiplication by @0@:
839−--
840−-- >>> product = fmap Data.Monoid.getProduct $ Fold.foldMap Data.Monoid.Product
841−--
842−{-# INLINE product #-}
843−product :: (Monad m, Num a, Eq a) => Fold m a a
844−product = foldt' step (Partial 1) id
845−
846− where
847−
848− step x a =
849− if a == 0
850− then Done 0
851− else Partial $ x * a
852−
853−------------------------------------------------------------------------------
854−-- To Summary (Maybe)
855−------------------------------------------------------------------------------
856−
857−-- | Determine the maximum element in a stream using the supplied comparison
858−-- function.
859−--
860−{-# INLINE maximumBy #-}
861−maximumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)
862−maximumBy cmp = foldl1' max'
863−
864− where
865−
866− max' x y =
867− case cmp x y of
868− GT -> x
869− _ -> y
870−
871−-- | Determine the maximum element in a stream.
872−--
873−-- Definitions:
874−--
875−-- >>> maximum = Fold.maximumBy compare
876−-- >>> maximum = Fold.foldl1' max
877−--
878−-- Same as the following but without a default maximum. The 'Max' Monoid uses
879−-- the 'minBound' as the default maximum:
880−--
881−-- >>> maximum = fmap Data.Semigroup.getMax $ Fold.foldMap Data.Semigroup.Max
882−--
883−{-# INLINE maximum #-}
884−maximum :: (Monad m, Ord a) => Fold m a (Maybe a)
885−maximum = foldl1' max
886−
887−-- | Computes the minimum element with respect to the given comparison function
888−--
889−{-# INLINE minimumBy #-}
890−minimumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)
891−minimumBy cmp = foldl1' min'
892−
893− where
894−
895− min' x y =
896− case cmp x y of
897− GT -> y
898− _ -> x
899−
900−-- | Determine the minimum element in a stream using the supplied comparison
901−-- function.
902−--
903−-- Definitions:
904−--
905−-- >>> minimum = Fold.minimumBy compare
906−-- >>> minimum = Fold.foldl1' min
907−--
908−-- Same as the following but without a default minimum. The 'Min' Monoid uses the
909−-- 'maxBound' as the default maximum:
910−--
911−-- >>> maximum = fmap Data.Semigroup.getMin $ Fold.foldMap Data.Semigroup.Min
912−--
913−{-# INLINE minimum #-}
914−minimum :: (Monad m, Ord a) => Fold m a (Maybe a)
915−minimum = foldl1' min
916−
917−------------------------------------------------------------------------------
918−-- To Summary (Statistical)
919−------------------------------------------------------------------------------
920−
921−-- | Compute a numerically stable arithmetic mean of all elements in the input
922−-- stream.
923−--
924−{-# INLINE mean #-}
925−mean :: (Monad m, Fractional a) => Fold m a a
926−mean = fmap done $ foldl' step begin
927−
928− where
929−
930− begin = Tuple' 0 0
931−
932− step (Tuple' x n) y =
933− let n1 = n + 1
934− in Tuple' (x + (y - x) / n1) n1
935−
936− done (Tuple' x _) = x
937−
938−-- | Compute a numerically stable (population) variance over all elements in
939−-- the input stream.
940−--
941−{-# DEPRECATED variance "Use the streamly-statistics package instead" #-}
942−{-# INLINE variance #-}
943−variance :: (Monad m, Fractional a) => Fold m a a
944−variance = fmap done $ foldl' step begin
945−
946− where
947−
948− begin = Tuple3' 0 0 0
949−
950− step (Tuple3' n mean_ m2) x = Tuple3' n' mean' m2'
951−
952− where
953−
954− n' = n + 1
955− mean' = (n * mean_ + x) / (n + 1)
956− delta = x - mean_
957− m2' = m2 + delta * delta * n / (n + 1)
958−
959− done (Tuple3' n _ m2) = m2 / n
960−
961−-- | Compute a numerically stable (population) standard deviation over all
962−-- elements in the input stream.
963−--
964−{-# DEPRECATED stdDev "Use the streamly-statistics package instead" #-}
965−{-# INLINE stdDev #-}
966−stdDev :: (Monad m, Floating a) => Fold m a a
967−stdDev = sqrt <$> variance
968−
969−-- | Compute an 'Int' sized polynomial rolling hash
970−--
971−-- > H = salt * k ^ n + c1 * k ^ (n - 1) + c2 * k ^ (n - 2) + ... + cn * k ^ 0
972−--
973−-- Where @c1@, @c2@, @cn@ are the elements in the input stream and @k@ is a
974−-- constant.
975−--
976−-- This hash is often used in Rabin-Karp string search algorithm.
977−--
978−-- See https://en.wikipedia.org/wiki/Rolling_hash
979−--
980−{-# INLINE rollingHashWithSalt #-}
981−rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64
982−rollingHashWithSalt = foldl' step
983−
984− where
985−
986− k = 2891336453 :: Int64
987−
988− step cksum a = cksum * k + fromIntegral (fromEnum a)
989−
990−-- | A default salt used in the implementation of 'rollingHash'.
991−{-# INLINE defaultSalt #-}
992−defaultSalt :: Int64
993−defaultSalt = -2578643520546668380
994−
995−-- | Compute an 'Int' sized polynomial rolling hash of a stream.
996−--
997−-- >>> rollingHash = Fold.rollingHashWithSalt Fold.defaultSalt
998−--
999−{-# INLINE rollingHash #-}
1000−rollingHash :: (Monad m, Enum a) => Fold m a Int64
1001−rollingHash = rollingHashWithSalt defaultSalt
1002−
1003−-- | Compute an 'Int' sized polynomial rolling hash of the first n elements of
1004−-- a stream.
1005−--
1006−-- >>> rollingHashFirstN n = Fold.take n Fold.rollingHash
1007−--
1008−-- /Pre-release/
1009−{-# INLINE rollingHashFirstN #-}
1010−rollingHashFirstN :: (Monad m, Enum a) => Int -> Fold m a Int64
1011−rollingHashFirstN n = take n rollingHash
1012−
1013−-- XXX Compare this with the implementation in Fold.Window, preferrably use the
1014−-- latter if performance is good.
1015−
1016−-- | Apply a function on every two successive elements of a stream. The first
1017−-- argument of the map function is the previous element and the second argument
1018−-- is the current element. When processing the very first element in the
1019−-- stream, the previous element is 'Nothing'.
1020−--
1021−-- /Pre-release/
1022−--
1023−{-# INLINE rollingMapM #-}
1024−rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Fold m a b
1025−rollingMapM f = Fold step initial extract
1026−
1027− where
1028−
1029− -- XXX We need just a postscan. We do not need an initial result here.
1030− -- Or we can supply a default initial result as an argument to rollingMapM.
1031− initial = return $ Partial (Nothing, error "Empty stream")
1032−
1033− step (prev, _) cur = do
1034− x <- f prev cur
1035− return $ Partial (Just cur, x)
1036−
1037− extract = return . snd
1038−
1039−-- |
1040−-- >>> rollingMap f = Fold.rollingMapM (\x y -> return $ f x y)
1041−--
1042−{-# INLINE rollingMap #-}
1043−rollingMap :: Monad m => (Maybe a -> a -> b) -> Fold m a b
1044−rollingMap f = rollingMapM (\x y -> return $ f x y)
1045−
1046−------------------------------------------------------------------------------
1047−-- Monoidal left folds
1048−------------------------------------------------------------------------------
1049−
1050−-- | Semigroup concat. Append the elements of an input stream to a provided
1051−-- starting value.
1052−--
1053−-- Definition:
1054−--
1055−-- >>> sconcat = Fold.foldl' (<>)
1056−--
1057−-- >>> semigroups = fmap Data.Monoid.Sum $ Stream.enumerateFromTo 1 10
1058−-- >>> Stream.fold (Fold.sconcat 10) semigroups
1059−-- Sum {getSum = 65}
1060−--
1061−{-# INLINE sconcat #-}
1062−sconcat :: (Monad m, Semigroup a) => a -> Fold m a a
1063−sconcat = foldl' (<>)
1064−
1065−-- | Monoid concat. Fold an input stream consisting of monoidal elements using
1066−-- 'mappend' and 'mempty'.
1067−--
1068−-- Definition:
1069−--
1070−-- >>> mconcat = Fold.sconcat mempty
1071−--
1072−-- >>> monoids = fmap Data.Monoid.Sum $ Stream.enumerateFromTo 1 10
1073−-- >>> Stream.fold Fold.mconcat monoids
1074−-- Sum {getSum = 55}
1075−--
1076−{-# INLINE mconcat #-}
1077−mconcat ::
1078− ( Monad m
1079− , Monoid a) => Fold m a a
1080−mconcat = sconcat mempty
1081−
1082−-- |
1083−-- Definition:
1084−--
1085−-- >>> foldMap f = Fold.lmap f Fold.mconcat
1086−--
1087−-- Make a fold from a pure function that folds the output of the function
1088−-- using 'mappend' and 'mempty'.
1089−--
1090−-- >>> sum = Fold.foldMap Data.Monoid.Sum
1091−-- >>> Stream.fold sum $ Stream.enumerateFromTo 1 10
1092−-- Sum {getSum = 55}
1093−--
1094−{-# INLINE foldMap #-}
1095−foldMap :: (Monad m, Monoid b) => (a -> b) -> Fold m a b
1096−foldMap f = lmap f mconcat
1097−
1098−-- |
1099−-- Definition:
1100−--
1101−-- >>> foldMapM f = Fold.lmapM f Fold.mconcat
1102−--
1103−-- Make a fold from a monadic function that folds the output of the function
1104−-- using 'mappend' and 'mempty'.
1105−--
1106−-- >>> sum = Fold.foldMapM (return . Data.Monoid.Sum)
1107−-- >>> Stream.fold sum $ Stream.enumerateFromTo 1 10
1108−-- Sum {getSum = 55}
1109−--
1110−{-# INLINE foldMapM #-}
1111−foldMapM :: (Monad m, Monoid b) => (a -> m b) -> Fold m a b
1112−foldMapM act = foldlM' step (pure mempty)
1113−
1114− where
1115−
1116− step m a = do
1117− m' <- act a
1118− return $! mappend m m'
1119−
1120−------------------------------------------------------------------------------
1121−-- To Containers
1122−------------------------------------------------------------------------------
1123−
1124−-- $toListRev
1125−-- This is more efficient than 'Streamly.Internal.Data.Fold.toList'. toList is
1126−-- exactly the same as reversing the list after 'toListRev'.
1127−
1128−-- | Buffers the input stream to a list in the reverse order of the input.
1129−--
1130−-- Definition:
1131−--
1132−-- >>> toListRev = Fold.foldl' (flip (:)) []
1133−--
1134−-- /Warning!/ working on large lists accumulated as buffers in memory could be
1135−-- very inefficient, consider using "Streamly.Array" instead.
1136−--
1137−
1138−-- xn : ... : x2 : x1 : []
1139−{-# INLINE toListRev #-}
1140−toListRev :: Monad m => Fold m a [a]
1141−toListRev = foldl' (flip (:)) []
1142−
1143−------------------------------------------------------------------------------
1144−-- Partial Folds
1145−------------------------------------------------------------------------------
1146−
1147−-- | A fold that drains the first n elements of its input, running the effects
1148−-- and discarding the results.
1149−--
1150−-- Definition:
1151−--
1152−-- >>> drainN n = Fold.take n Fold.drain
1153−--
1154−-- /Pre-release/
1155−{-# INLINE drainN #-}
1156−drainN :: Monad m => Int -> Fold m a ()
1157−drainN n = take n drain
1158−
1159−------------------------------------------------------------------------------
1160−-- To Elements
1161−------------------------------------------------------------------------------
1162−
1163−-- | Like 'index', except with a more general 'Integral' argument
1164−--
1165−-- /Pre-release/
1166−{-# INLINE indexGeneric #-}
1167−indexGeneric :: (Integral i, Monad m) => i -> Fold m a (Maybe a)
1168−indexGeneric i = foldt' step (Partial 0) (const Nothing)
1169−
1170− where
1171−
1172− step j a =
1173− if i == j
1174− then Done $ Just a
1175− else Partial (j + 1)
1176−
1177−-- | Return the element at the given index.
1178−--
1179−-- Definition:
1180−--
1181−-- >>> index = Fold.indexGeneric
1182−--
1183−{-# INLINE index #-}
1184−index :: Monad m => Int -> Fold m a (Maybe a)
1185−index = indexGeneric
1186−
1187−-- | Consume a single input and transform it using the supplied 'Maybe'
1188−-- returning function.
1189−--
1190−-- /Pre-release/
1191−--
1192−{-# INLINE maybe #-}
1193−maybe :: Monad m => (a -> Maybe b) -> Fold m a (Maybe b)
1194−maybe f = foldt' (const (Done . f)) (Partial Nothing) id
1195−
1196−-- | Consume a single element and return it if it passes the predicate else
1197−-- return 'Nothing'.
1198−--
1199−-- Definition:
1200−--
1201−-- >>> satisfy f = Fold.maybe (\a -> if f a then Just a else Nothing)
1202−--
1203−-- /Pre-release/
1204−{-# INLINE satisfy #-}
1205−satisfy :: Monad m => (a -> Bool) -> Fold m a (Maybe a)
1206−satisfy f = maybe (\a -> if f a then Just a else Nothing)
1207−{-
1208−satisfy f = Fold step (return $ Partial ()) (const (return Nothing))
1209−
1210− where
1211−
1212− step () a = return $ Done $ if f a then Just a else Nothing
1213−-}
1214−
1215−-- Naming notes:
1216−--
1217−-- "head" and "next" are two alternative names for the same API. head sounds
1218−-- apt in the context of lists but next sounds more apt in the context of
1219−-- streams where we think in terms of generating and consuming the next element
1220−-- rather than taking the head of some static/persistent structure.
1221−--
1222−-- We also want to keep the nomenclature consistent across folds and parsers,
1223−-- "head" becomes even more unintuitive for parsers because there are two
1224−-- possible variants viz. peek and next.
1225−--
1226−-- Also, the "head" fold creates confusion in situations like
1227−-- https://github.com/composewell/streamly/issues/1404 where intuitive
1228−-- expectation from head is to consume the entire stream and just give us the
1229−-- head. There we want to convey the notion that we consume one element from
1230−-- the stream and stop. The name "one" already being used in parsers for this
1231−-- purpose sounds more apt from this perspective.
1232−--
1233−-- The source of confusion is perhaps due to the fact that some folds consume
1234−-- the entire stream and others terminate early. It may have been clearer if we
1235−-- had separate abstractions for the two use cases.
1236−
1237−-- XXX We can possibly use "head" for the purposes of reducing the entire
1238−-- stream to the head element i.e. take the head and drain the rest.
1239−
1240−-- | Take one element from the stream and stop.
1241−--
1242−-- Definition:
1243−--
1244−-- >>> one = Fold.maybe Just
1245−--
1246−-- This is similar to the stream 'Stream.uncons' operation.
1247−--
1248−{-# INLINE one #-}
1249−one :: Monad m => Fold m a (Maybe a)
1250−one = maybe Just
1251−
1252−-- | Extract the first element of the stream, if any.
1253−--
1254−-- >>> head = Fold.one
1255−--
1256−{-# DEPRECATED head "Please use \"one\" instead" #-}
1257−{-# INLINE head #-}
1258−head :: Monad m => Fold m a (Maybe a)
1259−head = one
1260−
1261−-- | Returns the first element that satisfies the given predicate.
1262−--
1263−-- /Pre-release/
1264−{-# INLINE findM #-}
1265−findM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)
1266−findM predicate = Fold step (return $ Partial ()) (const $ return Nothing)
1267−
1268− where
1269−
1270− step () a =
1271− let f r =
1272− if r
1273− then Done (Just a)
1274− else Partial ()
1275− in f <$> predicate a
1276−
1277−-- | Returns the first element that satisfies the given predicate.
1278−--
1279−{-# INLINE find #-}
1280−find :: Monad m => (a -> Bool) -> Fold m a (Maybe a)
1281−find p = findM (return . p)
1282−
1283−-- | In a stream of (key-value) pairs @(a, b)@, return the value @b@ of the
1284−-- first pair where the key equals the given value @a@.
1285−--
1286−-- Definition:
1287−--
1288−-- >>> lookup x = fmap snd <$> Fold.find ((== x) . fst)
1289−--
1290−{-# INLINE lookup #-}
1291−lookup :: (Eq a, Monad m) => a -> Fold m (a,b) (Maybe b)
1292−lookup a0 = foldt' step (Partial ()) (const Nothing)
1293−
1294− where
1295−
1296− step () (a, b) =
1297− if a == a0
1298− then Done $ Just b
1299− else Partial ()
1300−
1301−-- | Returns the first index that satisfies the given predicate.
1302−--
1303−{-# INLINE findIndex #-}
1304−findIndex :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)
1305−findIndex predicate = foldt' step (Partial 0) (const Nothing)
1306−
1307− where
1308−
1309− step i a =
1310− if predicate a
1311− then Done $ Just i
1312− else Partial (i + 1)
1313−
1314−-- | Returns the index of the latest element if the element satisfies the given
1315−-- predicate.
1316−--
1317−{-# INLINE findIndices #-}
1318−findIndices :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)
1319−findIndices predicate =
1320− -- XXX implement by combining indexing and filtering scans
1321− fmap (either (const Nothing) Just) $ foldl' step (Left (-1))
1322−
1323− where
1324−
1325− step i a =
1326− if predicate a
1327− then Right (either id id i + 1)
1328− else Left (either id id i + 1)
1329−
1330−-- | Returns the index of the latest element if the element matches the given
1331−-- value.
1332−--
1333−-- Definition:
1334−--
1335−-- >>> elemIndices a = Fold.findIndices (== a)
1336−--
1337−{-# INLINE elemIndices #-}
1338−elemIndices :: (Monad m, Eq a) => a -> Fold m a (Maybe Int)
1339−elemIndices a = findIndices (== a)
1340−
1341−-- | Returns the first index where a given value is found in the stream.
1342−--
1343−-- Definition:
1344−--
1345−-- >>> elemIndex a = Fold.findIndex (== a)
1346−--
1347−{-# INLINE elemIndex #-}
1348−elemIndex :: (Eq a, Monad m) => a -> Fold m a (Maybe Int)
1349−elemIndex a = findIndex (== a)
1350−
1351−------------------------------------------------------------------------------
1352−-- To Boolean
1353−------------------------------------------------------------------------------
1354−
1355−-- Similar to 'eof' parser, but the fold consumes and discards an input element
1356−-- when not at eof. XXX Remove or Rename to "eof"?
1357−
1358−-- | Consume one element, return 'True' if successful else return 'False'. In
1359−-- other words, test if the input is empty or not.
1360−--
1361−-- WARNING! It consumes one element if the stream is not empty. If that is not
1362−-- what you want please use the eof parser instead.
1363−--
1364−-- Definition:
1365−--
1366−-- >>> null = fmap isJust Fold.one
1367−--
1368−{-# INLINE null #-}
1369−null :: Monad m => Fold m a Bool
1370−null = foldt' (\() _ -> Done False) (Partial ()) (const True)
1371−
1372−-- | Returns 'True' if any element of the input satisfies the predicate.
1373−--
1374−-- Definition:
1375−--
1376−-- >>> any p = Fold.lmap p Fold.or
1377−--
1378−-- Example:
1379−--
1380−-- >>> Stream.fold (Fold.any (== 0)) $ Stream.fromList [1,0,1]
1381−-- True
1382−--
1383−{-# INLINE any #-}
1384−any :: Monad m => (a -> Bool) -> Fold m a Bool
1385−any predicate = foldt' step initial id
1386−
1387− where
1388−
1389− initial = Partial False
1390−
1391− step _ a =
1392− if predicate a
1393− then Done True
1394− else Partial False
1395−
1396−-- | Return 'True' if the given element is present in the stream.
1397−--
1398−-- Definition:
1399−--
1400−-- >>> elem a = Fold.any (== a)
1401−--
1402−{-# INLINE elem #-}
1403−elem :: (Eq a, Monad m) => a -> Fold m a Bool
1404−elem a = any (== a)
1405−
1406−-- | Returns 'True' if all elements of the input satisfy the predicate.
1407−--
1408−-- Definition:
1409−--
1410−-- >>> all p = Fold.lmap p Fold.and
1411−--
1412−-- Example:
1413−--
1414−-- >>> Stream.fold (Fold.all (== 0)) $ Stream.fromList [1,0,1]
1415−-- False
1416−--
1417−{-# INLINE all #-}
1418−all :: Monad m => (a -> Bool) -> Fold m a Bool
1419−all predicate = foldt' step initial id
1420−
1421− where
1422−
1423− initial = Partial True
1424−
1425− step _ a =
1426− if predicate a
1427− then Partial True
1428− else Done False
1429−
1430−-- | Returns 'True' if the given element is not present in the stream.
1431−--
1432−-- Definition:
1433−--
1434−-- >>> notElem a = Fold.all (/= a)
1435−--
1436−{-# INLINE notElem #-}
1437−notElem :: (Eq a, Monad m) => a -> Fold m a Bool
1438−notElem a = all (/= a)
1439−
1440−-- | Returns 'True' if all elements are 'True', 'False' otherwise
1441−--
1442−-- Definition:
1443−--
1444−-- >>> and = Fold.all (== True)
1445−--
1446−{-# INLINE and #-}
1447−and :: Monad m => Fold m Bool Bool
1448−and = all (== True)
1449−
1450−-- | Returns 'True' if any element is 'True', 'False' otherwise
1451−--
1452−-- Definition:
1453−--
1454−-- >>> or = Fold.any (== True)
1455−--
1456−{-# INLINE or #-}
1457−or :: Monad m => Fold m Bool Bool
1458−or = any (== True)
1459−
1460−------------------------------------------------------------------------------
1461−-- Grouping/Splitting
1462−------------------------------------------------------------------------------
1463−
1464−------------------------------------------------------------------------------
1465−-- Grouping without looking at elements
1466−------------------------------------------------------------------------------
1467−
1468−------------------------------------------------------------------------------
1469−-- Binary APIs
1470−------------------------------------------------------------------------------
1471−
1472−-- | @splitAt n f1 f2@ composes folds @f1@ and @f2@ such that first @n@
1473−-- elements of its input are consumed by fold @f1@ and the rest of the stream
1474−-- is consumed by fold @f2@.
1475−--
1476−-- >>> let splitAt_ n xs = Stream.fold (Fold.splitAt n Fold.toList Fold.toList) $ Stream.fromList xs
1477−--
1478−-- >>> splitAt_ 6 "Hello World!"
1479−-- ("Hello ","World!")
1480−--
1481−-- >>> splitAt_ (-1) [1,2,3]
1482−-- ([],[1,2,3])
1483−--
1484−-- >>> splitAt_ 0 [1,2,3]
1485−-- ([],[1,2,3])
1486−--
1487−-- >>> splitAt_ 1 [1,2,3]
1488−-- ([1],[2,3])
1489−--
1490−-- >>> splitAt_ 3 [1,2,3]
1491−-- ([1,2,3],[])
1492−--
1493−-- >>> splitAt_ 4 [1,2,3]
1494−-- ([1,2,3],[])
1495−--
1496−-- > splitAt n f1 f2 = Fold.splitWith (,) (Fold.take n f1) f2
1497−--
1498−-- /Internal/
1499−
1500−{-# INLINE splitAt #-}
1501−splitAt
1502− :: Monad m
1503− => Int
1504− -> Fold m a b
1505− -> Fold m a c
1506− -> Fold m a (b, c)
1507−splitAt n fld = splitWith (,) (take n fld)
1508−
1509−------------------------------------------------------------------------------
1510−-- Element Aware APIs
1511−------------------------------------------------------------------------------
1512−--
1513−------------------------------------------------------------------------------
1514−-- Binary APIs
1515−------------------------------------------------------------------------------
1516−
1517−{-# INLINE takingEndByM #-}
1518−takingEndByM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)
1519−takingEndByM p = Fold step initial (return . toMaybe)
1520−
1521− where
1522−
1523− initial = return $ Partial Nothing'
1524−
1525− step _ a = do
1526− r <- p a
1527− return
1528− $ if r
1529− then Done $ Just a
1530− else Partial $ Just' a
1531−
1532−-- |
1533−--
1534−-- >>> takingEndBy p = Fold.takingEndByM (return . p)
1535−--
1536−{-# INLINE takingEndBy #-}
1537−takingEndBy :: Monad m => (a -> Bool) -> Fold m a (Maybe a)
1538−takingEndBy p = takingEndByM (return . p)
1539−
1540−{-# INLINE takingEndByM_ #-}
1541−takingEndByM_ :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)
1542−takingEndByM_ p = Fold step initial (return . toMaybe)
1543−
1544− where
1545−
1546− initial = return $ Partial Nothing'
1547−
1548− step _ a = do
1549− r <- p a
1550− return
1551− $ if r
1552− then Done Nothing
1553− else Partial $ Just' a
1554−
1555−-- |
1556−--
1557−-- >>> takingEndBy_ p = Fold.takingEndByM_ (return . p)
1558−--
1559−{-# INLINE takingEndBy_ #-}
1560−takingEndBy_ :: Monad m => (a -> Bool) -> Fold m a (Maybe a)
1561−takingEndBy_ p = takingEndByM_ (return . p)
1562−
1563−{-# INLINE droppingWhileM #-}
1564−droppingWhileM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)
1565−droppingWhileM p = Fold step initial (return . toMaybe)
1566−
1567− where
1568−
1569− initial = return $ Partial Nothing'
1570−
1571− step Nothing' a = do
1572− r <- p a
1573− return
1574− $ Partial
1575− $ if r
1576− then Nothing'
1577− else Just' a
1578− step _ a = return $ Partial $ Just' a
1579−
1580−-- |
1581−-- >>> droppingWhile p = Fold.droppingWhileM (return . p)
1582−--
1583−{-# INLINE droppingWhile #-}
1584−droppingWhile :: Monad m => (a -> Bool) -> Fold m a (Maybe a)
1585−droppingWhile p = droppingWhileM (return . p)
1586−
1587−-- Note: Keep this consistent with S.splitOn. In fact we should eliminate
1588−-- S.splitOn in favor of the fold.
1589−--
1590−-- XXX Use Fold.many instead once it is fixed.
1591−-- > Stream.splitOnSuffix p f = Stream.foldMany (Fold.takeEndBy_ p f)
1592−
1593−-- | Like 'takeEndBy' but drops the element on which the predicate succeeds.
1594−--
1595−-- Example:
1596−--
1597−-- >>> input = Stream.fromList "hello\nthere\n"
1598−-- >>> line = Fold.takeEndBy_ (== '\n') Fold.toList
1599−-- >>> Stream.fold line input
1600−-- "hello"
1601−--
1602−-- >>> Stream.fold Fold.toList $ Stream.foldMany line input
1603−-- ["hello","there"]
1604−--
1605−{-# INLINE takeEndBy_ #-}
1606−takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b
1607−-- takeEndBy_ predicate = scanMaybe (takingEndBy_ predicate)
1608−takeEndBy_ predicate (Fold fstep finitial fextract) =
1609− Fold step finitial fextract
1610−
1611− where
1612−
1613− step s a =
1614− if not (predicate a)
1615− then fstep s a
1616− else Done <$> fextract s
1617−
1618−-- Note:
1619−-- > Stream.splitWithSuffix p f = Stream.foldMany (Fold.takeEndBy p f)
1620−
1621−-- | Take the input, stop when the predicate succeeds taking the succeeding
1622−-- element as well.
1623−--
1624−-- Example:
1625−--
1626−-- >>> input = Stream.fromList "hello\nthere\n"
1627−-- >>> line = Fold.takeEndBy (== '\n') Fold.toList
1628−-- >>> Stream.fold line input
1629−-- "hello\n"
1630−--
1631−-- >>> Stream.fold Fold.toList $ Stream.foldMany line input
1632−-- ["hello\n","there\n"]
1633−--
1634−{-# INLINE takeEndBy #-}
1635−takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b
1636−-- takeEndBy predicate = scanMaybe (takingEndBy predicate)
1637−takeEndBy predicate (Fold fstep finitial fextract) =
1638− Fold step finitial fextract
1639−
1640− where
1641−
1642− step s a = do
1643− res <- fstep s a
1644− if not (predicate a)
1645− then return res
1646− else do
1647− case res of
1648− Partial s1 -> Done <$> fextract s1
1649− Done b -> return $ Done b
1650−
1651−------------------------------------------------------------------------------
1652−-- Binary splitting on a separator
1653−------------------------------------------------------------------------------
1654−
1655−data SplitOnSeqState acc a rb rh w ck =
1656− SplitOnSeqEmpty !acc
1657− | SplitOnSeqSingle !acc !a
1658− | SplitOnSeqWord !acc !Int !w
1659− | SplitOnSeqWordLoop !acc !w
1660− | SplitOnSeqKR !acc !Int !rb !rh
1661− | SplitOnSeqKRLoop !acc !ck !rb !rh
1662−
1663−-- XXX Need to add tests for takeEndBySeq, we have tests for takeEndBySeq_ .
1664−
1665−-- | Continue taking the input until the input sequence matches the supplied
1666−-- sequence, taking the supplied sequence as well. If the pattern is empty this
1667−-- acts as an identity fold.
1668−--
1669−-- >>> s = Stream.fromList "hello there. How are you?"
1670−-- >>> f = Fold.takeEndBySeq (Array.fromList "re") Fold.toList
1671−-- >>> Stream.fold f s
1672−-- "hello there"
1673−--
1674−-- >>> Stream.fold Fold.toList $ Stream.foldMany f s
1675−-- ["hello there",". How are"," you?"]
1676−--
1677−-- /Pre-release/
1678−{-# INLINE takeEndBySeq #-}
1679−takeEndBySeq :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) =>
1680− Array.Array a
1681− -> Fold m a b
1682− -> Fold m a b
1683−takeEndBySeq patArr (Fold fstep finitial fextract) =
1684− Fold step initial extract
1685−
1686− where
1687−
1688− patLen = Array.length patArr
1689−
1690− initial = do
1691− res <- finitial
1692− case res of
1693− Partial acc
1694− | patLen == 0 ->
1695− -- XXX Should we match nothing or everything on empty
1696− -- pattern?
1697− -- Done <$> fextract acc
1698− return $ Partial $ SplitOnSeqEmpty acc
1699− | patLen == 1 -> do
1700− pat <- liftIO $ Array.unsafeIndexIO 0 patArr
1701− return $ Partial $ SplitOnSeqSingle acc pat
1702− | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->
1703− return $ Partial $ SplitOnSeqWord acc 0 0
1704− | otherwise -> do
1705− (rb, rhead) <- liftIO $ Ring.new patLen
1706− return $ Partial $ SplitOnSeqKR acc 0 rb rhead
1707− Done b -> return $ Done b
1708−
1709− -- Word pattern related
1710− maxIndex = patLen - 1
1711−
1712− elemBits = SIZE_OF(a) * 8
1713−
1714− wordMask :: Word
1715− wordMask = (1 `shiftL` (elemBits * patLen)) - 1
1716−
1717− wordPat :: Word
1718− wordPat = wordMask .&. Array.foldl' addToWord 0 patArr
1719−
1720− addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)
1721−
1722− -- For Rabin-Karp search
1723− k = 2891336453 :: Word32
1724− coeff = k ^ patLen
1725−
1726− addCksum cksum a = cksum * k + fromIntegral (fromEnum a)
1727−
1728− deltaCksum cksum old new =
1729− addCksum cksum new - coeff * fromIntegral (fromEnum old)
1730−
1731− -- XXX shall we use a random starting hash or 1 instead of 0?
1732− -- XXX Need to keep this cached across fold calls in foldmany
1733− -- XXX We may need refold to inject the cached state instead of
1734− -- initializing the state every time.
1735− -- XXX Allocation of ring buffer should also be done once
1736− patHash = Array.foldl' addCksum 0 patArr
1737−
1738− step (SplitOnSeqEmpty s) x = do
1739− res <- fstep s x
1740− case res of
1741− Partial s1 -> return $ Partial $ SplitOnSeqEmpty s1
1742− Done b -> return $ Done b
1743− step (SplitOnSeqSingle s pat) x = do
1744− res <- fstep s x
1745− case res of
1746− Partial s1
1747− | pat /= x -> return $ Partial $ SplitOnSeqSingle s1 pat
1748− | otherwise -> Done <$> fextract s1
1749− Done b -> return $ Done b
1750− step (SplitOnSeqWord s idx wrd) x = do
1751− res <- fstep s x
1752− let wrd1 = addToWord wrd x
1753− case res of
1754− Partial s1
1755− | idx == maxIndex -> do
1756− if wrd1 .&. wordMask == wordPat
1757− then Done <$> fextract s1
1758− else return $ Partial $ SplitOnSeqWordLoop s1 wrd1
1759− | otherwise ->
1760− return $ Partial $ SplitOnSeqWord s1 (idx + 1) wrd1
1761− Done b -> return $ Done b
1762− step (SplitOnSeqWordLoop s wrd) x = do
1763− res <- fstep s x
1764− let wrd1 = addToWord wrd x
1765− case res of
1766− Partial s1
1767− | wrd1 .&. wordMask == wordPat ->
1768− Done <$> fextract s1
1769− | otherwise ->
1770− return $ Partial $ SplitOnSeqWordLoop s1 wrd1
1771− Done b -> return $ Done b
1772− step (SplitOnSeqKR s idx rb rh) x = do
1773− res <- fstep s x
1774− case res of
1775− Partial s1 -> do
1776− rh1 <- liftIO $ Ring.unsafeInsert rb rh x
1777− if idx == maxIndex
1778− then do
1779− let fld = Ring.unsafeFoldRing (Ring.ringBound rb)
1780− let !ringHash = fld addCksum 0 rb
1781− if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr
1782− then Done <$> fextract s1
1783− else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1
1784− else
1785− return $ Partial $ SplitOnSeqKR s1 (idx + 1) rb rh1
1786− Done b -> return $ Done b
1787− step (SplitOnSeqKRLoop s cksum rb rh) x = do
1788− res <- fstep s x
1789− case res of
1790− Partial s1 -> do
1791− old <- liftIO $ peek rh
1792− rh1 <- liftIO $ Ring.unsafeInsert rb rh x
1793− let ringHash = deltaCksum cksum old x
1794− if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr
1795− then Done <$> fextract s1
1796− else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1
1797− Done b -> return $ Done b
1798−
1799− extract state =
1800− let st =
1801− case state of
1802− SplitOnSeqEmpty s -> s
1803− SplitOnSeqSingle s _ -> s
1804− SplitOnSeqWord s _ _ -> s
1805− SplitOnSeqWordLoop s _ -> s
1806− SplitOnSeqKR s _ _ _ -> s
1807− SplitOnSeqKRLoop s _ _ _ -> s
1808− in fextract st
1809−
1810−-- | Like 'takeEndBySeq' but discards the matched sequence.
1811−--
1812−-- /Pre-release/
1813−--
1814−{-# INLINE takeEndBySeq_ #-}
1815−takeEndBySeq_ :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) =>
1816− Array.Array a
1817− -> Fold m a b
1818− -> Fold m a b
1819−takeEndBySeq_ patArr (Fold fstep finitial fextract) =
1820− Fold step initial extract
1821−
1822− where
1823−
1824− patLen = Array.length patArr
1825−
1826− initial = do
1827− res <- finitial
1828− case res of
1829− Partial acc
1830− | patLen == 0 ->
1831− -- XXX Should we match nothing or everything on empty
1832− -- pattern?
1833− -- Done <$> fextract acc
1834− return $ Partial $ SplitOnSeqEmpty acc
1835− | patLen == 1 -> do
1836− pat <- liftIO $ Array.unsafeIndexIO 0 patArr
1837− return $ Partial $ SplitOnSeqSingle acc pat
1838− -- XXX Need to add tests for this case
1839− | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->
1840− return $ Partial $ SplitOnSeqWord acc 0 0
1841− | otherwise -> do
1842− (rb, rhead) <- liftIO $ Ring.new patLen
1843− return $ Partial $ SplitOnSeqKR acc 0 rb rhead
1844− Done b -> return $ Done b
1845−
1846− -- Word pattern related
1847− maxIndex = patLen - 1
1848−
1849− elemBits = SIZE_OF(a) * 8
1850−
1851− wordMask :: Word
1852− wordMask = (1 `shiftL` (elemBits * patLen)) - 1
1853−
1854− elemMask :: Word
1855− elemMask = (1 `shiftL` elemBits) - 1
1856−
1857− wordPat :: Word
1858− wordPat = wordMask .&. Array.foldl' addToWord 0 patArr
1859−
1860− addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)
1861−
1862− -- For Rabin-Karp search
1863− k = 2891336453 :: Word32
1864− coeff = k ^ patLen
1865−
1866− addCksum cksum a = cksum * k + fromIntegral (fromEnum a)
1867−
1868− deltaCksum cksum old new =
1869− addCksum cksum new - coeff * fromIntegral (fromEnum old)
1870−
1871− -- XXX shall we use a random starting hash or 1 instead of 0?
1872− -- XXX Need to keep this cached across fold calls in foldMany
1873− -- XXX We may need refold to inject the cached state instead of
1874− -- initializing the state every time.
1875− -- XXX Allocation of ring buffer should also be done once
1876− patHash = Array.foldl' addCksum 0 patArr
1877−
1878− step (SplitOnSeqEmpty s) x = do
1879− res <- fstep s x
1880− case res of
1881− Partial s1 -> return $ Partial $ SplitOnSeqEmpty s1
1882− Done b -> return $ Done b
1883− step (SplitOnSeqSingle s pat) x = do
1884− if pat /= x
1885− then do
1886− res <- fstep s x
1887− case res of
1888− Partial s1 -> return $ Partial $ SplitOnSeqSingle s1 pat
1889− Done b -> return $ Done b
1890− else Done <$> fextract s
1891− step (SplitOnSeqWord s idx wrd) x = do
1892− let wrd1 = addToWord wrd x
1893− if idx == maxIndex
1894− then do
1895− if wrd1 .&. wordMask == wordPat
1896− then Done <$> fextract s
1897− else return $ Partial $ SplitOnSeqWordLoop s wrd1
1898− else return $ Partial $ SplitOnSeqWord s (idx + 1) wrd1
1899− step (SplitOnSeqWordLoop s wrd) x = do
1900− let wrd1 = addToWord wrd x
1901− old = (wordMask .&. wrd)
1902− `shiftR` (elemBits * (patLen - 1))
1903− res <- fstep s (toEnum $ fromIntegral old)
1904− case res of
1905− Partial s1
1906− | wrd1 .&. wordMask == wordPat ->
1907− Done <$> fextract s1
1908− | otherwise ->
1909− return $ Partial $ SplitOnSeqWordLoop s1 wrd1
1910− Done b -> return $ Done b
1911− step (SplitOnSeqKR s idx rb rh) x = do
1912− rh1 <- liftIO $ Ring.unsafeInsert rb rh x
1913− if idx == maxIndex
1914− then do
1915− let fld = Ring.unsafeFoldRing (Ring.ringBound rb)
1916− let !ringHash = fld addCksum 0 rb
1917− if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr
1918− then Done <$> fextract s
1919− else return $ Partial $ SplitOnSeqKRLoop s ringHash rb rh1
1920− else return $ Partial $ SplitOnSeqKR s (idx + 1) rb rh1
1921− step (SplitOnSeqKRLoop s cksum rb rh) x = do
1922− old <- liftIO $ peek rh
1923− res <- fstep s old
1924− case res of
1925− Partial s1 -> do
1926− rh1 <- liftIO $ Ring.unsafeInsert rb rh x
1927− let ringHash = deltaCksum cksum old x
1928− if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr
1929− then Done <$> fextract s1
1930− else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1
1931− Done b -> return $ Done b
1932−
1933− -- XXX extract should return backtrack count as well. If the fold
1934− -- terminates early inside extract, we may still have buffered data
1935− -- remaining which will be lost if we do not communicate that to the
1936− -- driver.
1937− extract state = do
1938− let consumeWord s n wrd = do
1939− if n == 0
1940− then fextract s
1941− else do
1942− let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))
1943− r <- fstep s (toEnum $ fromIntegral old)
1944− case r of
1945− Partial s1 -> consumeWord s1 (n - 1) wrd
1946− Done b -> return b
1947−
1948− let consumeRing s n rb rh =
1949− if n == 0
1950− then fextract s
1951− else do
1952− old <- liftIO $ peek rh
1953− let rh1 = Ring.advance rb rh
1954− r <- fstep s old
1955− case r of
1956− Partial s1 -> consumeRing s1 (n - 1) rb rh1
1957− Done b -> return b
1958−
1959− case state of
1960− SplitOnSeqEmpty s -> fextract s
1961− SplitOnSeqSingle s _ -> fextract s
1962− SplitOnSeqWord s idx wrd -> consumeWord s idx wrd
1963− SplitOnSeqWordLoop s wrd -> consumeWord s patLen wrd
1964− SplitOnSeqKR s idx rb _ -> consumeRing s idx rb (Ring.startOf rb)
1965− SplitOnSeqKRLoop s _ rb rh -> consumeRing s patLen rb rh
1966−
1967−------------------------------------------------------------------------------
1968−-- Distributing
1969−------------------------------------------------------------------------------
1970−--
1971−-- | Distribute one copy of the stream to each fold and zip the results.
1972−--
1973−-- @
1974−-- |-------Fold m a b--------|
1975−-- ---stream m a---| |---m (b,c)
1976−-- |-------Fold m a c--------|
1977−-- @
1978−--
1979−-- Definition:
1980−--
1981−-- >>> tee = Fold.teeWith (,)
1982−--
1983−-- Example:
1984−--
1985−-- >>> t = Fold.tee Fold.sum Fold.length
1986−-- >>> Stream.fold t (Stream.enumerateFromTo 1.0 100.0)
1987−-- (5050.0,100)
1988−--
1989−{-# INLINE tee #-}
1990−tee :: Monad m => Fold m a b -> Fold m a c -> Fold m a (b,c)
1991−tee = teeWith (,)
1992−
1993−-- XXX use "List" instead of "[]"?, use Array for output to scale it to a large
1994−-- number of consumers? For polymorphic case a vector could be helpful. For
1995−-- Storables we can use arrays. Will need separate APIs for those.
1996−--
1997−-- | Distribute one copy of the stream to each fold and collect the results in
1998−-- a container.
1999−--
2000−-- @
2001−--
2002−-- |-------Fold m a b--------|
2003−-- ---stream m a---| |---m [b]
2004−-- |-------Fold m a b--------|
2005−-- | |
2006−-- ...
2007−-- @
2008−--
2009−-- >>> Stream.fold (Fold.distribute [Fold.sum, Fold.length]) (Stream.enumerateFromTo 1 5)
2010−-- [15,5]
2011−--
2012−-- >>> distribute = Prelude.foldr (Fold.teeWith (:)) (Fold.fromPure [])
2013−--
2014−-- This is the consumer side dual of the producer side 'sequence' operation.
2015−--
2016−-- Stops when all the folds stop.
2017−--
2018−{-# INLINE distribute #-}
2019−distribute :: Monad m => [Fold m a b] -> Fold m a [b]
2020−distribute = Prelude.foldr (teeWith (:)) (fromPure [])
2021−
2022−------------------------------------------------------------------------------
2023−-- Partitioning
2024−------------------------------------------------------------------------------
2025−
2026−{-# INLINE partitionByMUsing #-}
2027−partitionByMUsing :: Monad m =>
2028− ( (x -> y -> (x, y))
2029− -> Fold m (Either b c) x
2030− -> Fold m (Either b c) y
2031− -> Fold m (Either b c) (x, y)
2032− )
2033− -> (a -> m (Either b c))
2034− -> Fold m b x
2035− -> Fold m c y
2036− -> Fold m a (x, y)
2037−partitionByMUsing t f fld1 fld2 =
2038− let l = lmap (fromLeft undefined) fld1 -- :: Fold m (Either b c) x
2039− r = lmap (fromRight undefined) fld2 -- :: Fold m (Either b c) y
2040− in lmapM f (t (,) (filter isLeft l) (filter isRight r))
2041−
2042−-- | Partition the input over two folds using an 'Either' partitioning
2043−-- predicate.
2044−--
2045−-- @
2046−--
2047−-- |-------Fold b x--------|
2048−-- -----stream m a --> (Either b c)----| |----(x,y)
2049−-- |-------Fold c y--------|
2050−-- @
2051−--
2052−-- Example, send input to either fold randomly:
2053−--
2054−-- >>> :set -package random
2055−-- >>> import System.Random (randomIO)
2056−-- >>> randomly a = randomIO >>= \x -> return $ if x then Left a else Right a
2057−-- >>> f = Fold.partitionByM randomly Fold.length Fold.length
2058−-- >>> Stream.fold f (Stream.enumerateFromTo 1 100)
2059−-- ...
2060−--
2061−-- Example, send input to the two folds in a proportion of 2:1:
2062−--
2063−-- >>> :{
2064−-- proportionately m n = do
2065−-- ref <- newIORef $ cycle $ concat [replicate m Left, replicate n Right]
2066−-- return $ \a -> do
2067−-- r <- readIORef ref
2068−-- writeIORef ref $ tail r
2069−-- return $ Prelude.head r a
2070−-- :}
2071−--
2072−-- >>> :{
2073−-- main = do
2074−-- g <- proportionately 2 1
2075−-- let f = Fold.partitionByM g Fold.length Fold.length
2076−-- r <- Stream.fold f (Stream.enumerateFromTo (1 :: Int) 100)
2077−-- print r
2078−-- :}
2079−--
2080−-- >>> main
2081−-- (67,33)
2082−--
2083−--
2084−-- This is the consumer side dual of the producer side 'mergeBy' operation.
2085−--
2086−-- When one fold is done, any input meant for it is ignored until the other
2087−-- fold is also done.
2088−--
2089−-- Stops when both the folds stop.
2090−--
2091−-- /See also: 'partitionByFstM' and 'partitionByMinM'./
2092−--
2093−-- /Pre-release/
2094−{-# INLINE partitionByM #-}
2095−partitionByM :: Monad m
2096− => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
2097−partitionByM = partitionByMUsing teeWith
2098−
2099−-- | Similar to 'partitionByM' but terminates when the first fold terminates.
2100−--
2101−{-# INLINE partitionByFstM #-}
2102−partitionByFstM :: Monad m
2103− => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
2104−partitionByFstM = partitionByMUsing teeWithFst
2105−
2106−-- | Similar to 'partitionByM' but terminates when any fold terminates.
2107−--
2108−{-# INLINE partitionByMinM #-}
2109−partitionByMinM :: Monad m =>
2110− (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
2111−partitionByMinM = partitionByMUsing teeWithMin
2112−
2113−-- Note: we could use (a -> Bool) instead of (a -> Either b c), but the latter
2114−-- makes the signature clearer as to which case belongs to which fold.
2115−-- XXX need to check the performance in both cases.
2116−
2117−-- | Same as 'partitionByM' but with a pure partition function.
2118−--
2119−-- Example, count even and odd numbers in a stream:
2120−--
2121−-- >>> :{
2122−-- let f = Fold.partitionBy (\n -> if even n then Left n else Right n)
2123−-- (fmap (("Even " ++) . show) Fold.length)
2124−-- (fmap (("Odd " ++) . show) Fold.length)
2125−-- in Stream.fold f (Stream.enumerateFromTo 1 100)
2126−-- :}
2127−-- ("Even 50","Odd 50")
2128−--
2129−-- /Pre-release/
2130−{-# INLINE partitionBy #-}
2131−partitionBy :: Monad m
2132− => (a -> Either b c) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
2133−partitionBy f = partitionByM (return . f)
2134−
2135−-- | Compose two folds such that the combined fold accepts a stream of 'Either'
2136−-- and routes the 'Left' values to the first fold and 'Right' values to the
2137−-- second fold.
2138−--
2139−-- Definition:
2140−--
2141−-- >>> partition = Fold.partitionBy id
2142−--
2143−{-# INLINE partition #-}
2144−partition :: Monad m
2145− => Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)
2146−partition = partitionBy id
2147−
2148−{-
2149−-- | Send one item to each fold in a round-robin fashion. This is the consumer
2150−-- side dual of producer side 'mergeN' operation.
2151−--
2152−-- partitionN :: Monad m => [Fold m a b] -> Fold m a [b]
2153−-- partitionN fs = Fold step begin done
2154−-}
2155−
2156−------------------------------------------------------------------------------
2157−-- Unzipping
2158−------------------------------------------------------------------------------
2159−
2160−{-# INLINE unzipWithMUsing #-}
2161−unzipWithMUsing :: Monad m =>
2162− ( (x -> y -> (x, y))
2163− -> Fold m (b, c) x
2164− -> Fold m (b, c) y
2165− -> Fold m (b, c) (x, y)
2166− )
2167− -> (a -> m (b, c))
2168− -> Fold m b x
2169− -> Fold m c y
2170− -> Fold m a (x, y)
2171−unzipWithMUsing t f fld1 fld2 =
2172− let f1 = lmap fst fld1 -- :: Fold m (b, c) b
2173− f2 = lmap snd fld2 -- :: Fold m (b, c) c
2174− in lmapM f (t (,) f1 f2)
2175−
2176−-- | Like 'unzipWith' but with a monadic splitter function.
2177−--
2178−-- Definition:
2179−--
2180−-- >>> unzipWithM k f1 f2 = Fold.lmapM k (Fold.unzip f1 f2)
2181−--
2182−-- /Pre-release/
2183−{-# INLINE unzipWithM #-}
2184−unzipWithM :: Monad m
2185− => (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
2186−unzipWithM = unzipWithMUsing teeWith
2187−
2188−-- | Similar to 'unzipWithM' but terminates when the first fold terminates.
2189−--
2190−{-# INLINE unzipWithFstM #-}
2191−unzipWithFstM :: Monad m =>
2192− (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
2193−unzipWithFstM = unzipWithMUsing teeWithFst
2194−
2195−-- | Similar to 'unzipWithM' but terminates when any fold terminates.
2196−--
2197−{-# INLINE unzipWithMinM #-}
2198−unzipWithMinM :: Monad m =>
2199− (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
2200−unzipWithMinM = unzipWithMUsing teeWithMin
2201−
2202−-- | Split elements in the input stream into two parts using a pure splitter
2203−-- function, direct each part to a different fold and zip the results.
2204−--
2205−-- Definitions:
2206−--
2207−-- >>> unzipWith f = Fold.unzipWithM (return . f)
2208−-- >>> unzipWith f fld1 fld2 = Fold.lmap f (Fold.unzip fld1 fld2)
2209−--
2210−-- This fold terminates when both the input folds terminate.
2211−--
2212−-- /Pre-release/
2213−{-# INLINE unzipWith #-}
2214−unzipWith :: Monad m
2215− => (a -> (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
2216−unzipWith f = unzipWithM (return . f)
2217−
2218−-- | Send the elements of tuples in a stream of tuples through two different
2219−-- folds.
2220−--
2221−-- @
2222−--
2223−-- |-------Fold m a x--------|
2224−-- ---------stream of (a,b)--| |----m (x,y)
2225−-- |-------Fold m b y--------|
2226−--
2227−-- @
2228−--
2229−-- Definition:
2230−--
2231−-- >>> unzip = Fold.unzipWith id
2232−--
2233−-- This is the consumer side dual of the producer side 'zip' operation.
2234−--
2235−{-# INLINE unzip #-}
2236−unzip :: Monad m => Fold m a x -> Fold m b y -> Fold m (a,b) (x,y)
2237−unzip = unzipWith id
2238−
2239−------------------------------------------------------------------------------
2240−-- Combining streams and folds - Zipping
2241−------------------------------------------------------------------------------
2242−
2243−-- XXX These can be implemented using the fold scan, using the stream as a
2244−-- state.
2245−-- XXX Stream Skip state cannot be efficiently handled in folds but can be
2246−-- handled in parsers using the Continue facility. See zipWithM in the Parser
2247−-- module.
2248−--
2249−-- cmpBy, eqBy, isPrefixOf, isSubsequenceOf etc can be implemented using
2250−-- zipStream.
2251−
2252−-- | Zip a stream with the input of a fold using the supplied function.
2253−--
2254−-- /Unimplemented/
2255−--
2256−{-# INLINE zipStreamWithM #-}
2257−zipStreamWithM :: -- Monad m =>
2258− (a -> b -> m c) -> Stream m a -> Fold m c x -> Fold m b x
2259−zipStreamWithM = undefined
2260−
2261−-- | Zip a stream with the input of a fold.
2262−--
2263−-- >>> zip = Fold.zipStreamWithM (curry return)
2264−--
2265−-- /Unimplemented/
2266−--
2267−{-# INLINE zipStream #-}
2268−zipStream :: Monad m => Stream m a -> Fold m (a, b) x -> Fold m b x
2269−zipStream = zipStreamWithM (curry return)
2270−
2271−-- | Pair each element of a fold input with its index, starting from index 0.
2272−--
2273−{-# INLINE indexingWith #-}
2274−indexingWith :: Monad m => Int -> (Int -> Int) -> Fold m a (Maybe (Int, a))
2275−indexingWith i f = fmap toMaybe $ foldl' step initial
2276−
2277− where
2278−
2279− initial = Nothing'
2280−
2281− step Nothing' a = Just' (i, a)
2282− step (Just' (n, _)) a = Just' (f n, a)
2283−
2284−-- |
2285−-- >>> indexing = Fold.indexingWith 0 (+ 1)
2286−--
2287−{-# INLINE indexing #-}
2288−indexing :: Monad m => Fold m a (Maybe (Int, a))
2289−indexing = indexingWith 0 (+ 1)
2290−
2291−-- |
2292−-- >>> indexingRev n = Fold.indexingWith n (subtract 1)
2293−--
2294−{-# INLINE indexingRev #-}
2295−indexingRev :: Monad m => Int -> Fold m a (Maybe (Int, a))
2296−indexingRev n = indexingWith n (subtract 1)
2297−
2298−-- | Pair each element of a fold input with its index, starting from index 0.
2299−--
2300−-- >>> indexed = Fold.scanMaybe Fold.indexing
2301−--
2302−{-# INLINE indexed #-}
2303−indexed :: Monad m => Fold m (Int, a) b -> Fold m a b
2304−indexed = scanMaybe indexing
2305−
2306−-- | Change the predicate function of a Fold from @a -> b@ to accept an
2307−-- additional state input @(s, a) -> b@. Convenient to filter with an
2308−-- addiitonal index or time input.
2309−--
2310−-- >>> filterWithIndex = Fold.with Fold.indexed Fold.filter
2311−--
2312−-- @
2313−-- filterWithAbsTime = with timestamped filter
2314−-- filterWithRelTime = with timeIndexed filter
2315−-- @
2316−--
2317−-- /Pre-release/
2318−{-# INLINE with #-}
2319−with ::
2320− (Fold m (s, a) b -> Fold m a b)
2321− -> (((s, a) -> c) -> Fold m (s, a) b -> Fold m (s, a) b)
2322− -> (((s, a) -> c) -> Fold m a b -> Fold m a b)
2323−with f comb g = f . comb g . lmap snd
2324−
2325−-- XXX Implement as a filter
2326−-- sampleFromthen :: Monad m => Int -> Int -> Fold m a (Maybe a)
2327−
2328−-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
2329−-- then every element at strides of @stride@.
2330−--
2331−{-# INLINE sampleFromthen #-}
2332−sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Fold m a b
2333−sampleFromthen offset size =
2334− with indexed filter (\(i, _) -> (i + offset) `mod` size == 0)
2335−
2336−------------------------------------------------------------------------------
2337−-- Nesting
2338−------------------------------------------------------------------------------
2339−
2340−-- | @concatSequence f t@ applies folds from stream @t@ sequentially and
2341−-- collects the results using the fold @f@.
2342−--
2343−-- /Unimplemented/
2344−--
2345−{-# INLINE concatSequence #-}
2346−concatSequence ::
2347− -- IsStream t =>
2348− Fold m b c -> t (Fold m a b) -> Fold m a c
2349−concatSequence _f _p = undefined
2350−
2351−-- | Group the input stream into groups of elements between @low@ and @high@.
2352−-- Collection starts in chunks of @low@ and then keeps doubling until we reach
2353−-- @high@. Each chunk is folded using the provided fold function.
2354−--
2355−-- This could be useful, for example, when we are folding a stream of unknown
2356−-- size to a stream of arrays and we want to minimize the number of
2357−-- allocations.
2358−--
2359−-- NOTE: this would be an application of "many" using a terminating fold.
2360−--
2361−-- /Unimplemented/
2362−--
2363−{-# INLINE chunksBetween #-}
2364−chunksBetween :: -- Monad m =>
2365− Int -> Int -> Fold m a b -> Fold m b c -> Fold m a c
2366−chunksBetween _low _high _f1 _f2 = undefined
2367−
2368−-- | A fold that buffers its input to a pure stream.
2369−--
2370−-- /Warning!/ working on large streams accumulated as buffers in memory could
2371−-- be very inefficient, consider using "Streamly.Data.Array" instead.
2372−--
2373−-- >>> toStream = fmap Stream.fromList Fold.toList
2374−--
2375−-- /Pre-release/
2376−{-# INLINE toStream #-}
2377−toStream :: (Monad m, Monad n) => Fold m a (Stream n a)
2378−toStream = fmap StreamD.fromList toList
2379−
2380−-- This is more efficient than 'toStream'. toStream is exactly the same as
2381−-- reversing the stream after toStreamRev.
2382−--
2383−-- | Buffers the input stream to a pure stream in the reverse order of the
2384−-- input.
2385−--
2386−-- >>> toStreamRev = fmap Stream.fromList Fold.toListRev
2387−--
2388−-- /Warning!/ working on large streams accumulated as buffers in memory could
2389−-- be very inefficient, consider using "Streamly.Data.Array" instead.
2390−--
2391−-- /Pre-release/
2392−
2393−-- xn : ... : x2 : x1 : []
2394−{-# INLINE toStreamRev #-}
2395−toStreamRev :: (Monad m, Monad n) => Fold m a (Stream n a)
2396−toStreamRev = fmap StreamD.fromList toListRev
2397−
2398−-- XXX This does not fuse. It contains a recursive step function. We will need
2399−-- a Skip input constructor in the fold type to make it fuse.
2400−--
2401−-- | Unfold and flatten the input stream of a fold.
2402−--
2403−-- @
2404−-- Stream.fold (unfoldMany u f) = Stream.fold f . Stream.unfoldMany u
2405−-- @
2406−--
2407−-- /Pre-release/
2408−{-# INLINE unfoldMany #-}
2409−unfoldMany :: Monad m => Unfold m a b -> Fold m b c -> Fold m a c
2410−unfoldMany (Unfold ustep inject) (Fold fstep initial extract) =
2411− Fold consume initial extract
2412−
2413− where
2414−
2415− {-# INLINE produce #-}
2416− produce fs us = do
2417− ures <- ustep us
2418− case ures of
2419− StreamD.Yield b us1 -> do
2420− fres <- fstep fs b
2421− case fres of
2422− Partial fs1 -> produce fs1 us1
2423− -- XXX What to do with the remaining stream?
2424− Done c -> return $ Done c
2425− StreamD.Skip us1 -> produce fs us1
2426− StreamD.Stop -> return $ Partial fs
2427−
2428− {-# INLINE_LATE consume #-}
2429− consume s a = inject a >>= produce s
2430−
2431−-- | Get the bottom most @n@ elements using the supplied comparison function.
2432−--
2433−{-# INLINE bottomBy #-}
2434−bottomBy :: (MonadIO m, Unbox a) =>
2435− (a -> a -> Ordering)
2436− -> Int
2437− -> Fold m a (MutArray a)
2438−bottomBy cmp n = Fold step initial extract
2439−
2440− where
2441−
2442− initial = do
2443− arr <- MA.pinnedNew n
2444− if n <= 0
2445− then return $ Done arr
2446− else return $ Partial (arr, 0)
2447−
2448− step (arr, i) x =
2449− if i < n
2450− then do
2451− arr' <- MA.snoc arr x
2452− MA.bubble cmp arr'
2453− return $ Partial (arr', i + 1)
2454− else do
2455− x1 <- MA.getIndexUnsafe (i - 1) arr
2456− case x `cmp` x1 of
2457− LT -> do
2458− MA.putIndexUnsafe (i - 1) arr x
2459− MA.bubble cmp arr
2460− return $ Partial (arr, i)
2461− _ -> return $ Partial (arr, i)
2462−
2463− extract = return . fst
2464−
2465−-- | Get the top @n@ elements using the supplied comparison function.
2466−--
2467−-- To get bottom n elements instead:
2468−--
2469−-- >>> bottomBy cmp = Fold.topBy (flip cmp)
2470−--
2471−-- Example:
2472−--
2473−-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]
2474−-- >>> Stream.fold (Fold.topBy compare 3) stream >>= MutArray.toList
2475−-- [17,11,9]
2476−--
2477−-- /Pre-release/
2478−--
2479−{-# INLINE topBy #-}
2480−topBy :: (MonadIO m, Unbox a) =>
2481− (a -> a -> Ordering)
2482− -> Int
2483− -> Fold m a (MutArray a)
2484−topBy cmp = bottomBy (flip cmp)
2485−
2486−-- | Fold the input stream to top n elements.
2487−--
2488−-- Definition:
2489−--
2490−-- >>> top = Fold.topBy compare
2491−--
2492−-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]
2493−-- >>> Stream.fold (Fold.top 3) stream >>= MutArray.toList
2494−-- [17,11,9]
2495−--
2496−-- /Pre-release/
2497−{-# INLINE top #-}
2498−top :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MutArray a)
2499−top = bottomBy $ flip compare
2500−
2501−-- | Fold the input stream to bottom n elements.
2502−--
2503−-- Definition:
2504−--
2505−-- >>> bottom = Fold.bottomBy compare
2506−--
2507−-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]
2508−-- >>> Stream.fold (Fold.bottom 3) stream >>= MutArray.toList
2509−-- [1,2,3]
2510−--
2511−-- /Pre-release/
2512−{-# INLINE bottom #-}
2513−bottom :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MutArray a)
2514−bottom = bottomBy compare
2515−
2516−------------------------------------------------------------------------------
2517−-- Interspersed parsing
2518−------------------------------------------------------------------------------
2519−
2520−data IntersperseQState fs ps =
2521− IntersperseQUnquoted !fs !ps
2522− | IntersperseQQuoted !fs !ps
2523− | IntersperseQQuotedEsc !fs !ps
2524−
2525−-- Useful for parsing CSV with quoting and escaping
2526−{-# INLINE intersperseWithQuotes #-}
2527−intersperseWithQuotes :: (Monad m, Eq a) =>
2528− a -> a -> a -> Fold m a b -> Fold m b c -> Fold m a c
2529−intersperseWithQuotes
2530− quote
2531− esc
2532− separator
2533− (Fold stepL initialL extractL)
2534− (Fold stepR initialR extractR) = Fold step initial extract
2535−
2536− where
2537−
2538− errMsg p status =
2539− error $ "intersperseWithQuotes: " ++ p ++ " parsing fold cannot "
2540− ++ status ++ " without input"
2541−
2542− {-# INLINE initL #-}
2543− initL mkState = do
2544− resL <- initialL
2545− case resL of
2546− Partial sL ->
2547− return $ Partial $ mkState sL
2548− Done _ ->
2549− errMsg "content" "succeed"
2550−
2551− initial = do
2552− res <- initialR
2553− case res of
2554− Partial sR -> initL (IntersperseQUnquoted sR)
2555− Done b -> return $ Done b
2556−
2557− {-# INLINE collect #-}
2558− collect nextS sR b = do
2559− res <- stepR sR b
2560− case res of
2561− Partial s ->
2562− initL (nextS s)
2563− Done c -> return (Done c)
2564−
2565− {-# INLINE process #-}
2566− process a sL sR nextState = do
2567− r <- stepL sL a
2568− case r of
2569− Partial s -> return $ Partial (nextState sR s)
2570− Done b -> collect nextState sR b
2571−
2572− {-# INLINE processQuoted #-}
2573− processQuoted a sL sR nextState = do
2574− r <- stepL sL a
2575− case r of
2576− Partial s -> return $ Partial (nextState sR s)
2577− Done _ -> error "Collecting fold finished inside quote"
2578−
2579− step (IntersperseQUnquoted sR sL) a
2580− | a == separator = do
2581− b <- extractL sL
2582− collect IntersperseQUnquoted sR b
2583− | a == quote = processQuoted a sL sR IntersperseQQuoted
2584− | otherwise = process a sL sR IntersperseQUnquoted
2585−
2586− step (IntersperseQQuoted sR sL) a
2587− | a == esc = processQuoted a sL sR IntersperseQQuotedEsc
2588− | a == quote = process a sL sR IntersperseQUnquoted
2589− | otherwise = processQuoted a sL sR IntersperseQQuoted
2590−
2591− step (IntersperseQQuotedEsc sR sL) a =
2592− processQuoted a sL sR IntersperseQQuoted
2593−
2594− extract (IntersperseQUnquoted sR _) = extractR sR
2595− extract (IntersperseQQuoted _ _) =
2596− error "intersperseWithQuotes: finished inside quote"
2597− extract (IntersperseQQuotedEsc _ _) =
2598− error "intersperseWithQuotes: finished inside quote, at escape char"