@@ -172,6 +172,10 @@ module Streamly.Internal.Data.Fold.Types
172172 , Fold (..)
173173
174174 -- * Fold constructors
175+ , mkFoldl
176+ , mkFoldlM
177+ , mkFoldr
178+ , mkFoldrM
175179 , mkAccum
176180 , mkAccum_
177181 , mkAccumM
@@ -230,10 +234,10 @@ module Streamly.Internal.Data.Fold.Types
230234 )
231235where
232236
237+import Control.Monad (void, (>=>))
233238import Control.Concurrent (threadDelay, forkIO, killThread)
234239import Control.Concurrent.MVar (MVar, newMVar, swapMVar, readMVar)
235240import Control.Exception (SomeException(..), catch, mask)
236−import Control.Monad (void)
237241import Control.Monad.IO.Class (MonadIO(..))
238242import Control.Monad.Trans.Control (control)
239243import Data.Bifunctor (Bifunctor(..))
@@ -296,6 +300,11 @@ instance Functor (Step s) where
296300 {-# INLINE fmap #-}
297301 fmap = second
298302
303+-- The Step functor around b allows expressing early termination like a right
304+-- fold. Traditional list right folds use function composition and laziness to
305+-- terminate early whereas we use data constructors. It allows stream fusion in
306+-- contrast to the foldr/build fusion when composing with functions.
307+
299308-- | The type @Fold m a b@ having constructor @Fold step initial extract@
300309-- represents a left fold over an input stream of values of type @a@ to a
301310-- single value of type @b@ in 'Monad' @m@. The constructor is not exposed via
@@ -318,16 +327,41 @@ data Fold m a b =
318327 forall s. Fold (s -> a -> m (Step s b)) (m (Step s b)) (s -> m b)
319328
320329------------------------------------------------------------------------------
321−-- Smart constructors
330+-- Left fold constructors
322331------------------------------------------------------------------------------
323332
333+-- | Make a fold from a left fold style pure step function and initial value of
334+-- the accumulator.
335+--
336+-- /Pre-release/
337+--
338+{-# INLINE mkFoldl #-}
339+mkFoldl :: Monad m => (b -> a -> b) -> b -> Fold m a b
340+mkFoldl step initial =
341+ Fold
342+ (\s a -> return $ Partial $ step s a)
343+ (return (Partial initial))
344+ return
345+
346+-- | Make a fold from a left fold style monadic step function and initial value
347+-- of the accumulator.
348+--
349+-- /Pre-release/
350+--
351+{-# INLINE mkFoldlM #-}
352+mkFoldlM :: Monad m => (b -> a -> m b) -> m b -> Fold m a b
353+mkFoldlM step initial =
354+ Fold (\s a -> Partial <$> step s a) (Partial <$> initial) return
355+
324356-- | Make an accumulating (non-terminating) fold using a pure step function, a
325357-- pure initial state and a pure state extraction function.
326358--
327359-- If your 'Fold' returns only 'Partial' (i.e. never returns a 'Done') then you
328360-- can use @mkAccum*@ constructors.
329361--
330−-- /Pre-release/
362+-- > mkAccum step initial extract = fmap extract (mkFoldl step initial)
363+--
364+-- /Internal/
331365--
332366{-# INLINE mkAccum #-}
333367mkAccum :: Monad m => (s -> a -> s) -> s -> (s -> b) -> Fold m a b
@@ -344,16 +378,18 @@ mkAccum step initial extract =
344378-- mkAccum_ step initial = mkAccum step initial id
345379-- @
346380--
347−-- /Pre-release/
381+-- /Internal/
348382--
349383{-# INLINE mkAccum_ #-}
350384mkAccum_ :: Monad m => (b -> a -> b) -> b -> Fold m a b
351−mkAccum_ step initial = mkAccum step initial id
385+mkAccum_ = mkFoldl
352386
353387-- | Make an accumulating (non-terminating) fold with an effectful step
354388-- function, an initial state, and a state extraction function.
355389--
356−-- /Pre-release/
390+-- > mkAccumM step initial extract = rmapM extract (mkFoldlM step initial)
391+--
392+-- /Internal/
357393--
358394{-# INLINE mkAccumM #-}
359395mkAccumM :: Functor m => (s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
@@ -367,11 +403,45 @@ mkAccumM step initial =
367403-- mkAccumM_ step initial = mkAccumM step initial return
368404-- @
369405--
370−-- /Pre-release/
406+-- /Internal/
371407--
372408{-# INLINE mkAccumM_ #-}
373409mkAccumM_ :: Monad m => (b -> a -> m b) -> m b -> Fold m a b
374−mkAccumM_ step initial = mkAccumM step initial return
410+mkAccumM_ = mkFoldlM
411+
412+------------------------------------------------------------------------------
413+-- Right fold constructors
414+------------------------------------------------------------------------------
415+
416+-- | Make a fold using a right fold style step function and a terminal value.
417+-- It performs a right fold via a left fold using function composition.
418+-- This can be useful for constructing structures. For reductions this may be
419+-- very inefficient compared to using a direct fold implementation using
420+-- 'mkFold'.
421+--
422+-- For example,
423+--
424+-- > toList = mkFoldr (:) []
425+--
426+-- /Pre-release/
427+{-# INLINE mkFoldr #-}
428+mkFoldr :: Monad m => (a -> b -> b) -> b -> Fold m a b
429+mkFoldr g z = mkAccum (\f x -> f . g x) id ($ z)
430+
431+-- | Like 'mkFoldr' but with a monadic step function.
432+--
433+-- For example,
434+--
435+-- > toList = mkFoldrM (\a xs -> return $ a : xs) (return [])
436+--
437+-- /Pre-release/
438+{-# INLINE mkFoldrM #-}
439+mkFoldrM :: Monad m => (a -> b -> m b) -> m b -> Fold m a b
440+mkFoldrM g z = mkAccumM (\f x -> return $ g x >=> f) (return return) (z >>=)
441+
442+------------------------------------------------------------------------------
443+-- General fold constructors
444+------------------------------------------------------------------------------
375445
376446-- | Make a terminating fold using a pure step function, a pure initial state
377447-- and a pure state extraction function.
@@ -464,11 +534,9 @@ drain = mkAccum_ (\_ _ -> ()) ()
464534-- instead.
465535--
466536-- @since 0.7.0
467−
468−-- id . (x1 :) . (x2 :) . (x3 :) . ... . (xn :) $ []
469537{-# INLINABLE toList #-}
470538toList :: Monad m => Fold m a [a]
471−toList = mkAccum (\f x -> f . (x :)) id ($ [])
539+toList = mkFoldr (:) []
472540
473541------------------------------------------------------------------------------
474542-- Instances