@@ -7,15 +7,16 @@
7-- Stability : experimental
7-- Stability : experimental
8-- Portability : GHC
8-- Portability : GHC
10−-- Also see the "Streamly.Internal.Data.Sink" module that provides specialized left folds
10+-- Also see the "Streamly.Internal.Data.Sink" module that provides specialized
11−-- that discard the outputs.
11+-- left folds that discard the outputs.
13-- IMPORTANT: keep the signatures consistent with the folds in Streamly.Prelude
13-- IMPORTANT: keep the signatures consistent with the folds in Streamly.Prelude
15module Streamly.Internal.Data.Fold
15module Streamly.Internal.Data.Fold
17 -- * Fold Type
17 -- * Fold Type
18− Fold (..)
19+ , Fold (..)
21 , generally
22 , generally
@@ -24,10 +25,14 @@ module Streamly.Internal.Data.Fold
26 -- * Fold Creation Utilities
27 -- * Fold Creation Utilities
27− , mkPure
28+ , mkAccum
28− , mkPureId
29+ , mkAccum_
30− , mkFoldId
33+ , mkFold_
32 -- ** Full Folds
37 -- ** Full Folds
@@ -65,7 +70,7 @@ module Streamly.Internal.Data.Fold
66 -- ** Partial Folds
71 -- ** Partial Folds
68− , drainWhile
73+ , drainSepBy
69 -- , lastN
74 -- , lastN
71 -- , genericIndex
76 -- , genericIndex
@@ -126,7 +131,7 @@ module Streamly.Internal.Data.Fold
126 -- ** Trimming
131 -- ** Trimming
128 -- , lrunFor -- time
133 -- , lrunFor -- time
129− , ltakeWhile
134+ , takeSepBy
131 , ltakeWhileM
136 , ltakeWhileM
@@ -151,6 +156,8 @@ module Streamly.Internal.Data.Fold
151 -- , breakAround
156 -- , breakAround
153 , spanByRolling
158 , spanByRolling
155 -- By sequences
162 -- By sequences
156 -- , breakOnSeq
163 -- , breakOnSeq
@@ -164,33 +171,36 @@ module Streamly.Internal.Data.Fold
165 -- * Partitioning
172 -- * Partitioning
167− -- , partitionByM
174+ , partitionByM
168− -- , partitionBy
177+ , partitionBy
169 , partition
178 , partition
171 -- * Demultiplexing
180 -- * Demultiplexing
174− -- , demuxWith
183+ , demuxWith
176 , demuxDefault_
185 , demuxDefault_
177− -- , demuxWith_
186+ , demuxWith_
178 , demuxWithDefault_
187 , demuxWithDefault_
180 -- * Classifying
189 -- * Classifying
182 , classify
191 , classify
183− -- , classifyWith
192+ , classifyWith
185 -- * Unzipping
194 -- * Unzipping
187− -- These can be expressed using lmap/lmapM and unzip
188− -- , unzipWith
196+ , unzipWith
189− -- , unzipWithM
197+ , unzipWithM
191 -- * Nested Folds
201 -- * Nested Folds
192 -- , concatMap
202 -- , concatMap
193− , foldChunks
203+ , many
194 , duplicate
204 , duplicate
196 -- * Running Folds
206 -- * Running Folds
@@ -203,7 +213,7 @@ module Streamly.Internal.Data.Fold
206−import Control.Monad (join, void)
216+import Control.Monad (void, join)
207import Control.Monad.IO.Class (MonadIO(..))
217import Control.Monad.IO.Class (MonadIO(..))
208import Data.Functor.Identity (Identity(..))
218import Data.Functor.Identity (Identity(..))
209import Data.Int (Int64)
219import Data.Int (Int64)
@@ -214,11 +224,13 @@ import Data.Semigroup (Semigroup((<>)))
215import Streamly.Internal.Data.Pipe.Types (Pipe (..), PipeState(..))
225import Streamly.Internal.Data.Pipe.Types (Pipe (..), PipeState(..))
216import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))
226import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))
217−import Streamly.Internal.Data.Either.Strict (Either'(..))
218import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)
227import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)
228+import Streamly.Internal.Data.Either.Strict (Either'(..))
230+import qualified Streamly.Internal.Data.Fold.Types as FL
220import qualified Streamly.Internal.Data.Pipe.Types as Pipe
231import qualified Streamly.Internal.Data.Pipe.Types as Pipe
221import qualified Data.Map.Strict as Map
232import qualified Data.Map.Strict as Map
233+import qualified Data.Set as Set
222import qualified Prelude
234import qualified Prelude
224import Prelude hiding
236import Prelude hiding
@@ -235,46 +247,86 @@ import Streamly.Internal.Data.Fold.Types
235-- Smart constructors
247-- Smart constructors
236------------------------------------------------------------------------------
248------------------------------------------------------------------------------
238−-- | Make a fold using a pure step function, a pure initial state and
250+-- | Make an accumulating (non-terminating) fold using a pure step function, a
239−-- a pure state extraction function.
251+-- pure initial state and a pure state extraction function.
241-- /Internal/
253-- /Internal/
243−{-# INLINE mkPure #-}
255+{-# INLINE mkAccum #-}
244−mkPure :: Monad m => (s -> a -> s) -> s -> (s -> b) -> Fold m a b
256+mkAccum :: Monad m => (s -> a -> s) -> s -> (s -> b) -> Fold m a b
257+mkAccum step initial extract =
259+ (\s a -> return $ Partial $ step s a)
263+-- | Similar to 'mkAccum' but the final state extracted is identical to the
264+-- intermediate state.
268+{-# INLINE mkAccum_ #-}
269+mkAccum_ :: Monad m => (b -> a -> b) -> b -> Fold m a b
270+mkAccum_ step initial = mkAccum step initial id
272+-- | Make an accumulating (non-terminating) fold with an effectful step
273+-- function, an initial state, and a state extraction function.
277+{-# INLINE mkAccumM #-}
278+mkAccumM :: Functor m => (s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
279+mkAccumM step = Fold (\s a -> Partial <$> step s a)
281+-- | Similar to 'mkAccumM' but the final state extracted is identical to the
282+-- intermediate state.
286+{-# INLINE mkAccumM_ #-}
287+mkAccumM_ :: Monad m => (b -> a -> m b) -> m b -> Fold m a b
288+mkAccumM_ step initial = mkAccumM step initial return
290+-- | Make a terminating fold using a pure step function, a pure initial state
291+-- and a pure state extraction function.
295+{-# INLINE mkFold #-}
296+mkFold :: Monad m => (s -> a -> Step s b) -> s -> (s -> b) -> Fold m a b
245−mkPure step initial extract =
297+mkFold step initial extract =
246 Fold (\s a -> return $ step s a) (return initial) (return . extract)
298 Fold (\s a -> return $ step s a) (return initial) (return . extract)
248−-- | Make a fold using a pure step function and a pure initial state. The
249−-- final state extracted is identical to the intermediate state.
300+-- | Similar to 'mkFold' but the final state extracted is identical to the
301+-- intermediate state.
251-- /Internal/
303-- /Internal/
253−{-# INLINE mkPureId #-}
305+{-# INLINE mkFold_ #-}
254−mkPureId :: Monad m => (b -> a -> b) -> b -> Fold m a b
306+mkFold_ :: Monad m => (b -> a -> Step b b) -> b -> Fold m a b
255−mkPureId step initial = mkPure step initial id
307+mkFold_ step initial = mkFold step initial id
257−-- | Make a fold with an effectful step function and initial state, and a state
309+-- | Make a terminating fold with an effectful step function and initial state,
258−-- extraction function.
310+-- and a state extraction function.
260−-- > mkFold = Fold
312+-- > mkFoldM = Fold
262-- We can just use 'Fold' but it is provided for completeness.
314-- We can just use 'Fold' but it is provided for completeness.
264-- /Internal/
316-- /Internal/
266−{-# INLINE mkFold #-}
318+{-# INLINE mkFoldM #-}
267−mkFold :: (s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
319+mkFoldM :: (s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Fold m a b
268−mkFold = Fold
320+mkFoldM = Fold
270−-- | Make a fold with an effectful step function and initial state. The final
271−-- state extracted is identical to the intermediate state.
322+-- | Similar to 'mkFoldM' but the final state extracted is identical to the
323+-- intermediate state.
273-- /Internal/
325-- /Internal/
275−{-# INLINE mkFoldId #-}
327+{-# INLINE mkFoldM_ #-}
276−mkFoldId :: Monad m => (b -> a -> m b) -> m b -> Fold m a b
328+mkFoldM_ :: Monad m => (b -> a -> m (Step b b)) -> m b -> Fold m a b
277−mkFoldId step initial = Fold step initial return
329+mkFoldM_ step initial = Fold step initial return
279------------------------------------------------------------------------------
331------------------------------------------------------------------------------
@@ -304,9 +356,17 @@ generally = hoist (return . runIdentity)
304-- @since 0.7.0
356-- @since 0.7.0
305{-# INLINE sequence #-}
357{-# INLINE sequence #-}
306sequence :: Monad m => Fold m a (m b) -> Fold m a b
358sequence :: Monad m => Fold m a (m b) -> Fold m a b
307−sequence (Fold step initial extract) = Fold step initial extract'
359+sequence (Fold step initial extract) = Fold step' initial extract'
366+ Partial x -> return $ Partial x
367+ Done b -> Done <$> b
309− extract' x = join (extract x)
369+ extract' = join . extract
311-- | Map a monadic function on the output of a fold.
371-- | Map a monadic function on the output of a fold.
@@ -346,23 +406,28 @@ transform (Pipe pstep1 pstep2 pinitial) (Fold fstep finitial fextract) =
348 initial = Tuple' pinitial <$> finitial
408 initial = Tuple' pinitial <$> finitial
349 step (Tuple' ps fs) x = do
410 step (Tuple' ps fs) x = do
350 r <- pstep1 ps x
411 r <- pstep1 ps x
354 -- XXX use SPEC?
416 -- XXX use SPEC?
355 go acc (Pipe.Yield b (Consume ps')) = do
417 go acc (Pipe.Yield b (Consume ps')) = do
356 acc' <- fstep acc b
418 acc' <- fstep acc b
357− return (Tuple' ps' acc')
419+ return
421+ Partial s -> Partial $ Tuple' ps' s
359 go acc (Pipe.Yield b (Produce ps')) = do
423 go acc (Pipe.Yield b (Produce ps')) = do
360 acc' <- fstep acc b
424 acc' <- fstep acc b
361 r <- pstep2 ps'
425 r <- pstep2 ps'
362− go acc' r
426+ case acc' of
363−
427+ Partial s -> go s r
428+ Done b2 -> return $ Done b2
364− go acc (Pipe.Continue (Consume ps')) = return (Tuple' ps' acc)
429+ go acc (Pipe.Continue (Consume ps')) =
365−
430+ return $ Partial $ Tuple' ps' acc
366 go acc (Pipe.Continue (Produce ps')) = do
431 go acc (Pipe.Continue (Produce ps')) = do
367 r <- pstep2 ps'
432 r <- pstep2 ps'
@@ -380,11 +445,11 @@ transform (Pipe pstep1 pstep2 pinitial) (Fold fstep finitial fextract) =
380{-# INLINABLE _Fold1 #-}
445{-# INLINABLE _Fold1 #-}
381_Fold1 :: Monad m => (a -> a -> a) -> Fold m a (Maybe a)
446_Fold1 :: Monad m => (a -> a -> a) -> Fold m a (Maybe a)
382_Fold1 step = Fold step_ (return Nothing') (return . toMaybe)
447_Fold1 step = Fold step_ (return Nothing') (return . toMaybe)
384− step_ mx a = return $ Just' $
450+
386− Nothing' -> a
451+ step_ Nothing' a = return $ Partial $ Just' a
387− Just' x -> step x a
452+ step_ (Just' x) a = return $ Partial $ Just' $ step x a
389------------------------------------------------------------------------------
454------------------------------------------------------------------------------
390-- Left folds
455-- Left folds
@@ -403,9 +468,13 @@ _Fold1 step = Fold step_ (return Nothing') (return . toMaybe)
403{-# INLINABLE drain #-}
468{-# INLINABLE drain #-}
404drain :: Monad m => Fold m a ()
469drain :: Monad m => Fold m a ()
405drain = Fold step begin done
470drain = Fold step begin done
407 begin = return ()
474 begin = return ()
408− step _ _ = return ()
476+ step _ _ = return $ FL.Partial ()
409 done = return
478 done = return
@@ -418,7 +487,7 @@ drain = Fold step begin done
418-- @since 0.7.0
487-- @since 0.7.0
419{-# INLINABLE drainBy #-}
488{-# INLINABLE drainBy #-}
420drainBy :: Monad m => (a -> m b) -> Fold m a ()
489drainBy :: Monad m => (a -> m b) -> Fold m a ()
421−drainBy f = Fold (const (void . f)) (return ()) return
490+drainBy f = Fold (const (fmap FL.Partial . void . f)) (return ()) return
423{-# INLINABLE drainBy2 #-}
492{-# INLINABLE drainBy2 #-}
424drainBy2 :: Monad m => (a -> m b) -> Fold2 m c a ()
493drainBy2 :: Monad m => (a -> m b) -> Fold2 m c a ()
@@ -442,16 +511,16 @@ last = _Fold1 (\_ x -> x)
442-- > genericLength = fmap getSum $ foldMap (Sum . const 1)
511-- > genericLength = fmap getSum $ foldMap (Sum . const 1)
444-- @since 0.7.0
513-- @since 0.7.0
445−{-# INLINABLE genericLength #-}
514+{-# INLINE genericLength #-}
446genericLength :: (Monad m, Num b) => Fold m a b
515genericLength :: (Monad m, Num b) => Fold m a b
447−genericLength = Fold (\n _ -> return $ n + 1) (return 0) return
516+genericLength = Fold (\n _ -> return $ Partial $ n + 1) (return 0) return
449-- | Determine the length of the input stream.
518-- | Determine the length of the input stream.
451-- > length = fmap getSum $ foldMap (Sum . const 1)
520-- > length = fmap getSum $ foldMap (Sum . const 1)
453-- @since 0.7.0
522-- @since 0.7.0
454−{-# INLINABLE length #-}
523+{-# INLINE length #-}
455length :: Monad m => Fold m a Int
524length :: Monad m => Fold m a Int
456length = genericLength
525length = genericLength
@@ -464,17 +533,27 @@ length = genericLength
464-- @since 0.7.0
533-- @since 0.7.0
465{-# INLINE sum #-}
534{-# INLINE sum #-}
466sum :: (Monad m, Num a) => Fold m a a
535sum :: (Monad m, Num a) => Fold m a a
467−sum = Fold (\x a -> return $ x + a) (return 0) return
536+sum = Fold (\x a -> return $ Partial $ x + a) (return 0) return
469-- | Determine the product of all elements of a stream of numbers. Returns
538-- | Determine the product of all elements of a stream of numbers. Returns
470−-- multiplicative identity (@1@) when the stream is empty.
539+-- multiplicative identity (@1@) when the stream is empty. The fold terminates
540+-- when it encounters (@0@) in its input.
472-- > product = fmap getProduct $ FL.foldMap Product
542-- > product = fmap getProduct $ FL.foldMap Product
474-- @since 0.7.0
544-- @since 0.7.0
545+-- /since 0.8.0 (Added 'Eq' constraint)/
475−{-# INLINABLE product #-}
546+{-# INLINE product #-}
476−product :: (Monad m, Num a) => Fold m a a
547+product :: (Monad m, Num a, Eq a) => Fold m a a
477−product = Fold (\x a -> return $ x * a) (return 1) return
548+product = Fold step (return 1) return
556+ else Partial $ x * a
479------------------------------------------------------------------------------
558------------------------------------------------------------------------------
480-- To Summary (Maybe)
559-- To Summary (Maybe)
@@ -484,13 +563,16 @@ product = Fold (\x a -> return $ x * a) (return 1) return
484-- function.
563-- function.
486-- @since 0.7.0
565-- @since 0.7.0
487−{-# INLINABLE maximumBy #-}
566+{-# INLINE maximumBy #-}
488maximumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)
567maximumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)
489maximumBy cmp = _Fold1 max'
568maximumBy cmp = _Fold1 max'
491− max' x y = case cmp x y of
573+ case cmp x y of
@@ -502,20 +584,23 @@ maximumBy cmp = _Fold1 max'
502-- Compare with @FL.foldMap Max@.
584-- Compare with @FL.foldMap Max@.
504-- @since 0.7.0
586-- @since 0.7.0
505−{-# INLINABLE maximum #-}
587+{-# INLINE maximum #-}
506maximum :: (Monad m, Ord a) => Fold m a (Maybe a)
588maximum :: (Monad m, Ord a) => Fold m a (Maybe a)
507maximum = _Fold1 max
589maximum = _Fold1 max
509-- | Computes the minimum element with respect to the given comparison function
591-- | Computes the minimum element with respect to the given comparison function
511-- @since 0.7.0
593-- @since 0.7.0
512−{-# INLINABLE minimumBy #-}
594+{-# INLINE minimumBy #-}
513minimumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)
595minimumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)
514minimumBy cmp = _Fold1 min'
596minimumBy cmp = _Fold1 min'
516− min' x y = case cmp x y of
601+ case cmp x y of
520-- | Determine the minimum element in a stream using the supplied comparison
605-- | Determine the minimum element in a stream using the supplied comparison
521-- function.
606-- function.
@@ -527,7 +612,7 @@ minimumBy cmp = _Fold1 min'
527-- Compare with @FL.foldMap Min@.
612-- Compare with @FL.foldMap Min@.
529-- @since 0.7.0
614-- @since 0.7.0
530−{-# INLINABLE minimum #-}
615+{-# INLINE minimum #-}
531minimum :: (Monad m, Ord a) => Fold m a (Maybe a)
616minimum :: (Monad m, Ord a) => Fold m a (Maybe a)
532minimum = _Fold1 min
617minimum = _Fold1 min
@@ -542,11 +627,16 @@ minimum = _Fold1 min
542{-# INLINABLE mean #-}
627{-# INLINABLE mean #-}
543mean :: (Monad m, Fractional a) => Fold m a a
628mean :: (Monad m, Fractional a) => Fold m a a
544mean = Fold step (return begin) (return . done)
629mean = Fold step (return begin) (return . done)
546 begin = Tuple' 0 0
633 begin = Tuple' 0 0
547− step (Tuple' x n) y = return $
635+ step (Tuple' x n) y =
548− let n' = n + 1
637+ $ let n' = n + 1
549− in Tuple' (x + (y - x) / n') n'
638+ in Partial $ Tuple' (x + (y - x) / n') n'
550 done (Tuple' x _) = x
640 done (Tuple' x _) = x
552-- | Compute a numerically stable (population) variance over all elements in
642-- | Compute a numerically stable (population) variance over all elements in
@@ -556,15 +646,19 @@ mean = Fold step (return begin) (return . done)
556{-# INLINABLE variance #-}
646{-# INLINABLE variance #-}
557variance :: (Monad m, Fractional a) => Fold m a a
647variance :: (Monad m, Fractional a) => Fold m a a
558variance = Fold step (return begin) (return . done)
648variance = Fold step (return begin) (return . done)
560 begin = Tuple3' 0 0 0
652 begin = Tuple3' 0 0 0
562− step (Tuple3' n mean_ m2) x = return $ Tuple3' n' mean' m2'
654+ step (Tuple3' n mean_ m2) x = return $ Partial $ Tuple3' n' mean' m2'
564− n' = n + 1
658+ n' = n + 1
565− mean' = (n * mean_ + x) / (n + 1)
659+ mean' = (n * mean_ + x) / (n + 1)
566− delta = x - mean_
660+ delta = x - mean_
567− m2' = m2 + delta * delta * n / (n + 1)
661+ m2' = m2 + delta * delta * n / (n + 1)
569 done (Tuple3' n _ m2) = m2 / n
663 done (Tuple3' n _ m2) = m2 / n
@@ -591,10 +685,15 @@ stdDev = sqrt variance
591{-# INLINABLE rollingHashWithSalt #-}
685{-# INLINABLE rollingHashWithSalt #-}
592rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64
686rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64
593rollingHashWithSalt salt = Fold step initial extract
687rollingHashWithSalt salt = Fold step initial extract
595 k = 2891336453 :: Int64
691 k = 2891336453 :: Int64
596 initial = return salt
693 initial = return salt
597− step cksum a = return $ cksum * k + fromIntegral (fromEnum a)
695+ step cksum a = return $ Partial $ cksum * k + fromIntegral (fromEnum a)
598 extract = return
697 extract = return
600-- | A default salt used in the implementation of 'rollingHash'.
699-- | A default salt used in the implementation of 'rollingHash'.
@@ -631,7 +730,7 @@ rollingHashFirstN n = ltake n rollingHash
632{-# INLINE sconcat #-}
731{-# INLINE sconcat #-}
633sconcat :: (Monad m, Semigroup a) => a -> Fold m a a
732sconcat :: (Monad m, Semigroup a) => a -> Fold m a a
634−sconcat i = Fold (\x a -> return $ x <> a) (return i) return
733+sconcat i = Fold (\x a -> return $ Partial $ x <> a) (return i) return
636-- | Fold an input stream consisting of monoidal elements using 'mappend'
735-- | Fold an input stream consisting of monoidal elements using 'mappend'
637-- and 'mempty'.
736-- and 'mempty'.
@@ -640,11 +739,12 @@ sconcat i = Fold (\x a -> return $ x <> a) (return i) return
641-- @since 0.7.0
740-- @since 0.7.0
642{-# INLINE mconcat #-}
741{-# INLINE mconcat #-}
643−mconcat :: (Monad m, Monoid a
742+mconcat ::
644−#if __GLASGOW_HASKELL__ < 804
743+ ( Monad m
744+#if !MIN_VERSION_base(4,11,0)
645 , Semigroup a
745 , Semigroup a
647− ) => Fold m a a
747+ , Monoid a) => Fold m a a
648mconcat = sconcat mempty
748mconcat = sconcat mempty
@@ -676,12 +776,16 @@ foldMap f = lmap f mconcat
676{-# INLINABLE foldMapM #-}
776{-# INLINABLE foldMapM #-}
677foldMapM :: (Monad m, Monoid b) => (a -> m b) -> Fold m a b
777foldMapM :: (Monad m, Monoid b) => (a -> m b) -> Fold m a b
678foldMapM act = Fold step begin done
778foldMapM act = Fold step begin done
680 done = return
782 done = return
681 begin = return mempty
784 begin = return mempty
682 step m a = do
786 step m a = do
683 m' <- act a
787 m' <- act a
684− return $! mappend m m'
788+ return $! Partial $! mappend m m'
686------------------------------------------------------------------------------
790------------------------------------------------------------------------------
687-- To Containers
791-- To Containers
@@ -690,14 +794,15 @@ foldMapM act = Fold step begin done
690-- | Folds the input stream to a list.
794-- | Folds the input stream to a list.
692-- /Warning!/ working on large lists accumulated as buffers in memory could be
796-- /Warning!/ working on large lists accumulated as buffers in memory could be
693−-- very inefficient, consider using "Streamly.Data.Array.Storable.Foreign" instead.
797+-- very inefficient, consider using "Streamly.Data.Array.Storable.Foreign"
695-- @since 0.7.0
800-- @since 0.7.0
697-- id . (x1 :) . (x2 :) . (x3 :) . ... . (xn :) $ []
802-- id . (x1 :) . (x2 :) . (x3 :) . ... . (xn :) $ []
698{-# INLINABLE toList #-}
803{-# INLINABLE toList #-}
699toList :: Monad m => Fold m a [a]
804toList :: Monad m => Fold m a [a]
700−toList = Fold (\f x -> return $ f . (x :))
805+toList = Fold (\f x -> return $ Partial $ f . (x :))
701 (return id)
806 (return id)
702 (return . ($ []))
807 (return . ($ []))
@@ -713,9 +818,9 @@ drainN n = ltake n drain
714-- | A fold that drains elements of its input as long as the predicate succeeds,
819-- | A fold that drains elements of its input as long as the predicate succeeds,
715-- running the effects and discarding the results.
820-- running the effects and discarding the results.
716−{-# INLINABLE drainWhile #-}
821+{-# INLINABLE drainSepBy #-}
717−drainWhile :: Monad m => (a -> Bool) -> Fold m a ()
822+drainSepBy :: Monad m => (a -> Bool) -> Fold m a ()
718−drainWhile p = ltakeWhile p drain
823+drainSepBy p = takeSepBy p drain
720------------------------------------------------------------------------------
825------------------------------------------------------------------------------
721-- To Elements
826-- To Elements
@@ -726,18 +831,15 @@ drainWhile p = ltakeWhile p drain
726-- @since 0.7.0
831-- @since 0.7.0
727{-# INLINABLE genericIndex #-}
832{-# INLINABLE genericIndex #-}
728genericIndex :: (Integral i, Monad m) => i -> Fold m a (Maybe a)
833genericIndex :: (Integral i, Monad m) => i -> Fold m a (Maybe a)
729−genericIndex i = Fold step (return $ Left' 0) done
834+genericIndex i = Fold step (return 0) (const (return Nothing))
731− step x a = return $
838+ step j a =
732− case x of
839+ return
733− Left' j -> if i == j
840+ $ if i == j
734− then Right' a
841+ then Done $ Just a
735− else Left' (j + 1)
842+ else Partial (j + 1)
742-- | Lookup the element at the given index.
844-- | Lookup the element at the given index.
@@ -765,14 +867,15 @@ head = _Fold1 const
765-- @since 0.7.0
867-- @since 0.7.0
766{-# INLINABLE find #-}
868{-# INLINABLE find #-}
767find :: Monad m => (a -> Bool) -> Fold m a (Maybe a)
869find :: Monad m => (a -> Bool) -> Fold m a (Maybe a)
768−find predicate = Fold step (return Nothing') (return . toMaybe)
870+find predicate = Fold step (return ()) (const (return Nothing))
770− step x a = return $
875+ return
772− Nothing' -> if predicate a
876+ $ if predicate a
773− then Just' a
877+ then Done (Just a)
774− else Nothing'
878+ else Partial ()
777-- | In a stream of (key-value) pairs @(a, b)@, return the value @b@ of the
880-- | In a stream of (key-value) pairs @(a, b)@, return the value @b@ of the
778-- first pair where the key equals the given value @a@.
881-- first pair where the key equals the given value @a@.
@@ -782,35 +885,30 @@ find predicate = Fold step (return Nothing') (return . toMaybe)
782-- @since 0.7.0
885-- @since 0.7.0
783{-# INLINABLE lookup #-}
886{-# INLINABLE lookup #-}
784lookup :: (Eq a, Monad m) => a -> Fold m (a,b) (Maybe b)
887lookup :: (Eq a, Monad m) => a -> Fold m (a,b) (Maybe b)
785−lookup a0 = Fold step (return Nothing') (return . toMaybe)
888+lookup a0 = Fold step (return ()) (const (return Nothing))
787− step x (a,b) = return $
789− Nothing' -> if a == a0
794−-- | Convert strict 'Either'' to lazy 'Maybe'
890+ where
795−{-# INLINABLE hush #-}
891+
796−hush :: Either' a b -> Maybe b
892+ step () (a, b) =
797−hush (Left' _) = Nothing
893+ return
798−hush (Right' b) = Just b
894+ $ if a == a0
800-- | Returns the first index that satisfies the given predicate.
898-- | Returns the first index that satisfies the given predicate.
802-- @since 0.7.0
900-- @since 0.7.0
803{-# INLINABLE findIndex #-}
901{-# INLINABLE findIndex #-}
804findIndex :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)
902findIndex :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)
805−findIndex predicate = Fold step (return $ Left' 0) (return . hush)
903+findIndex predicate = Fold step (return 0) (const (return Nothing))
807− step x a = return $
907+ step i a =
808− case x of
908+ return
810− if predicate a
909+ $ if predicate a
811− then Right' i
910+ then Done $ Just i
812− else Left' (i + 1)
911+ else Partial (i + 1)
815-- | Returns the first index where a given value is found in the stream.
913-- | Returns the first index where a given value is found in the stream.
@@ -832,7 +930,7 @@ elemIndex a = findIndex (a ==)
832-- @since 0.7.0
930-- @since 0.7.0
833{-# INLINABLE null #-}
931{-# INLINABLE null #-}
834null :: Monad m => Fold m a Bool
932null :: Monad m => Fold m a Bool
835−null = Fold (\_ _ -> return False) (return True) return
933+null = Fold (\() _ -> return $ Done False) (return ()) (\() -> return True)
838-- > any p = lmap p or
936-- > any p = lmap p or
@@ -841,9 +939,19 @@ null = Fold (\_ _ -> return False) (return True) return
841-- | Returns 'True' if any of the elements of a stream satisfies a predicate.
939-- | Returns 'True' if any of the elements of a stream satisfies a predicate.
843-- @since 0.7.0
941-- @since 0.7.0
844−{-# INLINABLE any #-}
942+{-# INLINE any #-}
845any :: Monad m => (a -> Bool) -> Fold m a Bool
943any :: Monad m => (a -> Bool) -> Fold m a Bool
846−any predicate = Fold (\x a -> return $ x || predicate a) (return False) return
944+any predicate = Fold step initial return
948+ initial = return False
848-- | Return 'True' if the given element is present in the stream.
956-- | Return 'True' if the given element is present in the stream.
@@ -863,7 +971,17 @@ elem a = any (a ==)
863-- @since 0.7.0
971-- @since 0.7.0
864{-# INLINABLE all #-}
972{-# INLINABLE all #-}
865all :: Monad m => (a -> Bool) -> Fold m a Bool
973all :: Monad m => (a -> Bool) -> Fold m a Bool
866−all predicate = Fold (\x a -> return $ x && predicate a) (return True) return
974+all predicate = Fold step initial return
978+ initial = return True
868-- | Returns 'True' if the given element is not present in the stream.
986-- | Returns 'True' if the given element is not present in the stream.
@@ -880,9 +998,9 @@ notElem a = all (a /=)
880-- > and = fmap getAll . FL.foldMap All
998-- > and = fmap getAll . FL.foldMap All
882-- @since 0.7.0
1000-- @since 0.7.0
883−{-# INLINABLE and #-}
1001+{-# INLINE and #-}
884and :: Monad m => Fold m Bool Bool
1002and :: Monad m => Fold m Bool Bool
885−and = Fold (\x a -> return $ x && a) (return True) return
1003+and = all (== True)
887-- | Returns 'True' if any element is 'True', 'False' otherwise
1005-- | Returns 'True' if any element is 'True', 'False' otherwise
@@ -890,9 +1008,9 @@ and = Fold (\x a -> return $ x && a) (return True) return
890-- > or = fmap getAny . FL.foldMap Any
1008-- > or = fmap getAny . FL.foldMap Any
892-- @since 0.7.0
1010-- @since 0.7.0
893−{-# INLINABLE or #-}
1011+{-# INLINE or #-}
894or :: Monad m => Fold m Bool Bool
1012or :: Monad m => Fold m Bool Bool
895−or = Fold (\x a -> return $ x || a) (return False) return
1013+or = any (== True)
897------------------------------------------------------------------------------
1015------------------------------------------------------------------------------
898-- Grouping/Splitting
1016-- Grouping/Splitting
@@ -905,7 +1023,7 @@ or = Fold (\x a -> return $ x || a) (return False) return
905------------------------------------------------------------------------------
1023------------------------------------------------------------------------------
906-- Binary APIs
1024-- Binary APIs
907------------------------------------------------------------------------------
1025------------------------------------------------------------------------------
909-- XXX These would just be applicative compositions of terminating folds.
1027-- XXX These would just be applicative compositions of terminating folds.
911-- | @splitAt n f1 f2@ composes folds @f1@ and @f2@ such that first @n@
1029-- | @splitAt n f1 f2@ composes folds @f1@ and @f2@ such that first @n@
@@ -944,17 +1062,7 @@ splitAt
944 -> Fold m a b
1062 -> Fold m a b
945 -> Fold m a c
1063 -> Fold m a c
946 -> Fold m a (b, c)
1064 -> Fold m a (b, c)
947−splitAt n (Fold stepL initialL extractL) (Fold stepR initialR extractR) =
1065+splitAt n fld1 = splitWith (,) (ltake n fld1)
948− Fold step initial extract
950− initial = Tuple3' n <$> initialL <*> initialR
952− step (Tuple3' i xL xR) input =
954− then stepL xL input >>= (\a -> return (Tuple3' (i - 1) a xR))
955− else stepR xR input >>= (return . Tuple3' i xL)
957− extract (Tuple3' _ a b) = (,) <$> extractL a <*> extractR b
959------------------------------------------------------------------------------
1067------------------------------------------------------------------------------
960-- Element Aware APIs
1068-- Element Aware APIs
@@ -964,12 +1072,71 @@ splitAt n (Fold stepL initialL extractL) (Fold stepR initialR extractR) =
964-- Binary APIs
1072-- Binary APIs
965------------------------------------------------------------------------------
1073------------------------------------------------------------------------------
1075+-- | Stops the fold at an infixed separator element, dropping the separator.
1078+-- "--.--" => "--" "--"
1083+-- * Stops - when the predicate succeeds.
1086+{-# INLINE sliceSepBy #-}
1087+sliceSepBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b
1088+sliceSepBy predicate (Fold fstep finitial fextract) = Fold step initial fextract
1095+ if not (predicate a)
1097+ else Done <$> fextract s
1099+-- | Like 'sliceSepBy' but does not drop the seperator element.
1102+-- "--.--" => "--." "--"
1103+-- "--." => "--." ""
1104+-- ".--" => "." "--"
1107+-- * Stops - when the predicate succeeds.
1110+{-# INLINE sliceSepWith #-}
1111+sliceSepWith :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b
1112+sliceSepWith predicate (Fold fstep finitial fextract) =
1113+ Fold step initial fextract
1120+ if not (predicate a)
1125+ Partial sres -> Done <$> fextract sres
1126+ Done bres -> return $ Done bres
1128+data SpanByState a bl fl fr
1129+ = SpanByLeft0 !fl !fr
1130+ | SpanByLeft !a !fl !fr
1131+ | SpanByRight !bl !fr
967-- | Break the input stream into two groups, the first group takes the input as
1133-- | Break the input stream into two groups, the first group takes the input as
968-- long as the predicate applied to the first element of the stream and next
1134-- long as the predicate applied to the first element of the stream and next
969-- input element holds 'True', the second group takes the rest of the input.
1135-- input element holds 'True', the second group takes the rest of the input.
971-- /Internal/
1137-- /Internal/
1139+{-# INLINE spanBy #-}
974 :: Monad m
1141 :: Monad m
975 => (a -> a -> Bool)
1142 => (a -> a -> Bool)
@@ -980,29 +1147,52 @@ spanBy cmp (Fold stepL initialL extractL) (Fold stepR initialR extractR) =
980 Fold step initial extract
1147 Fold step initial extract
983− initial = Tuple3' <$> initialL <*> initialR <*> return (Tuple' Nothing True)
985− step (Tuple3' a b (Tuple' (Just frst) isFirstG)) input =
1151+ initial = SpanByLeft0 <$> initialL <*> initialR
1153+ step (SpanByLeft0 fl fr) input = do
1154+ sfl <- stepL fl input
1158+ Partial fl1 -> SpanByLeft input fl1 fr
1159+ Done bl -> SpanByRight bl fr
1160+ step (SpanByLeft frst fl fr) input =
986− if cmp frst input && isFirstG
1161+ if cmp frst input
987− then stepL a input
1163+ sfl <- stepL fl input
988− >>= (\a' -> return (Tuple3' a' b (Tuple' (Just frst) isFirstG)))
1164+ return
1167+ Partial fl1 -> SpanByLeft frst fl1 fr
1168+ Done bl -> SpanByRight bl fr
989− else stepR b input
1171+ sfr <- stepR fr input
990− >>= (\a' -> return (Tuple3' a a' (Tuple' Nothing False)))
1172+ return
992− step (Tuple3' a b (Tuple' Nothing isFirstG)) input =
1174+ Partial fr1 -> Partial $ SpanByRight bl fr1
993− if isFirstG
1175+ Done br -> Done (bl, br)
994− then stepL a input
1176+ step (SpanByRight bl fr) input = do
995− >>= (\a' -> return (Tuple3' a' b (Tuple' (Just input) isFirstG)))
1177+ sfr <- stepR fr input
996− else stepR b input
1178+ return
997− >>= (\a' -> return (Tuple3' a a' (Tuple' Nothing False)))
1179+ $ case sfr of
998−
1180+ Partial fr1 -> Partial $ SpanByRight bl fr1
1181+ Done br -> Done (bl, br)
1183+ extract (SpanByLeft0 fl fr) = (,) <$> extractL fl <*> extractR fr
999− extract (Tuple3' a b _) = (,) <$> extractL a <*> extractR b
1184+ extract (SpanByLeft _ fl fr) = (,) <$> extractL fl <*> extractR fr
1185+ extract (SpanByRight bl fr) = (bl, ) <$> extractR fr
1187+data SpanState bl fl fr
1189+ | SpanRight !bl !fr
1001-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
1191-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
1002-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
1192-- input as long as the predicate @p@ is 'True'. @f2@ consumes the rest of the
1003-- input.
1193-- input.
1005−-- > let span_ p xs = S.fold (S.span p FL.toList FL.toList) $ S.fromList xs
1195+-- > let span_ p xs = S.fold (FL.span p FL.toList FL.toList) $ S.fromList xs
1007-- >>> span_ (< 1) [1,2,3]
1197-- >>> span_ (< 1) [1,2,3]
1008-- > ([],[1,2,3])
1198-- > ([],[1,2,3])
@@ -1029,14 +1219,33 @@ span p (Fold stepL initialL extractL) (Fold stepR initialR extractR) =
1032− initial = Tuple3' <$> initialL <*> initialR <*> return True
1222+ initial = SpanLeft <$> initialL <*> initialR
1034− step (Tuple3' a b isFirstG) input =
1035− if isFirstG && p input
1036− then stepL a input >>= (\a' -> return (Tuple3' a' b True))
1037− else stepR b input >>= (\a' -> return (Tuple3' a a' False))
1224+ step (SpanLeft fl fr) input =
1227+ sfl <- stepL fl input
1231+ Partial fl1 -> SpanLeft fl1 fr
1232+ Done bl -> SpanRight bl fr
1235+ sfr <- stepR fr input
1238+ Partial fr1 -> Partial $ SpanRight bl fr1
1239+ Done br -> Done (bl, br)
1240+ step (SpanRight bl fr) input = do
1241+ sfr <- stepR fr input
1244+ Partial fr1 -> Partial $ SpanRight bl fr1
1245+ Done br -> Done (bl, br)
1039− extract (Tuple3' a b _) = (,) <$> extractL a <*> extractR b
1247+ extract (SpanLeft fl fr) = (,) <$> extractL fl <*> extractR fr
1248+ extract (SpanRight bl fr) = (bl, ) <$> extractR fr
1042-- > break p = span (not . p)
1251-- > break p = span (not . p)
@@ -1082,18 +1291,43 @@ spanByRolling
1082spanByRolling cmp (Fold stepL initialL extractL) (Fold stepR initialR extractR) =
1291spanByRolling cmp (Fold stepL initialL extractL) (Fold stepR initialR extractR) =
1083 Fold step initial extract
1292 Fold step initial extract
1086− initial = Tuple3' <$> initialL <*> initialR <*> return Nothing
1088− step (Tuple3' a b (Just frst)) input =
1090− then stepL a input >>= (\a' -> return (Tuple3' a' b (Just input)))
1091− else stepR b input >>= (\b' -> return (Tuple3' a b' (Just input)))
1093− step (Tuple3' a b Nothing) input =
1094− stepL a input >>= (\a' -> return (Tuple3' a' b (Just input)))
1296+ initial = SpanByLeft0 <$> initialL <*> initialR
1298+ step (SpanByLeft0 fl fr) input = do
1299+ sfl <- stepL fl input
1303+ Partial fl1 -> SpanByLeft input fl1 fr
1304+ Done bl -> SpanByRight bl fr
1305+ step (SpanByLeft frst fl fr) input =
1308+ sfl <- stepL fl input
1312+ Partial fl1 -> SpanByLeft input fl1 fr
1313+ Done bl -> SpanByRight bl fr
1316+ sfr <- stepR fr input
1319+ Partial fr1 -> Partial $ SpanByRight bl fr1
1320+ Done br -> Done (bl, br)
1321+ step (SpanByRight bl fr) input = do
1322+ sfr <- stepR fr input
1325+ Partial fr1 -> Partial $ SpanByRight bl fr1
1326+ Done br -> Done (bl, br)
1328+ extract (SpanByLeft0 fl fr) = (,) <$> extractL fl <*> extractR fr
1096− extract (Tuple3' a b _) = (,) <$> extractL a <*> extractR b
1329+ extract (SpanByLeft _ fl fr) = (,) <$> extractL fl <*> extractR fr
1330+ extract (SpanByRight bl fr) = (bl, ) <$> extractR fr
1098------------------------------------------------------------------------------
1332------------------------------------------------------------------------------
1099-- Binary splitting on a separator
1333-- Binary splitting on a separator
@@ -1132,25 +1366,19 @@ breakOn pat f m = undefined
1132-- @since 0.7.0
1366-- @since 0.7.0
1133{-# INLINE tee #-}
1367{-# INLINE tee #-}
1134tee :: Monad m => Fold m a b -> Fold m a c -> Fold m a (b,c)
1368tee :: Monad m => Fold m a b -> Fold m a c -> Fold m a (b,c)
1135−tee f1 f2 = (,) <$> f1 <*> f2
1369+tee = teeWith (,)
1137{-# INLINE foldNil #-}
1371{-# INLINE foldNil #-}
1138foldNil :: Monad m => Fold m a [b]
1372foldNil :: Monad m => Fold m a [b]
1139foldNil = Fold step begin done where
1373foldNil = Fold step begin done where
1140 begin = return []
1374 begin = return []
1141− step _ _ = return []
1375+ step _ _ = return $ Partial []
1142 done = return
1376 done = return
1378+-- XXX How is the performance?
1144{-# INLINE foldCons #-}
1379{-# INLINE foldCons #-}
1145foldCons :: Monad m => Fold m a b -> Fold m a [b] -> Fold m a [b]
1380foldCons :: Monad m => Fold m a b -> Fold m a [b] -> Fold m a [b]
1146−foldCons (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
1381+foldCons = teeWith (:)
1147− Fold step begin done
1151− begin = Tuple' <$> beginL <*> beginR
1152− step (Tuple' xL xR) a = Tuple' <$> stepL xL a <*> stepR xR a
1153− done (Tuple' xL xR) = (:) <$> doneL xL <*> doneR xR
1155-- XXX use "List" instead of "[]"?, use Array for output to scale it to a large
1383-- XXX use "List" instead of "[]"?, use Array for output to scale it to a large
1156-- number of consumers? For polymorphic case a vector could be helpful. For
1384-- number of consumers? For polymorphic case a vector could be helpful. For
@@ -1178,27 +1406,53 @@ foldCons (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
1178distribute :: Monad m => [Fold m a b] -> Fold m a [b]
1406distribute :: Monad m => [Fold m a b] -> Fold m a [b]
1179distribute = foldr foldCons foldNil
1407distribute = foldr foldCons foldNil
1409+-- XXX This is 2x times faster wiithout the terminating condition.
1181-- | Like 'distribute' but for folds that return (), this can be more efficient
1410-- | Like 'distribute' but for folds that return (), this can be more efficient
1182−-- than 'distribute' as it does not need to maintain state.
1411+-- than 'distribute' as it does not need to maintain state. This fold terminates
1412+-- when all the folds terminate.
1184{-# INLINE distribute_ #-}
1414{-# INLINE distribute_ #-}
1185distribute_ :: Monad m => [Fold m a ()] -> Fold m a ()
1415distribute_ :: Monad m => [Fold m a ()] -> Fold m a ()
1186distribute_ fs = Fold step initial extract
1416distribute_ fs = Fold step initial extract
1188− initial = Prelude.mapM (\(Fold s i e) ->
1420+ initial = Prelude.mapM initialize fs
1189− i >>= \r -> return (Fold s (return r) e)) fs
1421+
1422+ -- XXX This itself can be a recursive function but we might face inlining
1424+ step [] _ = return $ Done ()
1190− step ss a = do
1425+ step ss a = do
1191− Prelude.mapM_ (\(Fold s i _) -> i >>= \r -> void (s r a)) ss
1426+ !ss1 <- go ss a
1428+ $ if Prelude.null ss1
1432+ go [] _ = return []
1433+ go ((Fold s i d):ss) a = do
1439+ let fld = Fold s (return i2) d
1192− return ss
1440+ return $ fld : rst
1193− extract =
1443+ extract ss = go1 ss
1194− Prelude.mapM_ (\(Fold _ i e) -> i >>= \r -> e r)
1444+
1446+ go1 ((Fold _ i d):ss) = (i >>= d) >> go1 ss
1196------------------------------------------------------------------------------
1448------------------------------------------------------------------------------
1197-- Partitioning
1449-- Partitioning
1198------------------------------------------------------------------------------
1450------------------------------------------------------------------------------
1200-- | Partition the input over two folds using an 'Either' partitioning
1452-- | Partition the input over two folds using an 'Either' partitioning
1201−-- predicate.
1453+-- predicate. This fold terminates when both the folds terminate.
1455+-- See also: 'partitionByFstM' and 'partitionByMinM'.
@@ -1241,23 +1495,85 @@ distribute_ fs = Fold step initial extract
1241partitionByM :: Monad m
1495partitionByM :: Monad m
1242 => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
1496 => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
1243partitionByM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
1497partitionByM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
1245 Fold step begin done
1498 Fold step begin done
1249− begin = Tuple' <$> beginL <*> beginR
1503+ sL <- beginL
1250− step (Tuple' xL xR) a = do
1504+ sR <- beginR
1505+ return $ RunBoth sL sR
1507+ step (RunBoth sL sR) a = do
1515+ Partial sres -> RunBoth sres sR
1516+ Done bres -> RunRight bres sR
1522+ Partial sres -> RunBoth sL sres
1523+ Done bres -> RunLeft sL bres
1524+ step (RunLeft sL bR) a = do
1531+ Partial sres -> Partial $ RunLeft sres bR
1532+ Done bres -> Done (bres, bR)
1533+ Right _ -> return $ Partial $ RunLeft sL bR
1534+ step (RunRight bL sR) a = do
1251 r <- f a
1535 r <- f a
1252 case r of
1536 case r of
1253− Left b -> Tuple' <$> stepL xL b <*> return xR
1537+ Left _ -> return $ Partial $ RunRight bL sR
1254− Right c -> Tuple' xL <$> stepR xR c
1538+ Right c -> do
1255− done (Tuple' xL xR) = (,) <$> doneL xL <*> doneR xR
1539+ res <- stepR sR c
1542+ Partial sres -> Partial $ RunRight bL sres
1543+ Done bres -> Done (bL, bres)
1545+ done (RunBoth sL sR) = do
1549+ done (RunLeft sL bR) = do
1552+ done (RunRight bL sR) = do
1556+-- | Similar to 'partitionByM' but terminates when the first fold terminates.
1560+{-# INLINE partitionByFstM #-}
1561+partitionByFstM :: -- Monad m =>
1562+ (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
1563+partitionByFstM = undefined
1565+-- | Similar to 'partitionByM' but terminates when any fold terminates.
1569+{-# INLINE partitionByMinM #-}
1570+partitionByMinM :: -- Monad m =>
1571+ (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
1572+partitionByMinM = undefined
1257-- Note: we could use (a -> Bool) instead of (a -> Either b c), but the latter
1574-- Note: we could use (a -> Bool) instead of (a -> Either b c), but the latter
1258-- makes the signature clearer as to which case belongs to which fold.
1575-- makes the signature clearer as to which case belongs to which fold.
1259-- XXX need to check the performance in both cases.
1576-- XXX need to check the performance in both cases.
1261-- | Same as 'partitionByM' but with a pure partition function.
1577-- | Same as 'partitionByM' but with a pure partition function.
1263-- Count even and odd numbers in a stream:
1579-- Count even and odd numbers in a stream:
@@ -1331,31 +1647,36 @@ demuxWith f kv = Fold step initial extract
1334− initial = return kv
1650+ initial = Tuple' Map.empty <$> Prelude.mapM initialize kv
1335−-- alterF is available only since containers version 0.5.8.2
1651+
1336−#if MIN_VERSION_containers(0,5,8)
1652+ step (Tuple' bmp mp) a =
1337− step mp a = case f a of
1653+ if Map.size mp > 0
1338− (k, a') -> Map.alterF twiddle k mp
1654+ then do
1339− -- XXX should we raise an exception in Nothing case?
1655+ let (k, a') = f a
1340− -- Ideally we should enforce that it is a total map over k so that look
1656+ case Map.lookup k mp of
1341− -- up never fails
1657+ Nothing -> return $ Partial $ Tuple' bmp mp
1342− -- XXX we could use a monadic update function for a single lookup and
1658+ Just (Fold stp ini dn) -> do
1343− -- update in the map.
1659+ !st <- ini
1344− where
1660+ !res <- stp st a'
1345− twiddle Nothing = pure Nothing
1661+ return
1346− twiddle (Just (Fold step' acc extract')) = do
1662+ $ case res of
1347− !r <- acc >>= \x -> step' x a'
1663+ Partial sres ->
1348− pure . Just $ Fold step' (return r) extract'
1664+ let fld = Fold stp (return sres) dn
1349−#else
1665+ mp1 = Map.insert k fld mp
1350− step mp a =
1666+ in Partial $ Tuple' bmp mp1
1351− let (k, a') = f a
1667+ Done bres ->
1352− in case Map.lookup k mp of
1668+ let mp1 = Map.delete k mp
1353− Nothing -> return mp
1669+ bmp1 = Map.insert k bres bmp
1354− Just (Fold step' acc extract') -> do
1670+ in if Map.size mp1 == 0
1355− !r <- acc >>= \x -> step' x a'
1671+ then Done bmp1
1356− return $ Map.insert k (Fold step' (return r) extract') mp
1672+ else Partial $ Tuple' bmp1 mp1
1357−#endif
1673+ -- XXX This state is reached even for an empty Map. That will change
1674+ -- once we have Step in the initial value
1675+ else error "Illegal state"
1677+ extract (Tuple' bmp mp) = do
1358− extract = Prelude.mapM (\(Fold _ acc e) -> acc >>= e)
1678+ mpe <- Prelude.mapM (\(Fold _ i d) -> i >>= d) mp
1679+ return $ bmp `Map.union` mpe
1360-- | Fold a stream of key value pairs using a map of specific folds for each
1681-- | Fold a stream of key value pairs using a map of specific folds for each
1361-- key into a map from keys to the results of fold outputs of the corresponding
1682-- key into a map from keys to the results of fold outputs of the corresponding
@@ -1374,6 +1695,9 @@ demux :: (Monad m, Ord k)
1374 => Map k (Fold m a b) -> Fold m (k, a) (Map k b)
1695 => Map k (Fold m a b) -> Fold m (k, a) (Map k b)
1375demux = demuxWith id
1696demux = demuxWith id
1698+-- data DemuxState m s = DemuxP !m !s | DemuxingOnlyMap !m
1699+data DemuxState s m1 m2 = DemuxingWithDefault !s !m1 !m2 | DemuxingOnlyMap !m2
1377{-# INLINE demuxWithDefault_ #-}
1701{-# INLINE demuxWithDefault_ #-}
1378demuxWithDefault_ :: (Monad m, Ord k)
1702demuxWithDefault_ :: (Monad m, Ord k)
1379 => (a -> (k, a')) -> Map k (Fold m a' b) -> Fold m (k, a') b -> Fold m a ()
1703 => (a -> (k, a')) -> Map k (Fold m a' b) -> Fold m (k, a') b -> Fold m a ()
@@ -1382,23 +1706,82 @@ demuxWithDefault_ f kv (Fold dstep dinitial dextract) =
1385− initFold (Fold s i e) = i >>= \r -> return (Fold s (return r) e)
1386 initial = do
1709 initial = do
1387− mp <- Prelude.mapM initFold kv
1711+ mp <- Prelude.mapM initialize kv
1388− Tuple' mp <$> dinitial
1712+ return $ DemuxingWithDefault ini Set.empty mp
1390− step (Tuple' mp dacc) a
1714+ -- XXX Some code can probably be abstracted
1715+ step (DemuxingWithDefault dacc bst mp) a =
1391− | (k, a') <- f a
1718+ let (k, a1) = f a
1392− = case Map.lookup k mp of
1719+ case Map.lookup k mp of
1393− Nothing -> do
1720+ Nothing ->
1721+ if k `Set.member` bst
1722+ then return $ Partial $ DemuxingWithDefault dacc bst mp
1394− acc <- dstep dacc (k, a')
1724+ res <- dstep dacc (k, a1)
1395− return (Tuple' mp acc)
1725+ return
1729+ DemuxingWithDefault sres bst mp
1730+ Done _ -> DemuxingOnlyMap mp
1396− Just (Fold step' acc _) -> do
1731+ Just (Fold stp ini dn) -> do
1397− _ <- acc >>= \x -> step' x a'
1732+ !st <- ini
1398− return (Tuple' mp dacc)
1733+ !res <- stp st a1
1737+ let fld = Fold stp (return sres) dn
1738+ mp1 = Map.insert k fld mp
1739+ in Partial $ DemuxingWithDefault dacc bst mp1
1741+ -- XXX We can skip the check here
1742+ if Map.size mp == 1
1745+ $ DemuxingWithDefault
1749+ -- XXX This state is reached even for an empty Map. That will change
1750+ -- once we have Step in the initial value
1751+ else error "Illegal state"
1752+ -- XXX Reduce code duplication?
1753+ step (DemuxingOnlyMap mp) a =
1757+ case Map.lookup k mp of
1758+ Nothing -> return $ Partial $ DemuxingOnlyMap mp
1759+ Just (Fold stp ini dn) -> do
1769+ (Fold stp (return sres) dn)
1772+ if Map.size mp == 1
1775+ $ DemuxingOnlyMap $ Map.delete k mp
1776+ -- XXX This state is reached even for an empty Map. That will change
1777+ -- once we have Step in the initial value
1778+ else error "Illegal state"
1399− extract (Tuple' mp dacc) = do
1780+ extract (DemuxingWithDefault dacc _ mp) = do
1400 void $ dextract dacc
1781 void $ dextract dacc
1401− Prelude.mapM_ (\(Fold _ acc e) -> acc >>= e) mp
1782+ Prelude.mapM_ (\(Fold _ i d) -> i >>= d) mp
1783+ extract (DemuxingOnlyMap mp) = do
1784+ Prelude.mapM_ (\(Fold _ i d) -> i >>= d) mp
1403-- | Split the input stream based on a key field and fold each split using a
1786-- | Split the input stream based on a key field and fold each split using a
1404-- specific fold without collecting the results. Useful for cases like protocol
1787-- specific fold without collecting the results. Useful for cases like protocol
@@ -1426,20 +1809,28 @@ demuxWith_ f kv = Fold step initial extract
1429− initial =
1812+ initial = Tuple' (Map.size kv) <$> Prelude.mapM initialize kv
1430− Prelude.mapM (\(Fold s i e) ->
1813+
1431− i >>= \r -> return (Fold s (return r) e)) kv
1432− step mp a
1814+ step (Tuple' n mp) a
1433− -- XXX should we raise an exception in Nothing case?
1434− -- Ideally we should enforce that it is a total map over k so that look
1436− | (k, a') <- f a
1815+ | (k, a') <- f a =
1437− = case Map.lookup k mp of
1816+ case Map.lookup k mp of
1438− Nothing -> return mp
1817+ Nothing -> return $ Partial $ Tuple' n mp
1439− Just (Fold step' acc _) -> do
1818+ Just (Fold stp ini dn) -> do
1440− _ <- acc >>= \x -> step' x a'
1819+ !st <- ini
1441− return mp
1820+ !res <- stp st a'
1825+ let fld = Fold stp (return sres) dn
1826+ in Partial $ Tuple' n $ Map.insert k fld mp
1830+ else Partial $ Tuple' n1 $ Map.delete k mp
1832+ extract (Tuple' _ mp) = do
1442− extract = Prelude.mapM_ (\(Fold _ acc e) -> acc >>= e)
1833+ Prelude.mapM_ (\(Fold _ i d) -> i >>= d) mp
1444-- | Given a stream of key value pairs and a map from keys to folds, fold the
1835-- | Given a stream of key value pairs and a map from keys to folds, fold the
1445-- values for each key using the corresponding folds, discarding the outputs.
1836-- values for each key using the corresponding folds, discarding the outputs.
@@ -1485,17 +1876,39 @@ classifyWith f (Fold step initial extract) = Fold step' initial' extract'
1487 initial' = return Map.empty
1878 initial' = return Map.empty
1488 step' kv a =
1880 step' kv a =
1490− in case Map.lookup k kv of
1881+ case Map.lookup k kv of
1491 Nothing -> do
1882 Nothing -> do
1492 x <- initial
1883 x <- initial
1493 r <- step x a
1884 r <- step x a
1494− return $ Map.insert k r kv
1887+ $ flip (Map.insert k) kv
1889+ Partial sr -> Left' sr
1890+ Done br -> Right' br
1495 Just x -> do
1891 Just x -> do
1496− r <- step x a
1894+ r <- step s a
1497− return $ Map.insert k r kv
1897+ $ flip (Map.insert k) kv
1899+ Partial sr -> Left' sr
1900+ Done br -> Right' br
1901+ Right' _ -> return $ Partial kv
1498− extract' = Prelude.mapM extract
1908+ Prelude.mapM
1910+ Left' s -> extract s
1911+ Right' b -> return b)
1500-- | Given an input stream of key value pairs and a fold for values, fold all
1913-- | Given an input stream of key value pairs and a fold for values, fold all
1501-- the values belonging to each key. Useful for map/reduce, bucketizing the
1914-- the values belonging to each key. Useful for map/reduce, bucketizing the
@@ -1520,9 +1933,11 @@ classify fld = classifyWith fst (lmap snd fld)
1520------------------------------------------------------------------------------
1933------------------------------------------------------------------------------
1521-- Unzipping
1934-- Unzipping
1522------------------------------------------------------------------------------
1935------------------------------------------------------------------------------
1524-- | Like 'unzipWith' but with a monadic splitter function.
1937-- | Like 'unzipWith' but with a monadic splitter function.
1939+-- -- @unzipWithM f fld1 fld2 = lmapM f (unzip fld1 fld2)@
1526-- @since 0.7.0
1941-- @since 0.7.0
1527{-# INLINE unzipWithM #-}
1942{-# INLINE unzipWithM #-}
1528unzipWithM :: Monad m
1943unzipWithM :: Monad m
@@ -1532,15 +1947,68 @@ unzipWithM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =
1535− step (Tuple' xL xR) a = do
1537− Tuple' <$> stepL xL b <*> stepR xR c
1538− begin = Tuple' <$> beginL <*> beginR
1950+ begin = RunBoth <$> beginL <*> beginR
1952+ step (RunBoth sL sR) a = do
1961+ Partial sresR -> RunBoth sresL sresR
1962+ Done bresR -> RunLeft sresL bresR
1966+ Partial sresR -> Partial $ RunRight bresL sresR
1967+ Done bresR -> Done (bresL, bresR)
1968+ step (RunLeft sL bR) a = do
1973+ Partial sresL -> Partial $ RunLeft sresL bR
1974+ Done bresL -> Done (bresL, bR)
1975+ step (RunRight bL sR) a = do
1980+ Partial sresR -> Partial $ RunRight bL sresR
1981+ Done bresR -> Done (bL, bresR)
1539− done (Tuple' xL xR) = (,) <$> doneL xL <*> doneR xR
1983+ done (RunBoth sL sR) = (,) <$> doneL sL <*> doneR sR
1984+ done (RunLeft sL bR) = (,) <$> doneL sL <*> return bR
1985+ done (RunRight bL sR) = (,) bL <$> doneR sR
1987+-- | Similar to 'unzipWithM' but terminates when the first fold terminates.
1991+{-# INLINE unzipWithFstM #-}
1992+unzipWithFstM :: -- Monad m =>
1993+ (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
1994+unzipWithFstM = undefined
1996+-- | Similar to 'unzipWithM' but terminates when any fold terminates.
2000+{-# INLINE unzipWithMinM #-}
2001+unzipWithMinM :: -- Monad m =>
2002+ (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
2003+unzipWithMinM = undefined
1541-- | Split elements in the input stream into two parts using a pure splitter
2005-- | Split elements in the input stream into two parts using a pure splitter
1542-- function, direct each part to a different fold and zip the results.
2006-- function, direct each part to a different fold and zip the results.
2008+-- @unzipWith f fld1 fld2 = lmap f (unzip fld1 fld2)@
2010+-- This fold terminates when both the input folds terminate.
1544-- @since 0.7.0
2012-- @since 0.7.0
1545{-# INLINE unzipWith #-}
2013{-# INLINE unzipWith #-}
1546unzipWith :: Monad m
2014unzipWith :: Monad m
@@ -1569,35 +2037,9 @@ unzip = unzipWith id
1569-- Nesting
2037-- Nesting
1570------------------------------------------------------------------------------
2038------------------------------------------------------------------------------
1573−-- All the stream flattening transformations can also be applied to a fold
1576−-- | This can be used to apply all the stream generation operations on folds.
1577−lconcatMap ::(IsStream t, Monad m) => (a -> t m b)
1580−lconcatMap s f1 f2 = undefined
1583−-- All the grouping transformation that we apply to a stream can also be
1584−-- applied to a fold input stream. groupBy et al can be written as terminating
1585−-- folds and then we can apply foldChunks to use those repeatedly on a stream.
1587−-- | Apply a terminating fold repeatedly to the input of another fold.
1589−-- Compare with: Streamly.Prelude.concatMap, Streamly.Prelude.foldChunks
1593−{-# INLINABLE foldChunks #-}
1596− Fold m a b -> Fold m b c -> Fold m a c
1597−foldChunks = undefined
1600−-- XXX this would be an application of foldChunks using a terminating fold.
2042+-- XXX this would be an application of "many" using a terminating fold.
1602-- | Group the input stream into groups of elements between @low@ and @high@.
2044-- | Group the input stream into groups of elements between @low@ and @high@.
1603-- Collection starts in chunks of @low@ and then keeps doubling until we reach
2045-- Collection starts in chunks of @low@ and then keeps doubling until we reach
@@ -1625,39 +2067,43 @@ lchunksInRange low high (Fold step1 initial1 extract1)
1625{-# INLINE toParallelSVar #-}
2067{-# INLINE toParallelSVar #-}
1626toParallelSVar :: MonadIO m => SVar t m a -> Maybe WorkerInfo -> Fold m a ()
2068toParallelSVar :: MonadIO m => SVar t m a -> Maybe WorkerInfo -> Fold m a ()
1627toParallelSVar svar winfo = Fold step initial extract
2069toParallelSVar svar winfo = Fold step initial extract
1630 initial = return ()
2073 initial = return ()
1632− step () x = liftIO $ do
1633− -- XXX we can have a separate fold for unlimited buffer case to avoid a
2075+ -- XXX we can have a separate fold for unlimited buffer case to avoid a
1634− -- branch in the step here.
2076+ -- branch in the step here.
1635− decrementBufferLimit svar
2079+ decrementBufferLimit svar
1636− void $ send svar (ChildYield x)
2080+ void $ send svar (ChildYield x)
2081+ return $ FL.Partial ()
1638− extract () = liftIO $
1639− sendStop svar winfo
2083+ extract () = liftIO $ sendStop svar winfo
1641{-# INLINE toParallelSVarLimited #-}
2085{-# INLINE toParallelSVarLimited #-}
1642toParallelSVarLimited :: MonadIO m
2086toParallelSVarLimited :: MonadIO m
1643 => SVar t m a -> Maybe WorkerInfo -> Fold m a ()
2087 => SVar t m a -> Maybe WorkerInfo -> Fold m a ()
1644toParallelSVarLimited svar winfo = Fold step initial extract
2088toParallelSVarLimited svar winfo = Fold step initial extract
1647 initial = return True
2092 initial = return True
1649− step True x = liftIO $ do
2094+ step True x =
1650− yieldLimitOk <- decrementYieldLimit svar
2096+ yieldLimitOk <- decrementYieldLimit svar
1651− if yieldLimitOk
2097+ if yieldLimitOk
1652− then do
2098+ then do
1653− decrementBufferLimit svar
2099+ decrementBufferLimit svar
1654− void $ send svar (ChildYield x)
2100+ void $ send svar (ChildYield x)
1655− return True
2101+ return $ FL.Partial True
1656− else do
2102+ else do
1657− cleanupSVarFromWorker svar
2103+ cleanupSVarFromWorker svar
1658− sendStop svar winfo
2104+ sendStop svar winfo
1659− return False
2105+ return $ FL.Done ()
1660− step False _ = return False
2106+ step False _ = return $ FL.Done ()
1662 extract True = liftIO $ sendStop svar winfo
2108 extract True = liftIO $ sendStop svar winfo
1663 extract False = return ()
2109 extract False = return ()