-- |
-- Module      : Streamly.Internal.Data.Fold.Type
-- Copyright   : (c) 2019 Composewell Technologies
--               (c) 2013 Gabriel Gonzalez
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- = Stream Consumers
--
-- We can classify stream consumers in the following categories in order of
-- increasing complexity and power:
--
-- == Accumulators
--
-- These are the simplest folds that never fail and never terminate, they
-- accumulate the input values forever and can always accept new inputs (never
-- terminate) and always have a valid result value.  A
-- 'Streamly.Internal.Data.Fold.sum' operation is an example of an accumulator.
-- Traditional Haskell left folds like 'foldl' are accumulators.
--
-- We can distribute an input stream to two or more accumulators using a @tee@
-- style composition.  Accumulators cannot be applied on a stream one after the
-- other, which we call a @serial@ append style composition of folds. This is
-- because accumulators never terminate, since the first accumulator in a
-- series will never terminate, the next one will never get to run.
--
-- == Terminating Folds
--
-- Terminating folds are accumulators that can terminate. Once a fold
-- terminates it no longer accepts any more inputs.  Terminating folds can be
-- used in a @serial@ append style composition where one fold can be applied
-- after the other on an input stream. We can apply a terminating fold
-- repeatedly on an input stream, splitting the stream and consuming it in
-- fragments.  Terminating folds never fail, therefore, they do not need
-- backtracking.
--
-- The 'Streamly.Internal.Data.Fold.take' operation is an example of a
-- terminating fold  It terminates after consuming @n@ items. Coupled with an
-- accumulator (e.g. sum) it can be used to split and process the stream into
-- chunks of fixed size.
--
-- == Terminating Folds with Leftovers
--
-- The next upgrade after terminating folds is terminating folds with leftover
-- inputs.  Consider the example of @takeWhile@ operation, it needs to inspect
-- an element for termination decision. However, it does not consume the
-- element on which it terminates. To implement @takeWhile@ a terminating fold
-- will have to implement a way to return unconsumed input to the fold driver.
--
-- Single element leftover case is the most common and its easy to implement it
-- in terminating folds using a @Done1@ constructor in the 'Step' type which
-- indicates that the last element was not consumed by the fold. The following
-- additional operations can be implemented as terminating folds if we do that.
--
-- @
-- takeWhile
-- groupBy
-- wordBy
-- @
--
-- However, it creates several complications.  The 'many' combinator  requires
-- a @Partial1@ ('Partial' with leftover) to handle a @Done1@ from the top
-- level fold, for efficient implementation.  If the collecting fold in "many"
-- returns a @Partial1@ or @Done1@ then what to do with all the elements that
-- have been consumed?
--
-- Similarly, in distribute, if one fold consumes a value and others say its a
-- leftover then what do we do?  Folds like "many" require the leftover to be
-- fed to it again. So in a distribute operation those folds which gave a
-- leftover will have to be fed the leftover while the folds that consumed will
-- have to be fed the next input.  This is very complicated to implement. We
-- have the same issue in backtracking parsers being used in a distribute
-- operation.
--
-- To avoid these issues we want to enforce by typing that the collecting folds
-- can never return a leftover. So we need a fold type without @Done1@ or
-- @Partial1@. This leads us to design folds to never return a leftover and the
-- use cases of single leftover are transferred to parsers where we have
-- general backtracking mechanism and single leftover is just a special case of
-- backtracking.
--
-- This means: takeWhile, groupBy, wordBy would be implemented as parsers.
-- "take 0" can implemented as a fold if we make initial return @Step@ type.
-- "takeInterval" can be implemented without @Done1@.
--
-- == Parsers
--
-- The next upgrade after terminating folds with a leftover are parsers.
-- Parsers are terminating folds that can fail and backtrack. Parsers can be
-- composed using an @alternative@ style composition where they can backtrack
-- and apply another parser if one parser fails.
-- 'Streamly.Internal.Data.Parser.satisfy' is a simple example of a parser, it
-- would succeed if the condition is satisfied and it would fail otherwise, on
-- failure an alternative parser can be used on the same input.
--
-- = Types for Stream Consumers
--
-- In streamly, there is no separate type for accumulators. Terminating folds
-- are a superset of accumulators and to avoid too many types we represent both
-- using the same type, 'Fold'.
--
-- We do not club the leftovers functionality with terminating folds because of
-- the reasons explained earlier. Instead combinators that require leftovers
-- are implemented as the 'Streamly.Internal.Data.Parser.Parser' type.  This is
-- a sweet spot to balance ease of use, type safety and performance.  Using
-- separate Accumulator and terminating fold types would encode more
-- information in types but it would make ease of use, implementation,
-- maintenance effort worse. Combining Accumulator, terminating folds and
-- Parser into a single 'Streamly.Internal.Data.Parser.Parser' type would make
-- ease of use even better but type safety and performance worse.
--
-- One of the design requirements that we have placed for better ease of use
-- and code reuse is that 'Streamly.Internal.Data.Parser.Parser' type should be
-- a strict superset of the 'Fold' type i.e. it can do everything that a 'Fold'
-- can do and more. Therefore, folds can be easily upgraded to parsers and we
-- can use parser combinators on folds as well when needed.
--
-- = Fold Design
--
-- A fold is represented by a collection of "initial", "step" and "extract"
-- functions. The "initial" action generates the initial state of the fold. The
-- state is internal to the fold and maintains the accumulated output. The
-- "step" function is invoked using the current state and the next input value
-- and results in a @Partial@ or @Done@. A @Partial@ returns the next intermediate
-- state of the fold, a @Done@ indicates that the fold has terminated and
-- returns the final value of the accumulator.
--
-- Every @Partial@ indicates that a new accumulated output is available.  The
-- accumulated output can be extracted from the state at any point using
-- "extract". "extract" can never fail. A fold returns a valid output even
-- without any input i.e. even if you call "extract" on "initial" state it
-- provides an output. This is not true for parsers.
--
-- In general, "extract" is used in two cases:
--
-- * When the fold is used as a scan @extract@ is called on the intermediate
-- state every time it is yielded by the fold, the resulting value is yielded
-- as a stream.
-- * When the fold is used as a regular fold, @extract@ is called once when
-- we are done feeding input to the fold.
--
-- = Alternate Designs
--
-- An alternate and simpler design would be to return the intermediate output
-- via @Partial@ along with the state, instead of using "extract" on the yielded
-- state and remove the extract function altogether.
--
-- This may even facilitate more efficient implementation.  Extract from the
-- intermediate state after each yield may be more costly compared to the fold
-- step itself yielding the output. The fold may have more efficient ways to
-- retrieve the output rather than stuffing it in the state and using extract
-- on the state.
--
-- However, removing extract altogether may lead to less optimal code in some
-- cases because the driver of the fold needs to thread around the intermediate
-- output to return it if the stream stops before the fold could @Done@.  When
-- using this approach, the @parseMany (FL.take filesize)@ benchmark shows a
-- 2x worse performance even after ensuring everything fuses.  So we keep the
-- "extract" approach to ensure better perf in all cases.
--
-- But we could still yield both state and the output in @Partial@, the output
-- can be used for the scan use case, instead of using extract. Extract would
-- then be used only for the case when the stream stops before the fold
-- completes.
--
-- = Accumulators and Terminating Folds
--
-- Folds in this module can be classified in two categories viz. accumulators
-- and terminating folds. Accumulators do not have a terminating condition,
-- they run forever and consume the entire stream, for example the 'length'
-- fold. Terminating folds have a terminating condition and can terminate
-- without consuming the entire stream, for example, the 'head' fold.
--
-- = Monoids
--
-- Monoids allow generalized, modular folding.  The accumulators in this module
-- can be expressed using 'mconcat' and a suitable 'Monoid'.  Instead of
-- writing folds we can write Monoids and turn them into folds.
--
-- = Performance Notes
--
-- 'Streamly.Prelude' module provides fold functions to directly fold streams
-- e.g.  Streamly.Prelude/'Streamly.Prelude.sum' serves the same purpose as
-- Fold/'sum'.  However, the functions in Streamly.Prelude cannot be
-- efficiently combined together e.g. we cannot drive the input stream through
-- @sum@ and @length@ fold functions simultaneously.  Using the 'Fold' type we
-- can efficiently split the stream across multiple folds because it allows the
-- compiler to perform stream fusion optimizations.
--
module Streamly.Internal.Data.Fold.Type
    (
    -- * Types
      Step (..)
    , Fold (..)

    -- * Constructors
    , foldl'
    , foldlM'
    , foldl1'
    , foldr
    , foldrM
    , mkFold
    , mkFold_
    , mkFoldM
    , mkFoldM_

    -- * Folds
    , fromPure
    , fromEffect
    , fromRefold
    , drain
    , toList
    , toStreamK
    , toStreamKRev

    -- * Combinators

    -- ** Mapping output
    , rmapM

    -- ** Mapping Input
    , lmap
    , lmapM

    -- ** Filtering
    , filter
    , filterM
    , catMaybes

    -- ** Trimming
    , take

    -- ** Serial Append
    , serialWith -- rename to "append"
    , serial_

    -- ** Parallel Distribution
    , teeWith
    , teeWithFst
    , teeWithMin

    -- ** Parallel Alternative
    , shortest
    , longest

    -- ** Splitting
    , ManyState
    , many
    , manyPost
    , chunksOf
    , refoldMany
    , refoldMany1
    , refold

    -- ** Nesting
    , concatMap

    -- * Running A Fold
    , initialize
    , snoc
    , duplicate
    , finish
    )
where

import Control.Monad ((>=>))
import Data.Bifunctor (Bifunctor(..))
import Data.Maybe (isJust, fromJust)
import Fusion.Plugin.Types (Fuse(..))
import Streamly.Internal.Data.Fold.Step (Step(..), mapMStep, chainStepM)
import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
import Streamly.Internal.Data.Refold.Type (Refold(..))

import qualified Streamly.Internal.Data.Stream.StreamK.Type as K

import Prelude hiding (concatMap, filter, foldr, map, take)

-- $setup
-- >>> :m
-- >>> :set -XFlexibleContexts
-- >>> import Streamly.Data.Fold (Fold)
-- >>> import Prelude hiding (concatMap, filter, map)
-- >>> import Streamly.Prelude (SerialT)
-- >>> import qualified Data.Foldable as Foldable
-- >>> import qualified Streamly.Prelude as Stream
-- >>> import qualified Streamly.Data.Fold as Fold
-- >>> import qualified Streamly.Internal.Data.Fold as Fold
-- >>> import qualified Streamly.Internal.Data.Fold.Type as Fold
-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream
-- >>> import qualified Streamly.Internal.Data.Stream.StreamK as StreamK

------------------------------------------------------------------------------
-- The Fold type
------------------------------------------------------------------------------

-- An fold is akin to a writer. It is the streaming equivalent of a writer.
-- The type @b@ is the accumulator of the writer. That's the reason the
-- default folds in various modules are called "write".

-- | The type @Fold m a b@ having constructor @Fold step initial extract@
-- represents a fold over an input stream of values of type @a@ to a final
-- value of type @b@ in 'Monad' @m@.
--
-- The fold uses an intermediate state @s@ as accumulator, the type @s@ is
-- internal to the specific fold definition. The initial value of the fold
-- state @s@ is returned by @initial@. The @step@ function consumes an input
-- and either returns the final result @b@ if the fold is done or the next
-- intermediate state (see 'Step'). At any point the fold driver can extract
-- the result from the intermediate state using the @extract@ function.
--
-- NOTE: The constructor is not yet exposed via exposed modules, smart
-- constructors are provided to create folds.  If you think you need the
-- constructor of this type please consider using the smart constructors in
-- "Streamly.Internal.Data.Fold" instead.
--
-- /since 0.8.0 (type changed)/
--
-- @since 0.7.0

data Fold m a b =
  -- | @Fold @ @ step @ @ initial @ @ extract@
  forall s. Fold (s -> a -> m (Step s b)) (m (Step s b)) (s -> m b)

------------------------------------------------------------------------------
-- Mapping on the output
------------------------------------------------------------------------------

-- | Map a monadic function on the output of a fold.
--
-- @since 0.8.0
{-# INLINE rmapM #-}
rmapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c
rmapM :: (b -> m c) -> Fold m a b -> Fold m a c
rmapM b -> m c
f (Fold s -> a -> m (Step s b)
step m (Step s b)
initial s -> m b
extract) = (s -> a -> m (Step s c))
-> m (Step s c) -> (s -> m c) -> Fold m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s c)
step1 m (Step s c)
initial1 (s -> m b
extract (s -> m b) -> (b -> m c) -> s -> m c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> m c
f)

    where

    initial1 :: m (Step s c)
initial1 = m (Step s b)
initial m (Step s b) -> (Step s b -> m (Step s c)) -> m (Step s c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (b -> m c) -> Step s b -> m (Step s c)
forall (m :: * -> *) a b s.
Applicative m =>
(a -> m b) -> Step s a -> m (Step s b)
mapMStep b -> m c
f
    step1 :: s -> a -> m (Step s c)
step1 s
s a
a = s -> a -> m (Step s b)
step s
s a
a m (Step s b) -> (Step s b -> m (Step s c)) -> m (Step s c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (b -> m c) -> Step s b -> m (Step s c)
forall (m :: * -> *) a b s.
Applicative m =>
(a -> m b) -> Step s a -> m (Step s b)
mapMStep b -> m c
f

------------------------------------------------------------------------------
-- Left fold constructors
------------------------------------------------------------------------------

-- | Make a fold from a left fold style pure step function and initial value of
-- the accumulator.
--
-- If your 'Fold' returns only 'Partial' (i.e. never returns a 'Done') then you
-- can use @foldl'*@ constructors.
--
-- A fold with an extract function can be expressed using fmap:
--
-- @
-- mkfoldlx :: Monad m => (s -> a -> s) -> s -> (s -> b) -> Fold m a b
-- mkfoldlx step initial extract = fmap extract (foldl' step initial)
-- @
--
-- See also: @Streamly.Prelude.foldl'@
--
-- @since 0.8.0
--
{-# INLINE foldl' #-}
foldl' :: Monad m => (b -> a -> b) -> b -> Fold m a b
foldl' :: (b -> a -> b) -> b -> Fold m a b
foldl' b -> a -> b
step b
initial =
    (b -> a -> m (Step b b))
-> m (Step b b) -> (b -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold
        (\b
s a
a -> Step b b -> m (Step b b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step b b -> m (Step b b)) -> Step b b -> m (Step b b)
forall a b. (a -> b) -> a -> b
$ b -> Step b b
forall s b. s -> Step s b
Partial (b -> Step b b) -> b -> Step b b
forall a b. (a -> b) -> a -> b
$ b -> a -> b
step b
s a
a)
        (Step b b -> m (Step b b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Step b b
forall s b. s -> Step s b
Partial b
initial))
        b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Make a fold from a left fold style monadic step function and initial value
-- of the accumulator.
--
-- A fold with an extract function can be expressed using rmapM:
--
-- @
-- mkFoldlxM :: Functor m => (s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
-- mkFoldlxM step initial extract = rmapM extract (foldlM' step initial)
-- @
--
-- See also: @Streamly.Prelude.foldlM'@
--
-- @since 0.8.0
--
{-# INLINE foldlM' #-}
foldlM' :: Monad m => (b -> a -> m b) -> m b -> Fold m a b
foldlM' :: (b -> a -> m b) -> m b -> Fold m a b
foldlM' b -> a -> m b
step m b
initial =
    (b -> a -> m (Step b b))
-> m (Step b b) -> (b -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold (\b
s a
a -> b -> Step b b
forall s b. s -> Step s b
Partial (b -> Step b b) -> m b -> m (Step b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> a -> m b
step b
s a
a) (b -> Step b b
forall s b. s -> Step s b
Partial (b -> Step b b) -> m b -> m (Step b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
initial) b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Make a strict left fold, for non-empty streams, using first element as the
-- starting value. Returns Nothing if the stream is empty.
--
-- See also: @Streamly.Prelude.foldl1'@
--
-- /Pre-release/
{-# INLINE foldl1' #-}
foldl1' :: Monad m => (a -> a -> a) -> Fold m a (Maybe a)
foldl1' :: (a -> a -> a) -> Fold m a (Maybe a)
foldl1' a -> a -> a
step = (Maybe' a -> Maybe a) -> Fold m a (Maybe' a) -> Fold m a (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe' a -> Maybe a
forall a. Maybe' a -> Maybe a
toMaybe (Fold m a (Maybe' a) -> Fold m a (Maybe a))
-> Fold m a (Maybe' a) -> Fold m a (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Maybe' a -> a -> Maybe' a) -> Maybe' a -> Fold m a (Maybe' a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' Maybe' a -> a -> Maybe' a
step1 Maybe' a
forall a. Maybe' a
Nothing'

    where

    step1 :: Maybe' a -> a -> Maybe' a
step1 Maybe' a
Nothing' a
a = a -> Maybe' a
forall a. a -> Maybe' a
Just' a
a
    step1 (Just' a
x) a
a = a -> Maybe' a
forall a. a -> Maybe' a
Just' (a -> Maybe' a) -> a -> Maybe' a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
step a
x a
a

------------------------------------------------------------------------------
-- Right fold constructors
------------------------------------------------------------------------------

-- | Make a fold using a right fold style step function and a terminal value.
-- It performs a strict right fold via a left fold using function composition.
-- Note that this is strict fold, it can only be useful for constructing strict
-- structures in memory. For reductions this will be very inefficient.
--
-- For example,
--
-- > toList = foldr (:) []
--
-- See also: 'Streamly.Prelude.foldr'
--
-- @since 0.8.0
{-# INLINE foldr #-}
foldr :: Monad m => (a -> b -> b) -> b -> Fold m a b
foldr :: (a -> b -> b) -> b -> Fold m a b
foldr a -> b -> b
g b
z = ((b -> b) -> b) -> Fold m a (b -> b) -> Fold m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b
z) (Fold m a (b -> b) -> Fold m a b)
-> Fold m a (b -> b) -> Fold m a b
forall a b. (a -> b) -> a -> b
$ ((b -> b) -> a -> b -> b) -> (b -> b) -> Fold m a (b -> b)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' (\b -> b
f a
x -> b -> b
f (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> b
g a
x) b -> b
forall a. a -> a
id

-- XXX we have not seen any use of this yet, not releasing until we have a use
-- case.
--
-- | Like 'foldr' but with a monadic step function.
--
-- For example,
--
-- > toList = foldrM (\a xs -> return $ a : xs) (return [])
--
-- See also: 'Streamly.Prelude.foldrM'
--
-- /Pre-release/
{-# INLINE foldrM #-}
foldrM :: Monad m => (a -> b -> m b) -> m b -> Fold m a b
foldrM :: (a -> b -> m b) -> m b -> Fold m a b
foldrM a -> b -> m b
g m b
z =
    ((b -> m b) -> m b) -> Fold m a (b -> m b) -> Fold m a b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Fold m a b -> Fold m a c
rmapM (m b
z m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) (Fold m a (b -> m b) -> Fold m a b)
-> Fold m a (b -> m b) -> Fold m a b
forall a b. (a -> b) -> a -> b
$ ((b -> m b) -> a -> m (b -> m b))
-> m (b -> m b) -> Fold m a (b -> m b)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
foldlM' (\b -> m b
f a
x -> (b -> m b) -> m (b -> m b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((b -> m b) -> m (b -> m b)) -> (b -> m b) -> m (b -> m b)
forall a b. (a -> b) -> a -> b
$ a -> b -> m b
g a
x (b -> m b) -> (b -> m b) -> b -> m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> m b
f) ((b -> m b) -> m (b -> m b)
forall (m :: * -> *) a. Monad m => a -> m a
return b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return)

------------------------------------------------------------------------------
-- General fold constructors
------------------------------------------------------------------------------

-- XXX If the Step yield gives the result each time along with the state then
-- we can make the type of this as
--
-- mkFold :: Monad m => (s -> a -> Step s b) -> Step s b -> Fold m a b
--
-- Then similar to foldl' and foldr we can just fmap extract on it to extend
-- it to the version where an 'extract' function is required. Or do we even
-- need that?
--
-- Until we investigate this we are not releasing these.
--
-- XXX The above text would apply to
-- Streamly.Internal.Data.Parser.ParserD.Type.parser

-- | Make a terminating fold using a pure step function, a pure initial state
-- and a pure state extraction function.
--
-- /Pre-release/
--
{-# INLINE mkFold #-}
mkFold :: Monad m => (s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
mkFold :: (s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
mkFold s -> a -> Step s b
step Step s b
initial s -> b
extract =
    (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold (\s
s a
a -> Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ s -> a -> Step s b
step s
s a
a) (Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
initial) (b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> (s -> b) -> s -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> b
extract)

-- | Similar to 'mkFold' but the final state extracted is identical to the
-- intermediate state.
--
-- @
-- mkFold_ step initial = mkFold step initial id
-- @
--
-- /Pre-release/
--
{-# INLINE mkFold_ #-}
mkFold_ :: Monad m => (b -> a -> Step b b) -> Step b b -> Fold m a b
mkFold_ :: (b -> a -> Step b b) -> Step b b -> Fold m a b
mkFold_ b -> a -> Step b b
step Step b b
initial = (b -> a -> Step b b) -> Step b b -> (b -> b) -> Fold m a b
forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
mkFold b -> a -> Step b b
step Step b b
initial b -> b
forall a. a -> a
id

-- | Make a terminating fold with an effectful step function and initial state,
-- and a state extraction function.
--
-- > mkFoldM = Fold
--
--  We can just use 'Fold' but it is provided for completeness.
--
-- /Pre-release/
--
{-# INLINE mkFoldM #-}
mkFoldM :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> Fold m a b
mkFoldM :: (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
mkFoldM = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold

-- | Similar to 'mkFoldM' but the final state extracted is identical to the
-- intermediate state.
--
-- @
-- mkFoldM_ step initial = mkFoldM step initial return
-- @
--
-- /Pre-release/
--
{-# INLINE mkFoldM_ #-}
mkFoldM_ :: Monad m => (b -> a -> m (Step b b)) -> m (Step b b) -> Fold m a b
mkFoldM_ :: (b -> a -> m (Step b b)) -> m (Step b b) -> Fold m a b
mkFoldM_ b -> a -> m (Step b b)
step m (Step b b)
initial = (b -> a -> m (Step b b))
-> m (Step b b) -> (b -> m b) -> Fold m a b
forall s a (m :: * -> *) b.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
mkFoldM b -> a -> m (Step b b)
step m (Step b b)
initial b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return

------------------------------------------------------------------------------
-- Refold
------------------------------------------------------------------------------

-- This is similar to how we run an Unfold to generate a Stream. A Fold is like
-- a Stream and a Fold2 is like an Unfold.
--
-- | Make a fold from a consumer.
--
-- /Internal/
fromRefold :: Refold m c a b -> c -> Fold m a b
fromRefold :: Refold m c a b -> c -> Fold m a b
fromRefold (Refold s -> a -> m (Step s b)
step c -> m (Step s b)
inject s -> m b
extract) c
c =
    (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step (c -> m (Step s b)
inject c
c) s -> m b
extract

------------------------------------------------------------------------------
-- Basic Folds
------------------------------------------------------------------------------

-- | A fold that drains all its input, running the effects and discarding the
-- results.
--
-- > drain = drainBy (const (return ()))
--
-- @since 0.7.0
{-# INLINE drain #-}
drain :: Monad m => Fold m a ()
drain :: Fold m a ()
drain = (() -> a -> ()) -> () -> Fold m a ()
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' (\()
_ a
_ -> ()) ()

-- | Folds the input stream to a list.
--
-- /Warning!/ working on large lists accumulated as buffers in memory could be
-- very inefficient, consider using "Streamly.Data.Array.Foreign"
-- instead.
--
-- > toList = foldr (:) []
--
-- @since 0.7.0
{-# INLINE toList #-}
toList :: Monad m => Fold m a [a]
toList :: Fold m a [a]
toList = (a -> [a] -> [a]) -> [a] -> Fold m a [a]
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Fold m a b
foldr (:) []

-- | Buffers the input stream to a pure stream in the reverse order of the
-- input.
--
-- >>> toStreamKRev = Foldable.foldl' (flip StreamK.cons) StreamK.nil
--
-- This is more efficient than 'toStreamK'. toStreamK has exactly the same
-- performance as reversing the stream after toStreamKRev.
--
-- /Pre-release/

--  xn : ... : x2 : x1 : []
{-# INLINE toStreamKRev #-}
toStreamKRev :: Monad m => Fold m a (K.Stream n a)
toStreamKRev :: Fold m a (Stream n a)
toStreamKRev = (Stream n a -> a -> Stream n a)
-> Stream n a -> Fold m a (Stream n a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' ((a -> Stream n a -> Stream n a) -> Stream n a -> a -> Stream n a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Stream n a -> Stream n a
forall a (m :: * -> *). a -> Stream m a -> Stream m a
K.cons) Stream n a
forall (m :: * -> *) a. Stream m a
K.nil

-- | A fold that buffers its input to a pure stream.
--
-- >>> toStreamK = foldr StreamK.cons StreamK.nil
-- >>> toStreamK = fmap StreamK.reverse Fold.toStreamKRev
--
-- /Internal/
{-# INLINE toStreamK #-}
toStreamK :: Monad m => Fold m a (K.Stream n a)
toStreamK :: Fold m a (Stream n a)
toStreamK = (a -> Stream n a -> Stream n a)
-> Stream n a -> Fold m a (Stream n a)
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Fold m a b
foldr a -> Stream n a -> Stream n a
forall a (m :: * -> *). a -> Stream m a -> Stream m a
K.cons Stream n a
forall (m :: * -> *) a. Stream m a
K.nil

------------------------------------------------------------------------------
-- Instances
------------------------------------------------------------------------------

-- | Maps a function on the output of the fold (the type @b@).
instance Functor m => Functor (Fold m a) where
    {-# INLINE fmap #-}
    fmap :: (a -> b) -> Fold m a a -> Fold m a b
fmap a -> b
f (Fold s -> a -> m (Step s a)
step1 m (Step s a)
initial1 s -> m a
extract) = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step m (Step s b)
initial ((a -> b) -> (s -> m a) -> s -> m b
forall (f :: * -> *) (f :: * -> *) a b.
(Functor f, Functor f) =>
(a -> b) -> f (f a) -> f (f b)
fmap2 a -> b
f s -> m a
extract)

        where

        initial :: m (Step s b)
initial = (a -> b) -> m (Step s a) -> m (Step s b)
forall (f :: * -> *) (f :: * -> *) a b.
(Functor f, Functor f) =>
(a -> b) -> f (f a) -> f (f b)
fmap2 a -> b
f m (Step s a)
initial1
        step :: s -> a -> m (Step s b)
step s
s a
b = (a -> b) -> m (Step s a) -> m (Step s b)
forall (f :: * -> *) (f :: * -> *) a b.
(Functor f, Functor f) =>
(a -> b) -> f (f a) -> f (f b)
fmap2 a -> b
f (s -> a -> m (Step s a)
step1 s
s a
b)
        fmap2 :: (a -> b) -> f (f a) -> f (f b)
fmap2 a -> b
g = (f a -> f b) -> f (f a) -> f (f b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
g)

-- This is the dual of stream "fromPure".
--
-- | A fold that always yields a pure value without consuming any input.
--
-- /Pre-release/
--
{-# INLINE fromPure #-}
fromPure :: Applicative m => b -> Fold m a b
fromPure :: b -> Fold m a b
fromPure b
b = (b -> a -> m (Step b b))
-> m (Step b b) -> (b -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold b -> a -> m (Step b b)
forall a. HasCallStack => a
undefined (Step b b -> m (Step b b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step b b -> m (Step b b)) -> Step b b -> m (Step b b)
forall a b. (a -> b) -> a -> b
$ b -> Step b b
forall s b. b -> Step s b
Done b
b) b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- This is the dual of stream "fromEffect".
--
-- | A fold that always yields the result of an effectful action without
-- consuming any input.
--
-- /Pre-release/
--
{-# INLINE fromEffect #-}
fromEffect :: Applicative m => m b -> Fold m a b
fromEffect :: m b -> Fold m a b
fromEffect m b
b = (b -> a -> m (Step b b))
-> m (Step b b) -> (b -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold b -> a -> m (Step b b)
forall a. HasCallStack => a
undefined (b -> Step b b
forall s b. b -> Step s b
Done (b -> Step b b) -> m b -> m (Step b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
b) b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure

{-# ANN type SeqFoldState Fuse #-}
data SeqFoldState sl f sr = SeqFoldL !sl | SeqFoldR !f !sr

-- | Sequential fold application. Apply two folds sequentially to an input
-- stream.  The input is provided to the first fold, when it is done - the
-- remaining input is provided to the second fold. When the second fold is done
-- or if the input stream is over, the outputs of the two folds are combined
-- using the supplied function.
--
-- >>> f = Fold.serialWith (,) (Fold.take 8 Fold.toList) (Fold.takeEndBy (== '\n') Fold.toList)
-- >>> Stream.fold f $ Stream.fromList "header: hello\n"
-- ("header: ","hello\n")
--
-- Note: This is dual to appending streams using 'Streamly.Prelude.serial'.
--
-- Note: this implementation allows for stream fusion but has quadratic time
-- complexity, because each composition adds a new branch that each subsequent
-- fold's input element has to traverse, therefore, it cannot scale to a large
-- number of compositions. After around 100 compositions the performance starts
-- dipping rapidly compared to a CPS style implementation.
--
-- /Time: O(n^2) where n is the number of compositions./
--
-- @since 0.8.0
--
{-# INLINE serialWith #-}
serialWith :: Monad m =>
    (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
serialWith :: (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
serialWith a -> b -> c
func (Fold s -> x -> m (Step s a)
stepL m (Step s a)
initialL s -> m a
extractL) (Fold s -> x -> m (Step s b)
stepR m (Step s b)
initialR s -> m b
extractR) =
    (SeqFoldState s (b -> c) s
 -> x -> m (Step (SeqFoldState s (b -> c) s) c))
-> m (Step (SeqFoldState s (b -> c) s) c)
-> (SeqFoldState s (b -> c) s -> m c)
-> Fold m x c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold SeqFoldState s (b -> c) s
-> x -> m (Step (SeqFoldState s (b -> c) s) c)
step m (Step (SeqFoldState s (b -> c) s) c)
initial SeqFoldState s (b -> c) s -> m c
extract

    where

    {-# INLINE runR #-}
    runR :: f (p sr c) -> (c -> d) -> f (p (SeqFoldState sl (c -> d) sr) d)
runR f (p sr c)
action c -> d
f = (sr -> SeqFoldState sl (c -> d) sr)
-> (c -> d) -> p sr c -> p (SeqFoldState sl (c -> d) sr) d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((c -> d) -> sr -> SeqFoldState sl (c -> d) sr
forall sl f sr. f -> sr -> SeqFoldState sl f sr
SeqFoldR c -> d
f) c -> d
f (p sr c -> p (SeqFoldState sl (c -> d) sr) d)
-> f (p sr c) -> f (p (SeqFoldState sl (c -> d) sr) d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (p sr c)
action

    {-# INLINE runL #-}
    runL :: m (Step sl a) -> m (Step (SeqFoldState sl (b -> c) s) c)
runL m (Step sl a)
action = do
        Step sl a
resL <- m (Step sl a)
action
        (sl -> m (SeqFoldState sl (b -> c) s))
-> (a -> m (Step (SeqFoldState sl (b -> c) s) c))
-> Step sl a
-> m (Step (SeqFoldState sl (b -> c) s) c)
forall (m :: * -> *) s1 s2 a b.
Applicative m =>
(s1 -> m s2) -> (a -> m (Step s2 b)) -> Step s1 a -> m (Step s2 b)
chainStepM (SeqFoldState sl (b -> c) s -> m (SeqFoldState sl (b -> c) s)
forall (m :: * -> *) a. Monad m => a -> m a
return (SeqFoldState sl (b -> c) s -> m (SeqFoldState sl (b -> c) s))
-> (sl -> SeqFoldState sl (b -> c) s)
-> sl
-> m (SeqFoldState sl (b -> c) s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. sl -> SeqFoldState sl (b -> c) s
forall sl f sr. sl -> SeqFoldState sl f sr
SeqFoldL) (m (Step s b) -> (b -> c) -> m (Step (SeqFoldState sl (b -> c) s) c)
forall (f :: * -> *) (p :: * -> * -> *) sr c d sl.
(Functor f, Bifunctor p) =>
f (p sr c) -> (c -> d) -> f (p (SeqFoldState sl (c -> d) sr) d)
runR m (Step s b)
initialR ((b -> c) -> m (Step (SeqFoldState sl (b -> c) s) c))
-> (a -> b -> c) -> a -> m (Step (SeqFoldState sl (b -> c) s) c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c
func) Step sl a
resL

    initial :: m (Step (SeqFoldState s (b -> c) s) c)
initial = m (Step s a) -> m (Step (SeqFoldState s (b -> c) s) c)
forall sl. m (Step sl a) -> m (Step (SeqFoldState sl (b -> c) s) c)
runL m (Step s a)
initialL

    step :: SeqFoldState s (b -> c) s
-> x -> m (Step (SeqFoldState s (b -> c) s) c)
step (SeqFoldL s
st) x
a = m (Step s a) -> m (Step (SeqFoldState s (b -> c) s) c)
forall sl. m (Step sl a) -> m (Step (SeqFoldState sl (b -> c) s) c)
runL (s -> x -> m (Step s a)
stepL s
st x
a)
    step (SeqFoldR b -> c
f s
st) x
a = m (Step s b) -> (b -> c) -> m (Step (SeqFoldState s (b -> c) s) c)
forall (f :: * -> *) (p :: * -> * -> *) sr c d sl.
(Functor f, Bifunctor p) =>
f (p sr c) -> (c -> d) -> f (p (SeqFoldState sl (c -> d) sr) d)
runR (s -> x -> m (Step s b)
stepR s
st x
a) b -> c
f

    extract :: SeqFoldState s (b -> c) s -> m c
extract (SeqFoldR b -> c
f s
sR) = (b -> c) -> m b -> m c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f (s -> m b
extractR s
sR)
    extract (SeqFoldL s
sL) = do
        a
rL <- s -> m a
extractL s
sL
        Step s b
res <- m (Step s b)
initialR
        (b -> c) -> m b -> m c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
func a
rL)
            (m b -> m c) -> m b -> m c
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                Partial s
sR -> s -> m b
extractR s
sR
                Done b
rR -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
rR

{-# ANN type SeqFoldState_ Fuse #-}
data SeqFoldState_ sl sr = SeqFoldL_ !sl | SeqFoldR_ !sr

-- | Same as applicative '*>'. Run two folds serially one after the other
-- discarding the result of the first.
--
-- This was written in the hope that it might be faster than implementing it
-- using serialWith, but the current benchmarks show that it has the same
-- performance. So do not expose it unless some benchmark shows benefit.
--
{-# INLINE serial_ #-}
serial_ :: Monad m => Fold m x a -> Fold m x b -> Fold m x b
serial_ :: Fold m x a -> Fold m x b -> Fold m x b
serial_ (Fold s -> x -> m (Step s a)
stepL m (Step s a)
initialL s -> m a
_) (Fold s -> x -> m (Step s b)
stepR m (Step s b)
initialR s -> m b
extractR) =
    (SeqFoldState_ s s -> x -> m (Step (SeqFoldState_ s s) b))
-> m (Step (SeqFoldState_ s s) b)
-> (SeqFoldState_ s s -> m b)
-> Fold m x b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold SeqFoldState_ s s -> x -> m (Step (SeqFoldState_ s s) b)
step m (Step (SeqFoldState_ s s) b)
initial SeqFoldState_ s s -> m b
forall sl. SeqFoldState_ sl s -> m b
extract

    where

    initial :: m (Step (SeqFoldState_ s s) b)
initial = do
        Step s a
resL <- m (Step s a)
initialL
        case Step s a
resL of
            Partial s
sl -> Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b))
-> Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b)
forall a b. (a -> b) -> a -> b
$ SeqFoldState_ s s -> Step (SeqFoldState_ s s) b
forall s b. s -> Step s b
Partial (SeqFoldState_ s s -> Step (SeqFoldState_ s s) b)
-> SeqFoldState_ s s -> Step (SeqFoldState_ s s) b
forall a b. (a -> b) -> a -> b
$ s -> SeqFoldState_ s s
forall sl sr. sl -> SeqFoldState_ sl sr
SeqFoldL_ s
sl
            Done a
_ -> do
                Step s b
resR <- m (Step s b)
initialR
                Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b))
-> Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b)
forall a b. (a -> b) -> a -> b
$ (s -> SeqFoldState_ s s) -> Step s b -> Step (SeqFoldState_ s s) b
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first s -> SeqFoldState_ s s
forall sl sr. sr -> SeqFoldState_ sl sr
SeqFoldR_ Step s b
resR

    step :: SeqFoldState_ s s -> x -> m (Step (SeqFoldState_ s s) b)
step (SeqFoldL_ s
st) x
a = do
        Step s a
r <- s -> x -> m (Step s a)
stepL s
st x
a
        case Step s a
r of
            Partial s
s -> Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b))
-> Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b)
forall a b. (a -> b) -> a -> b
$ SeqFoldState_ s s -> Step (SeqFoldState_ s s) b
forall s b. s -> Step s b
Partial (s -> SeqFoldState_ s s
forall sl sr. sl -> SeqFoldState_ sl sr
SeqFoldL_ s
s)
            Done a
_ -> do
                Step s b
resR <- m (Step s b)
initialR
                Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b))
-> Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b)
forall a b. (a -> b) -> a -> b
$ (s -> SeqFoldState_ s s) -> Step s b -> Step (SeqFoldState_ s s) b
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first s -> SeqFoldState_ s s
forall sl sr. sr -> SeqFoldState_ sl sr
SeqFoldR_ Step s b
resR
    step (SeqFoldR_ s
st) x
a = do
        Step s b
resR <- s -> x -> m (Step s b)
stepR s
st x
a
        Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b))
-> Step (SeqFoldState_ s s) b -> m (Step (SeqFoldState_ s s) b)
forall a b. (a -> b) -> a -> b
$ (s -> SeqFoldState_ s s) -> Step s b -> Step (SeqFoldState_ s s) b
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first s -> SeqFoldState_ s s
forall sl sr. sr -> SeqFoldState_ sl sr
SeqFoldR_ Step s b
resR

    extract :: SeqFoldState_ sl s -> m b
extract (SeqFoldR_ s
sR) = s -> m b
extractR s
sR
    extract (SeqFoldL_ sl
_) = do
        Step s b
res <- m (Step s b)
initialR
        case Step s b
res of
            Partial s
sR -> s -> m b
extractR s
sR
            Done b
rR -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
rR

{-# ANN type TeeState Fuse #-}
data TeeState sL sR bL bR
    = TeeBoth !sL !sR
    | TeeLeft !bR !sL
    | TeeRight !bL !sR

-- | @teeWith k f1 f2@ distributes its input to both @f1@ and @f2@ until both
-- of them terminate and combines their output using @k@.
--
-- >>> avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length)
-- >>> Stream.fold avg $ Stream.fromList [1.0..100.0]
-- 50.5
--
-- > teeWith k f1 f2 = fmap (uncurry k) ((Fold.tee f1 f2)
--
-- For applicative composition using this combinator see
-- "Streamly.Internal.Data.Fold.Tee".
--
-- See also: "Streamly.Internal.Data.Fold.Tee"
--
-- @since 0.8.0
--
{-# INLINE teeWith #-}
teeWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
teeWith :: (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
teeWith a -> b -> c
f (Fold s -> x -> m (Step s a)
stepL m (Step s a)
initialL s -> m a
extractL) (Fold s -> x -> m (Step s b)
stepR m (Step s b)
initialR s -> m b
extractR) =
    (TeeState s s a b -> x -> m (Step (TeeState s s a b) c))
-> m (Step (TeeState s s a b) c)
-> (TeeState s s a b -> m c)
-> Fold m x c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold TeeState s s a b -> x -> m (Step (TeeState s s a b) c)
step m (Step (TeeState s s a b) c)
initial TeeState s s a b -> m c
extract

    where

    {-# INLINE runBoth #-}
    runBoth :: m (Step sL a) -> m (Step sR b) -> m (Step (TeeState sL sR a b) c)
runBoth m (Step sL a)
actionL m (Step sR b)
actionR = do
        Step sL a
resL <- m (Step sL a)
actionL
        Step sR b
resR <- m (Step sR b)
actionR
        Step (TeeState sL sR a b) c -> m (Step (TeeState sL sR a b) c)
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (TeeState sL sR a b) c -> m (Step (TeeState sL sR a b) c))
-> Step (TeeState sL sR a b) c -> m (Step (TeeState sL sR a b) c)
forall a b. (a -> b) -> a -> b
$ case Step sL a
resL of
                  Partial sL
sl ->
                      TeeState sL sR a b -> Step (TeeState sL sR a b) c
forall s b. s -> Step s b
Partial
                          (TeeState sL sR a b -> Step (TeeState sL sR a b) c)
-> TeeState sL sR a b -> Step (TeeState sL sR a b) c
forall a b. (a -> b) -> a -> b
$ case Step sR b
resR of
                                Partial sR
sr -> sL -> sR -> TeeState sL sR a b
forall sL sR bL bR. sL -> sR -> TeeState sL sR bL bR
TeeBoth sL
sl sR
sr
                                Done b
br -> b -> sL -> TeeState sL sR a b
forall sL sR bL bR. bR -> sL -> TeeState sL sR bL bR
TeeLeft b
br sL
sl
                  Done a
bl -> (sR -> TeeState sL sR a b)
-> (b -> c) -> Step sR b -> Step (TeeState sL sR a b) c
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (a -> sR -> TeeState sL sR a b
forall sL sR bL bR. bL -> sR -> TeeState sL sR bL bR
TeeRight a
bl) (a -> b -> c
f a
bl) Step sR b
resR

    initial :: m (Step (TeeState s s a b) c)
initial = m (Step s a) -> m (Step s b) -> m (Step (TeeState s s a b) c)
forall (m :: * -> *) sL sR.
Monad m =>
m (Step sL a) -> m (Step sR b) -> m (Step (TeeState sL sR a b) c)
runBoth m (Step s a)
initialL m (Step s b)
initialR

    step :: TeeState s s a b -> x -> m (Step (TeeState s s a b) c)
step (TeeBoth s
sL s
sR) x
a = m (Step s a) -> m (Step s b) -> m (Step (TeeState s s a b) c)
forall (m :: * -> *) sL sR.
Monad m =>
m (Step sL a) -> m (Step sR b) -> m (Step (TeeState sL sR a b) c)
runBoth (s -> x -> m (Step s a)
stepL s
sL x
a) (s -> x -> m (Step s b)
stepR s
sR x
a)
    step (TeeLeft b
bR s
sL) x
a = (s -> TeeState s s a b)
-> (a -> c) -> Step s a -> Step (TeeState s s a b) c
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (b -> s -> TeeState s s a b
forall sL sR bL bR. bR -> sL -> TeeState sL sR bL bR
TeeLeft b
bR) (a -> b -> c
`f` b
bR) (Step s a -> Step (TeeState s s a b) c)
-> m (Step s a) -> m (Step (TeeState s s a b) c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> x -> m (Step s a)
stepL s
sL x
a
    step (TeeRight a
bL s
sR) x
a = (s -> TeeState s s a b)
-> (b -> c) -> Step s b -> Step (TeeState s s a b) c
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (a -> s -> TeeState s s a b
forall sL sR bL bR. bL -> sR -> TeeState sL sR bL bR
TeeRight a
bL) (a -> b -> c
f a
bL) (Step s b -> Step (TeeState s s a b) c)
-> m (Step s b) -> m (Step (TeeState s s a b) c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> x -> m (Step s b)
stepR s
sR x
a

    extract :: TeeState s s a b -> m c
extract (TeeBoth s
sL s
sR) = a -> b -> c
f (a -> b -> c) -> m a -> m (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m a
extractL s
sL m (b -> c) -> m b -> m c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m b
extractR s
sR
    extract (TeeLeft b
bR s
sL) = (a -> b -> c
`f` b
bR) (a -> c) -> m a -> m c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m a
extractL s
sL
    extract (TeeRight a
bL s
sR) = a -> b -> c
f a
bL (b -> c) -> m b -> m c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractR s
sR

{-# ANN type TeeFstState Fuse #-}
data TeeFstState sL sR b
    = TeeFstBoth !sL !sR
    | TeeFstLeft !b !sL

-- | Like 'teeWith' but terminates as soon as the first fold terminates.
--
-- /Pre-release/
--
{-# INLINE teeWithFst #-}
teeWithFst :: Monad m =>
    (b -> c -> d) -> Fold m a b -> Fold m a c -> Fold m a d
teeWithFst :: (b -> c -> d) -> Fold m a b -> Fold m a c -> Fold m a d
teeWithFst b -> c -> d
f (Fold s -> a -> m (Step s b)
stepL m (Step s b)
initialL s -> m b
extractL) (Fold s -> a -> m (Step s c)
stepR m (Step s c)
initialR s -> m c
extractR) =
    (TeeFstState s s c -> a -> m (Step (TeeFstState s s c) d))
-> m (Step (TeeFstState s s c) d)
-> (TeeFstState s s c -> m d)
-> Fold m a d
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold TeeFstState s s c -> a -> m (Step (TeeFstState s s c) d)
step m (Step (TeeFstState s s c) d)
initial TeeFstState s s c -> m d
extract

    where

    {-# INLINE runBoth #-}
    runBoth :: m (Step sL b) -> m (Step s c) -> m (Step (TeeFstState sL s c) d)
runBoth m (Step sL b)
actionL m (Step s c)
actionR = do
        Step sL b
resL <- m (Step sL b)
actionL
        Step s c
resR <- m (Step s c)
actionR

        case Step sL b
resL of
            Partial sL
sl ->
                Step (TeeFstState sL s c) d -> m (Step (TeeFstState sL s c) d)
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step (TeeFstState sL s c) d -> m (Step (TeeFstState sL s c) d))
-> Step (TeeFstState sL s c) d -> m (Step (TeeFstState sL s c) d)
forall a b. (a -> b) -> a -> b
$ TeeFstState sL s c -> Step (TeeFstState sL s c) d
forall s b. s -> Step s b
Partial
                    (TeeFstState sL s c -> Step (TeeFstState sL s c) d)
-> TeeFstState sL s c -> Step (TeeFstState sL s c) d
forall a b. (a -> b) -> a -> b
$ case Step s c
resR of
                        Partial s
sr -> sL -> s -> TeeFstState sL s c
forall sL sR b. sL -> sR -> TeeFstState sL sR b
TeeFstBoth sL
sl s
sr
                        Done c
br -> c -> sL -> TeeFstState sL s c
forall sL sR b. b -> sL -> TeeFstState sL sR b
TeeFstLeft c
br sL
sl
            Done b
bl -> do
                d -> Step (TeeFstState sL s c) d
forall s b. b -> Step s b
Done (d -> Step (TeeFstState sL s c) d)
-> (c -> d) -> c -> Step (TeeFstState sL s c) d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c -> d
f b
bl (c -> Step (TeeFstState sL s c) d)
-> m c -> m (Step (TeeFstState sL s c) d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    case Step s c
resR of
                        Partial s
sr -> s -> m c
extractR s
sr
                        Done c
br -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
br

    initial :: m (Step (TeeFstState s s c) d)
initial = m (Step s b) -> m (Step s c) -> m (Step (TeeFstState s s c) d)
forall sL.
m (Step sL b) -> m (Step s c) -> m (Step (TeeFstState sL s c) d)
runBoth m (Step s b)
initialL m (Step s c)
initialR

    step :: TeeFstState s s c -> a -> m (Step (TeeFstState s s c) d)
step (TeeFstBoth s
sL s
sR) a
a = m (Step s b) -> m (Step s c) -> m (Step (TeeFstState s s c) d)
forall sL.
m (Step sL b) -> m (Step s c) -> m (Step (TeeFstState sL s c) d)
runBoth (s -> a -> m (Step s b)
stepL s
sL a
a) (s -> a -> m (Step s c)
stepR s
sR a
a)
    step (TeeFstLeft c
bR s
sL) a
a = (s -> TeeFstState s s c)
-> (b -> d) -> Step s b -> Step (TeeFstState s s c) d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (c -> s -> TeeFstState s s c
forall sL sR b. b -> sL -> TeeFstState sL sR b
TeeFstLeft c
bR) (b -> c -> d
`f` c
bR) (Step s b -> Step (TeeFstState s s c) d)
-> m (Step s b) -> m (Step (TeeFstState s s c) d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> a -> m (Step s b)
stepL s
sL a
a

    extract :: TeeFstState s s c -> m d
extract (TeeFstBoth s
sL s
sR) = b -> c -> d
f (b -> c -> d) -> m b -> m (c -> d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
sL m (c -> d) -> m c -> m d
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m c
extractR s
sR
    extract (TeeFstLeft c
bR s
sL) = (b -> c -> d
`f` c
bR) (b -> d) -> m b -> m d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
sL

-- | Like 'teeWith' but terminates as soon as any one of the two folds
-- terminates.
--
-- /Pre-release/
--
{-# INLINE teeWithMin #-}
teeWithMin :: Monad m =>
    (b -> c -> d) -> Fold m a b -> Fold m a c -> Fold m a d
teeWithMin :: (b -> c -> d) -> Fold m a b -> Fold m a c -> Fold m a d
teeWithMin b -> c -> d
f (Fold s -> a -> m (Step s b)
stepL m (Step s b)
initialL s -> m b
extractL) (Fold s -> a -> m (Step s c)
stepR m (Step s c)
initialR s -> m c
extractR) =
    (Tuple' s s -> a -> m (Step (Tuple' s s) d))
-> m (Step (Tuple' s s) d) -> (Tuple' s s -> m d) -> Fold m a d
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold Tuple' s s -> a -> m (Step (Tuple' s s) d)
step m (Step (Tuple' s s) d)
initial Tuple' s s -> m d
extract

    where

    {-# INLINE runBoth #-}
    runBoth :: m (Step s b) -> m (Step s c) -> m (Step (Tuple' s s) d)
runBoth m (Step s b)
actionL m (Step s c)
actionR = do
        Step s b
resL <- m (Step s b)
actionL
        Step s c
resR <- m (Step s c)
actionR
        case Step s b
resL of
            Partial s
sl -> do
                case Step s c
resR of
                    Partial s
sr -> Step (Tuple' s s) d -> m (Step (Tuple' s s) d)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' s s) d -> m (Step (Tuple' s s) d))
-> Step (Tuple' s s) d -> m (Step (Tuple' s s) d)
forall a b. (a -> b) -> a -> b
$ Tuple' s s -> Step (Tuple' s s) d
forall s b. s -> Step s b
Partial (Tuple' s s -> Step (Tuple' s s) d)
-> Tuple' s s -> Step (Tuple' s s) d
forall a b. (a -> b) -> a -> b
$ s -> s -> Tuple' s s
forall a b. a -> b -> Tuple' a b
Tuple' s
sl s
sr
                    Done c
br -> d -> Step (Tuple' s s) d
forall s b. b -> Step s b
Done (d -> Step (Tuple' s s) d) -> (b -> d) -> b -> Step (Tuple' s s) d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> c -> d
`f` c
br) (b -> Step (Tuple' s s) d) -> m b -> m (Step (Tuple' s s) d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
sl

            Done b
bl -> do
                d -> Step (Tuple' s s) d
forall s b. b -> Step s b
Done (d -> Step (Tuple' s s) d) -> (c -> d) -> c -> Step (Tuple' s s) d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c -> d
f b
bl (c -> Step (Tuple' s s) d) -> m c -> m (Step (Tuple' s s) d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                    case Step s c
resR of
                        Partial s
sr -> s -> m c
extractR s
sr
                        Done c
br -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
br

    initial :: m (Step (Tuple' s s) d)
initial = m (Step s b) -> m (Step s c) -> m (Step (Tuple' s s) d)
runBoth m (Step s b)
initialL m (Step s c)
initialR

    step :: Tuple' s s -> a -> m (Step (Tuple' s s) d)
step (Tuple' s
sL s
sR) a
a = m (Step s b) -> m (Step s c) -> m (Step (Tuple' s s) d)
runBoth (s -> a -> m (Step s b)
stepL s
sL a
a) (s -> a -> m (Step s c)
stepR s
sR a
a)

    extract :: Tuple' s s -> m d
extract (Tuple' s
sL s
sR) = b -> c -> d
f (b -> c -> d) -> m b -> m (c -> d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
sL m (c -> d) -> m c -> m d
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m c
extractR s
sR

-- | Shortest alternative. Apply both folds in parallel but choose the result
-- from the one which consumed least input i.e. take the shortest succeeding
-- fold.
--
-- If both the folds finish at the same time or if the result is extracted
-- before any of the folds could finish then the left one is taken.
--
-- /Pre-release/
--
{-# INLINE shortest #-}
shortest :: Monad m => Fold m x a -> Fold m x b -> Fold m x (Either a b)
shortest :: Fold m x a -> Fold m x b -> Fold m x (Either a b)
shortest (Fold s -> x -> m (Step s a)
stepL m (Step s a)
initialL s -> m a
extractL) (Fold s -> x -> m (Step s b)
stepR m (Step s b)
initialR s -> m b
_) =
    (Tuple' s s -> x -> m (Step (Tuple' s s) (Either a b)))
-> m (Step (Tuple' s s) (Either a b))
-> (Tuple' s s -> m (Either a b))
-> Fold m x (Either a b)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold Tuple' s s -> x -> m (Step (Tuple' s s) (Either a b))
step m (Step (Tuple' s s) (Either a b))
initial Tuple' s s -> m (Either a b)
forall b b. Tuple' s b -> m (Either a b)
extract

    where

    {-# INLINE runBoth #-}
    runBoth :: m (Step a a) -> m (Step b b) -> m (Step (Tuple' a b) (Either a b))
runBoth m (Step a a)
actionL m (Step b b)
actionR = do
        Step a a
resL <- m (Step a a)
actionL
        Step b b
resR <- m (Step b b)
actionR
        Step (Tuple' a b) (Either a b)
-> m (Step (Tuple' a b) (Either a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' a b) (Either a b)
 -> m (Step (Tuple' a b) (Either a b)))
-> Step (Tuple' a b) (Either a b)
-> m (Step (Tuple' a b) (Either a b))
forall a b. (a -> b) -> a -> b
$
            case Step a a
resL of
                Partial a
sL -> (b -> Tuple' a b)
-> (b -> Either a b) -> Step b b -> Step (Tuple' a b) (Either a b)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (a -> b -> Tuple' a b
forall a b. a -> b -> Tuple' a b
Tuple' a
sL) b -> Either a b
forall a b. b -> Either a b
Right Step b b
resR
                Done a
bL -> Either a b -> Step (Tuple' a b) (Either a b)
forall s b. b -> Step s b
Done (Either a b -> Step (Tuple' a b) (Either a b))
-> Either a b -> Step (Tuple' a b) (Either a b)
forall a b. (a -> b) -> a -> b
$ a -> Either a b
forall a b. a -> Either a b
Left a
bL

    initial :: m (Step (Tuple' s s) (Either a b))
initial = m (Step s a) -> m (Step s b) -> m (Step (Tuple' s s) (Either a b))
forall (m :: * -> *) a a b b.
Monad m =>
m (Step a a) -> m (Step b b) -> m (Step (Tuple' a b) (Either a b))
runBoth m (Step s a)
initialL m (Step s b)
initialR

    step :: Tuple' s s -> x -> m (Step (Tuple' s s) (Either a b))
step (Tuple' s
sL s
sR) x
a = m (Step s a) -> m (Step s b) -> m (Step (Tuple' s s) (Either a b))
forall (m :: * -> *) a a b b.
Monad m =>
m (Step a a) -> m (Step b b) -> m (Step (Tuple' a b) (Either a b))
runBoth (s -> x -> m (Step s a)
stepL s
sL x
a) (s -> x -> m (Step s b)
stepR s
sR x
a)

    extract :: Tuple' s b -> m (Either a b)
extract (Tuple' s
sL b
_) = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> m a -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m a
extractL s
sL

{-# ANN type LongestState Fuse #-}
data LongestState sL sR
    = LongestBoth !sL !sR
    | LongestLeft !sL
    | LongestRight !sR

-- | Longest alternative. Apply both folds in parallel but choose the result
-- from the one which consumed more input i.e. take the longest succeeding
-- fold.
--
-- If both the folds finish at the same time or if the result is extracted
-- before any of the folds could finish then the left one is taken.
--
-- /Pre-release/
--
{-# INLINE longest #-}
longest :: Monad m => Fold m x a -> Fold m x b -> Fold m x (Either a b)
longest :: Fold m x a -> Fold m x b -> Fold m x (Either a b)
longest (Fold s -> x -> m (Step s a)
stepL m (Step s a)
initialL s -> m a
extractL) (Fold s -> x -> m (Step s b)
stepR m (Step s b)
initialR s -> m b
extractR) =
    (LongestState s s -> x -> m (Step (LongestState s s) (Either a b)))
-> m (Step (LongestState s s) (Either a b))
-> (LongestState s s -> m (Either a b))
-> Fold m x (Either a b)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold LongestState s s -> x -> m (Step (LongestState s s) (Either a b))
step m (Step (LongestState s s) (Either a b))
forall b. m (Step (LongestState s s) (Either a b))
initial LongestState s s -> m (Either a b)
extract

    where

    {-# INLINE runBoth #-}
    runBoth :: m (Step sL a)
-> m (Step sR b) -> m (Step (LongestState sL sR) (Either a b))
runBoth m (Step sL a)
actionL m (Step sR b)
actionR = do
        Step sL a
resL <- m (Step sL a)
actionL
        Step sR b
resR <- m (Step sR b)
actionR
        Step (LongestState sL sR) (Either a b)
-> m (Step (LongestState sL sR) (Either a b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (LongestState sL sR) (Either a b)
 -> m (Step (LongestState sL sR) (Either a b)))
-> Step (LongestState sL sR) (Either a b)
-> m (Step (LongestState sL sR) (Either a b))
forall a b. (a -> b) -> a -> b
$
            case Step sL a
resL of
                Partial sL
sL ->
                    LongestState sL sR -> Step (LongestState sL sR) (Either a b)
forall s b. s -> Step s b
Partial (LongestState sL sR -> Step (LongestState sL sR) (Either a b))
-> LongestState sL sR -> Step (LongestState sL sR) (Either a b)
forall a b. (a -> b) -> a -> b
$
                        case Step sR b
resR of
                            Partial sR
sR -> sL -> sR -> LongestState sL sR
forall sL sR. sL -> sR -> LongestState sL sR
LongestBoth sL
sL sR
sR
                            Done b
_ -> sL -> LongestState sL sR
forall sL sR. sL -> LongestState sL sR
LongestLeft sL
sL
                Done a
bL -> (sR -> LongestState sL sR)
-> (b -> Either a b)
-> Step sR b
-> Step (LongestState sL sR) (Either a b)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap sR -> LongestState sL sR
forall sL sR. sR -> LongestState sL sR
LongestRight (Either a b -> b -> Either a b
forall a b. a -> b -> a
const (a -> Either a b
forall a b. a -> Either a b
Left a
bL)) Step sR b
resR

    initial :: m (Step (LongestState s s) (Either a b))
initial = m (Step s a)
-> m (Step s b) -> m (Step (LongestState s s) (Either a b))
forall (m :: * -> *) sL a sR b b.
Monad m =>
m (Step sL a)
-> m (Step sR b) -> m (Step (LongestState sL sR) (Either a b))
runBoth m (Step s a)
initialL m (Step s b)
initialR

    step :: LongestState s s -> x -> m (Step (LongestState s s) (Either a b))
step (LongestBoth s
sL s
sR) x
a = m (Step s a)
-> m (Step s b) -> m (Step (LongestState s s) (Either a b))
forall (m :: * -> *) sL a sR b b.
Monad m =>
m (Step sL a)
-> m (Step sR b) -> m (Step (LongestState sL sR) (Either a b))
runBoth (s -> x -> m (Step s a)
stepL s
sL x
a) (s -> x -> m (Step s b)
stepR s
sR x
a)
    step (LongestLeft s
sL) x
a = (s -> LongestState s s)
-> (a -> Either a b)
-> Step s a
-> Step (LongestState s s) (Either a b)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap s -> LongestState s s
forall sL sR. sL -> LongestState sL sR
LongestLeft a -> Either a b
forall a b. a -> Either a b
Left (Step s a -> Step (LongestState s s) (Either a b))
-> m (Step s a) -> m (Step (LongestState s s) (Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> x -> m (Step s a)
stepL s
sL x
a
    step (LongestRight s
sR) x
a = (s -> LongestState s s)
-> (b -> Either a b)
-> Step s b
-> Step (LongestState s s) (Either a b)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap s -> LongestState s s
forall sL sR. sR -> LongestState sL sR
LongestRight b -> Either a b
forall a b. b -> Either a b
Right (Step s b -> Step (LongestState s s) (Either a b))
-> m (Step s b) -> m (Step (LongestState s s) (Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> x -> m (Step s b)
stepR s
sR x
a

    left :: s -> m (Either a b)
left s
sL = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> m a -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m a
extractL s
sL
    extract :: LongestState s s -> m (Either a b)
extract (LongestLeft s
sL) = s -> m (Either a b)
forall b. s -> m (Either a b)
left s
sL
    extract (LongestRight s
sR) = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> m b -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractR s
sR
    extract (LongestBoth s
sL s
_) = s -> m (Either a b)
forall b. s -> m (Either a b)
left s
sL

data ConcatMapState m sa a c
    = B !sa
    | forall s. C (s -> a -> m (Step s c)) !s (s -> m c)

-- Compare with foldIterate.
--
-- | Map a 'Fold' returning function on the result of a 'Fold' and run the
-- returned fold. This operation can be used to express data dependencies
-- between fold operations.
--
-- Let's say the first element in the stream is a count of the following
-- elements that we have to add, then:
--
-- >>> import Data.Maybe (fromJust)
-- >>> count = fmap fromJust Fold.head
-- >>> total n = Fold.take n Fold.sum
-- >>> Stream.fold (Fold.concatMap total count) $ Stream.fromList [10,9..1]
-- 45
--
-- /Time: O(n^2) where @n@ is the number of compositions./
--
-- See also: 'Streamly.Internal.Data.Stream.IsStream.foldIterateM'
--
-- @since 0.8.0
--
{-# INLINE concatMap #-}
concatMap :: Monad m => (b -> Fold m a c) -> Fold m a b -> Fold m a c
concatMap :: (b -> Fold m a c) -> Fold m a b -> Fold m a c
concatMap b -> Fold m a c
f (Fold s -> a -> m (Step s b)
stepa m (Step s b)
initiala s -> m b
extracta) = (ConcatMapState m s a c
 -> a -> m (Step (ConcatMapState m s a c) c))
-> m (Step (ConcatMapState m s a c) c)
-> (ConcatMapState m s a c -> m c)
-> Fold m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold ConcatMapState m s a c -> a -> m (Step (ConcatMapState m s a c) c)
stepc m (Step (ConcatMapState m s a c) c)
initialc ConcatMapState m s a c -> m c
forall a. ConcatMapState m s a c -> m c
extractc
  where
    initialc :: m (Step (ConcatMapState m s a c) c)
initialc = do
        Step s b
r <- m (Step s b)
initiala
        case Step s b
r of
            Partial s
s -> Step (ConcatMapState m s a c) c
-> m (Step (ConcatMapState m s a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatMapState m s a c) c
 -> m (Step (ConcatMapState m s a c) c))
-> Step (ConcatMapState m s a c) c
-> m (Step (ConcatMapState m s a c) c)
forall a b. (a -> b) -> a -> b
$ ConcatMapState m s a c -> Step (ConcatMapState m s a c) c
forall s b. s -> Step s b
Partial (s -> ConcatMapState m s a c
forall (m :: * -> *) sa a c. sa -> ConcatMapState m sa a c
B s
s)
            Done b
b -> Fold m a c -> m (Step (ConcatMapState m s a c) c)
forall (m :: * -> *) a b sa.
Monad m =>
Fold m a b -> m (Step (ConcatMapState m sa a b) b)
initInnerFold (b -> Fold m a c
f b
b)

    stepc :: ConcatMapState m s a c -> a -> m (Step (ConcatMapState m s a c) c)
stepc (B s
s) a
a = do
        Step s b
r <- s -> a -> m (Step s b)
stepa s
s a
a
        case Step s b
r of
            Partial s
s1 -> Step (ConcatMapState m s a c) c
-> m (Step (ConcatMapState m s a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatMapState m s a c) c
 -> m (Step (ConcatMapState m s a c) c))
-> Step (ConcatMapState m s a c) c
-> m (Step (ConcatMapState m s a c) c)
forall a b. (a -> b) -> a -> b
$ ConcatMapState m s a c -> Step (ConcatMapState m s a c) c
forall s b. s -> Step s b
Partial (s -> ConcatMapState m s a c
forall (m :: * -> *) sa a c. sa -> ConcatMapState m sa a c
B s
s1)
            Done b
b -> Fold m a c -> m (Step (ConcatMapState m s a c) c)
forall (m :: * -> *) a b sa.
Monad m =>
Fold m a b -> m (Step (ConcatMapState m sa a b) b)
initInnerFold (b -> Fold m a c
f b
b)

    stepc (C s -> a -> m (Step s c)
stepInner s
s s -> m c
extractInner) a
a = do
        Step s c
r <- s -> a -> m (Step s c)
stepInner s
s a
a
        Step (ConcatMapState m s a c) c
-> m (Step (ConcatMapState m s a c) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatMapState m s a c) c
 -> m (Step (ConcatMapState m s a c) c))
-> Step (ConcatMapState m s a c) c
-> m (Step (ConcatMapState m s a c) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Partial s
sc -> ConcatMapState m s a c -> Step (ConcatMapState m s a c) c
forall s b. s -> Step s b
Partial ((s -> a -> m (Step s c))
-> s -> (s -> m c) -> ConcatMapState m s a c
forall (m :: * -> *) sa a c s.
(s -> a -> m (Step s c))
-> s -> (s -> m c) -> ConcatMapState m sa a c
C s -> a -> m (Step s c)
stepInner s
sc s -> m c
extractInner)
            Done c
c -> c -> Step (ConcatMapState m s a c) c
forall s b. b -> Step s b
Done c
c

    extractc :: ConcatMapState m s a c -> m c
extractc (B s
s) = do
        b
r <- s -> m b
extracta s
s
        Fold m a c -> m c
forall (m :: * -> *) a b. Monad m => Fold m a b -> m b
initExtract (b -> Fold m a c
f b
r)
    extractc (C s -> a -> m (Step s c)
_ s
sInner s -> m c
extractInner) = s -> m c
extractInner s
sInner

    initInnerFold :: Fold m a b -> m (Step (ConcatMapState m sa a b) b)
initInnerFold (Fold s -> a -> m (Step s b)
step m (Step s b)
i s -> m b
e) = do
        Step s b
r <- m (Step s b)
i
        Step (ConcatMapState m sa a b) b
-> m (Step (ConcatMapState m sa a b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatMapState m sa a b) b
 -> m (Step (ConcatMapState m sa a b) b))
-> Step (ConcatMapState m sa a b) b
-> m (Step (ConcatMapState m sa a b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Partial s
s -> ConcatMapState m sa a b -> Step (ConcatMapState m sa a b) b
forall s b. s -> Step s b
Partial ((s -> a -> m (Step s b))
-> s -> (s -> m b) -> ConcatMapState m sa a b
forall (m :: * -> *) sa a c s.
(s -> a -> m (Step s c))
-> s -> (s -> m c) -> ConcatMapState m sa a c
C s -> a -> m (Step s b)
step s
s s -> m b
e)
            Done b
c -> b -> Step (ConcatMapState m sa a b) b
forall s b. b -> Step s b
Done b
c

    initExtract :: Fold m a b -> m b
initExtract (Fold s -> a -> m (Step s b)
_ m (Step s b)
i s -> m b
e) = do
        Step s b
r <- m (Step s b)
i
        case Step s b
r of
            Partial s
s -> s -> m b
e s
s
            Done b
c -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
c

------------------------------------------------------------------------------
-- Mapping on input
------------------------------------------------------------------------------

-- | @lmap f fold@ maps the function @f@ on the input of the fold.
--
-- >>> Stream.fold (Fold.lmap (\x -> x * x) Fold.sum) (Stream.enumerateFromTo 1 100)
-- 338350
--
-- > lmap = Fold.lmapM return
--
-- @since 0.8.0
{-# INLINE lmap #-}
lmap :: (a -> b) -> Fold m b r -> Fold m a r
lmap :: (a -> b) -> Fold m b r -> Fold m a r
lmap a -> b
f (Fold s -> b -> m (Step s r)
step m (Step s r)
begin s -> m r
done) = (s -> a -> m (Step s r))
-> m (Step s r) -> (s -> m r) -> Fold m a r
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s r)
step' m (Step s r)
begin s -> m r
done
    where
    step' :: s -> a -> m (Step s r)
step' s
x a
a = s -> b -> m (Step s r)
step s
x (a -> b
f a
a)

-- | @lmapM f fold@ maps the monadic function @f@ on the input of the fold.
--
-- @since 0.8.0
{-# INLINE lmapM #-}
lmapM :: Monad m => (a -> m b) -> Fold m b r -> Fold m a r
lmapM :: (a -> m b) -> Fold m b r -> Fold m a r
lmapM a -> m b
f (Fold s -> b -> m (Step s r)
step m (Step s r)
begin s -> m r
done) = (s -> a -> m (Step s r))
-> m (Step s r) -> (s -> m r) -> Fold m a r
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s r)
step' m (Step s r)
begin s -> m r
done
    where
    step' :: s -> a -> m (Step s r)
step' s
x a
a = a -> m b
f a
a m b -> (b -> m (Step s r)) -> m (Step s r)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> b -> m (Step s r)
step s
x

------------------------------------------------------------------------------
-- Filtering
------------------------------------------------------------------------------

-- | Include only those elements that pass a predicate.
--
-- >>> Stream.fold (Fold.filter (> 5) Fold.sum) $ Stream.fromList [1..10]
-- 40
--
-- > filter f = Fold.filterM (return . f)
--
-- @since 0.8.0
{-# INLINE filter #-}
filter :: Monad m => (a -> Bool) -> Fold m a r -> Fold m a r
filter :: (a -> Bool) -> Fold m a r -> Fold m a r
filter a -> Bool
f (Fold s -> a -> m (Step s r)
step m (Step s r)
begin s -> m r
done) = (s -> a -> m (Step s r))
-> m (Step s r) -> (s -> m r) -> Fold m a r
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s r)
step' m (Step s r)
begin s -> m r
done
    where
    step' :: s -> a -> m (Step s r)
step' s
x a
a = if a -> Bool
f a
a then s -> a -> m (Step s r)
step s
x a
a else Step s r -> m (Step s r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s r -> m (Step s r)) -> Step s r -> m (Step s r)
forall a b. (a -> b) -> a -> b
$ s -> Step s r
forall s b. s -> Step s b
Partial s
x

-- | Like 'filter' but with a monadic predicate.
--
-- @since 0.8.0
{-# INLINE filterM #-}
filterM :: Monad m => (a -> m Bool) -> Fold m a r -> Fold m a r
filterM :: (a -> m Bool) -> Fold m a r -> Fold m a r
filterM a -> m Bool
f (Fold s -> a -> m (Step s r)
step m (Step s r)
begin s -> m r
done) = (s -> a -> m (Step s r))
-> m (Step s r) -> (s -> m r) -> Fold m a r
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s r)
step' m (Step s r)
begin s -> m r
done
    where
    step' :: s -> a -> m (Step s r)
step' s
x a
a = do
      Bool
use <- a -> m Bool
f a
a
      if Bool
use then s -> a -> m (Step s r)
step s
x a
a else Step s r -> m (Step s r)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s r -> m (Step s r)) -> Step s r -> m (Step s r)
forall a b. (a -> b) -> a -> b
$ s -> Step s r
forall s b. s -> Step s b
Partial s
x

-- | Modify a fold to receive a 'Maybe' input, the 'Just' values are unwrapped
-- and sent to the original fold, 'Nothing' values are discarded.
--
-- @since 0.8.0
{-# INLINE catMaybes #-}
catMaybes :: Monad m => Fold m a b -> Fold m (Maybe a) b
catMaybes :: Fold m a b -> Fold m (Maybe a) b
catMaybes = (Maybe a -> Bool) -> Fold m (Maybe a) b -> Fold m (Maybe a) b
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Fold m a r -> Fold m a r
filter Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Fold m (Maybe a) b -> Fold m (Maybe a) b)
-> (Fold m a b -> Fold m (Maybe a) b)
-> Fold m a b
-> Fold m (Maybe a) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> a) -> Fold m a b -> Fold m (Maybe a) b
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust

------------------------------------------------------------------------------
-- Parsing
------------------------------------------------------------------------------

-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x
{-# ANN type Tuple'Fused Fuse #-}
data Tuple'Fused a b = Tuple'Fused !a !b deriving Int -> Tuple'Fused a b -> ShowS
[Tuple'Fused a b] -> ShowS
Tuple'Fused a b -> String
(Int -> Tuple'Fused a b -> ShowS)
-> (Tuple'Fused a b -> String)
-> ([Tuple'Fused a b] -> ShowS)
-> Show (Tuple'Fused a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> Tuple'Fused a b -> ShowS
forall a b. (Show a, Show b) => [Tuple'Fused a b] -> ShowS
forall a b. (Show a, Show b) => Tuple'Fused a b -> String
showList :: [Tuple'Fused a b] -> ShowS
$cshowList :: forall a b. (Show a, Show b) => [Tuple'Fused a b] -> ShowS
show :: Tuple'Fused a b -> String
$cshow :: forall a b. (Show a, Show b) => Tuple'Fused a b -> String
showsPrec :: Int -> Tuple'Fused a b -> ShowS
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> Tuple'Fused a b -> ShowS
Show

-- | Take at most @n@ input elements and fold them using the supplied fold. A
-- negative count is treated as 0.
--
-- >>> Stream.fold (Fold.take 2 Fold.toList) $ Stream.fromList [1..10]
-- [1,2]
--
-- @since 0.8.0
{-# INLINE take #-}
take :: Monad m => Int -> Fold m a b -> Fold m a b
take :: Int -> Fold m a b -> Fold m a b
take Int
n (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) = (Tuple'Fused Int s -> a -> m (Step (Tuple'Fused Int s) b))
-> m (Step (Tuple'Fused Int s) b)
-> (Tuple'Fused Int s -> m b)
-> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold Tuple'Fused Int s -> a -> m (Step (Tuple'Fused Int s) b)
step m (Step (Tuple'Fused Int s) b)
initial Tuple'Fused Int s -> m b
forall a. Tuple'Fused a s -> m b
extract

    where

    {-# INLINE next #-}
    next :: Int -> Step s b -> m (Step (Tuple'Fused Int s) b)
next Int
i Step s b
res =
        case Step s b
res of
            Partial s
s -> do
                let i1 :: Int
i1 = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                    s1 :: Tuple'Fused Int s
s1 = Int -> s -> Tuple'Fused Int s
forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused Int
i1 s
s
                if Int
i1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n
                then Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b))
-> Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b)
forall a b. (a -> b) -> a -> b
$ Tuple'Fused Int s -> Step (Tuple'Fused Int s) b
forall s b. s -> Step s b
Partial Tuple'Fused Int s
s1
                else b -> Step (Tuple'Fused Int s) b
forall s b. b -> Step s b
Done (b -> Step (Tuple'Fused Int s) b)
-> m b -> m (Step (Tuple'Fused Int s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
fextract s
s
            Done b
b -> Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b))
-> Step (Tuple'Fused Int s) b -> m (Step (Tuple'Fused Int s) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (Tuple'Fused Int s) b
forall s b. b -> Step s b
Done b
b

    initial :: m (Step (Tuple'Fused Int s) b)
initial = m (Step s b)
finitial m (Step s b)
-> (Step s b -> m (Step (Tuple'Fused Int s) b))
-> m (Step (Tuple'Fused Int s) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Step s b -> m (Step (Tuple'Fused Int s) b)
next (-Int
1)

    step :: Tuple'Fused Int s -> a -> m (Step (Tuple'Fused Int s) b)
step (Tuple'Fused Int
i s
r) a
a = s -> a -> m (Step s b)
fstep s
r a
a m (Step s b)
-> (Step s b -> m (Step (Tuple'Fused Int s) b))
-> m (Step (Tuple'Fused Int s) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Step s b -> m (Step (Tuple'Fused Int s) b)
next Int
i

    extract :: Tuple'Fused a s -> m b
extract (Tuple'Fused a
_ s
r) = s -> m b
fextract s
r

------------------------------------------------------------------------------
-- Nesting
------------------------------------------------------------------------------

-- | 'duplicate' provides the ability to run a fold in parts.  The duplicated
-- fold consumes the input and returns the same fold as output instead of
-- returning the final result, the returned fold can be run later to consume
-- more input.
--
-- We can append a stream to a fold as follows:
--
-- >>> :{
-- foldAppend :: Monad m => Fold m a b -> SerialT m a -> m (Fold m a b)
-- foldAppend f = Stream.fold (Fold.duplicate f)
-- :}
--
-- >>> :{
-- do
--  sum1 <- foldAppend Fold.sum (Stream.enumerateFromTo 1 10)
--  sum2 <- foldAppend sum1 (Stream.enumerateFromTo 11 20)
--  Stream.fold sum2 (Stream.enumerateFromTo 21 30)
-- :}
-- 465
--
-- 'duplicate' essentially appends a stream to the fold without finishing the
-- fold.  Compare with 'snoc' which appends a singleton value to the fold.
--
-- /Pre-release/
{-# INLINE duplicate #-}
duplicate :: Monad m => Fold m a b -> Fold m a (Fold m a b)
duplicate :: Fold m a b -> Fold m a (Fold m a b)
duplicate (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1) =
    (s -> a -> m (Step s (Fold m a b)))
-> m (Step s (Fold m a b))
-> (s -> m (Fold m a b))
-> Fold m a (Fold m a b)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s (Fold m a b))
forall (m :: * -> *) a.
Applicative m =>
s -> a -> m (Step s (Fold m a b))
step m (Step s (Fold m a b))
forall a. m (Step s (Fold m a b))
initial (\s
s -> Fold m a b -> m (Fold m a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fold m a b -> m (Fold m a b)) -> Fold m a b -> m (Fold m a b)
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ s -> Step s b
forall s b. s -> Step s b
Partial s
s) s -> m b
extract1)

    where

    initial :: m (Step s (Fold m a b))
initial = (b -> Fold m a b) -> Step s b -> Step s (Fold m a b)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second b -> Fold m a b
forall (m :: * -> *) b a. Applicative m => b -> Fold m a b
fromPure (Step s b -> Step s (Fold m a b))
-> m (Step s b) -> m (Step s (Fold m a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Step s b)
initial1

    step :: s -> a -> m (Step s (Fold m a b))
step s
s a
a = (b -> Fold m a b) -> Step s b -> Step s (Fold m a b)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second b -> Fold m a b
forall (m :: * -> *) b a. Applicative m => b -> Fold m a b
fromPure (Step s b -> Step s (Fold m a b))
-> m (Step s b) -> m (Step s (Fold m a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> a -> m (Step s b)
step1 s
s a
a

-- | Run the initialization effect of a fold. The returned fold would use the
-- value returned by this effect as its initial value.
--
-- /Pre-release/
{-# INLINE initialize #-}
initialize :: Monad m => Fold m a b -> m (Fold m a b)
initialize :: Fold m a b -> m (Fold m a b)
initialize (Fold s -> a -> m (Step s b)
step m (Step s b)
initial s -> m b
extract) = do
    Step s b
i <- m (Step s b)
initial
    Fold m a b -> m (Fold m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Fold m a b -> m (Fold m a b)) -> Fold m a b -> m (Fold m a b)
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step (Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
i) s -> m b
extract

-- | Append a singleton value to the fold.
--
-- >>> import qualified Data.Foldable as Foldable
-- >>> Foldable.foldlM Fold.snoc Fold.toList [1..3] >>= Fold.finish
-- [1,2,3]
--
-- Compare with 'duplicate' which allows appending a stream to the fold.
--
-- /Pre-release/
{-# INLINE snoc #-}
snoc :: Monad m => Fold m a b -> a -> m (Fold m a b)
snoc :: Fold m a b -> a -> m (Fold m a b)
snoc (Fold s -> a -> m (Step s b)
step m (Step s b)
initial s -> m b
extract) a
a = do
    Step s b
res <- m (Step s b)
initial
    Step s b
r <- case Step s b
res of
          Partial s
fs -> s -> a -> m (Step s b)
step s
fs a
a
          Done b
_ -> Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res
    Fold m a b -> m (Fold m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Fold m a b -> m (Fold m a b)) -> Fold m a b -> m (Fold m a b)
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step (Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
r) s -> m b
extract

-- | Finish the fold to extract the current value of the fold.
--
-- >>> Fold.finish Fold.toList
-- []
--
-- /Pre-release/
{-# INLINE finish #-}
finish :: Monad m => Fold m a b -> m b
finish :: Fold m a b -> m b
finish (Fold s -> a -> m (Step s b)
_ m (Step s b)
initial s -> m b
extract) = do
    Step s b
res <- m (Step s b)
initial
    case Step s b
res of
          Partial s
fs -> s -> m b
extract s
fs
          Done b
b -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

------------------------------------------------------------------------------
-- Parsing
------------------------------------------------------------------------------

-- All the grouping transformation that we apply to a stream can also be
-- applied to a fold input stream. groupBy et al can be written as terminating
-- folds and then we can apply "many" to use those repeatedly on a stream.

{-# ANN type ManyState Fuse #-}
data ManyState s1 s2
    = ManyFirst !s1 !s2
    | ManyLoop !s1 !s2

-- | Collect zero or more applications of a fold.  @many split collect@ applies
-- the @split@ fold repeatedly on the input stream and accumulates zero or more
-- fold results using @collect@.
--
-- >>> two = Fold.take 2 Fold.toList
-- >>> twos = Fold.many two Fold.toList
-- >>> Stream.fold twos $ Stream.fromList [1..10]
-- [[1,2],[3,4],[5,6],[7,8],[9,10]]
--
-- Stops when @collect@ stops.
--
-- See also: 'Streamly.Prelude.concatMap', 'Streamly.Prelude.foldMany'
--
-- @since 0.8.0
--
{-# INLINE many #-}
many :: Monad m => Fold m a b -> Fold m b c -> Fold m a c
many :: Fold m a b -> Fold m b c -> Fold m a c
many (Fold s -> a -> m (Step s b)
sstep m (Step s b)
sinitial s -> m b
sextract) (Fold s -> b -> m (Step s c)
cstep m (Step s c)
cinitial s -> m c
cextract) =
    (ManyState s s -> a -> m (Step (ManyState s s) c))
-> m (Step (ManyState s s) c)
-> (ManyState s s -> m c)
-> Fold m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold ManyState s s -> a -> m (Step (ManyState s s) c)
step m (Step (ManyState s s) c)
initial ManyState s s -> m c
extract

    where

    -- cs = collect state
    -- ss = split state
    -- cres = collect state result
    -- sres = split state result
    -- cb = collect done
    -- sb = split done

    -- Caution! There is mutual recursion here, inlining the right functions is
    -- important.

    {-# INLINE split #-}
    split :: (s -> s -> ManyState s s)
-> s -> Step s b -> m (Step (ManyState s s) c)
split s -> s -> ManyState s s
f s
cs Step s b
sres =
        case Step s b
sres of
            Partial s
ss -> Step (ManyState s s) c -> m (Step (ManyState s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyState s s) c -> m (Step (ManyState s s) c))
-> Step (ManyState s s) c -> m (Step (ManyState s s) c)
forall a b. (a -> b) -> a -> b
$ ManyState s s -> Step (ManyState s s) c
forall s b. s -> Step s b
Partial (ManyState s s -> Step (ManyState s s) c)
-> ManyState s s -> Step (ManyState s s) c
forall a b. (a -> b) -> a -> b
$ s -> s -> ManyState s s
f s
ss s
cs
            Done b
sb -> s -> b -> m (Step s c)
cstep s
cs b
sb m (Step s c)
-> (Step s c -> m (Step (ManyState s s) c))
-> m (Step (ManyState s s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Step s c -> m (Step (ManyState s s) c)
collect

    collect :: Step s c -> m (Step (ManyState s s) c)
collect Step s c
cres =
        case Step s c
cres of
            Partial s
cs -> m (Step s b)
sinitial m (Step s b)
-> (Step s b -> m (Step (ManyState s s) c))
-> m (Step (ManyState s s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s -> s -> ManyState s s)
-> s -> Step s b -> m (Step (ManyState s s) c)
split s -> s -> ManyState s s
forall s1 s2. s1 -> s2 -> ManyState s1 s2
ManyFirst s
cs
            Done c
cb -> Step (ManyState s s) c -> m (Step (ManyState s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ManyState s s) c -> m (Step (ManyState s s) c))
-> Step (ManyState s s) c -> m (Step (ManyState s s) c)
forall a b. (a -> b) -> a -> b
$ c -> Step (ManyState s s) c
forall s b. b -> Step s b
Done c
cb

    -- A fold may terminate even without accepting a single input.  So we run
    -- the split fold's initial action even if no input is received.  However,
    -- this means that if no input was ever received by "step" we discard the
    -- fold's initial result which could have generated an effect. However,
    -- note that if "sinitial" results in Done we do collect its output even
    -- though the fold may not have received any input. XXX Is this
    -- inconsistent?
    initial :: m (Step (ManyState s s) c)
initial = m (Step s c)
cinitial m (Step s c)
-> (Step s c -> m (Step (ManyState s s) c))
-> m (Step (ManyState s s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Step s c -> m (Step (ManyState s s) c)
collect

    {-# INLINE step_ #-}
    step_ :: s -> s -> a -> m (Step (ManyState s s) c)
step_ s
ss s
cs a
a = s -> a -> m (Step s b)
sstep s
ss a
a m (Step s b)
-> (Step s b -> m (Step (ManyState s s) c))
-> m (Step (ManyState s s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s -> s -> ManyState s s)
-> s -> Step s b -> m (Step (ManyState s s) c)
split s -> s -> ManyState s s
forall s1 s2. s1 -> s2 -> ManyState s1 s2
ManyLoop s
cs

    {-# INLINE step #-}
    step :: ManyState s s -> a -> m (Step (ManyState s s) c)
step (ManyFirst s
ss s
cs) a
a = s -> s -> a -> m (Step (ManyState s s) c)
step_ s
ss s
cs a
a
    step (ManyLoop s
ss s
cs) a
a = s -> s -> a -> m (Step (ManyState s s) c)
step_ s
ss s
cs a
a

    -- Do not extract the split fold if no item was consumed.
    extract :: ManyState s s -> m c
extract (ManyFirst s
_ s
cs) = s -> m c
cextract s
cs
    extract (ManyLoop s
ss s
cs) = do
        Step s c
cres <- s -> m b
sextract s
ss m b -> (b -> m (Step s c)) -> m (Step s c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> b -> m (Step s c)
cstep s
cs
        case Step s c
cres of
            Partial s
s -> s -> m c
cextract s
s
            Done c
b -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
b

-- | Like many, but inner fold emits an output at the end even if no input is
-- received.
--
-- /Internal/
--
-- /See also: 'Streamly.Prelude.concatMap', 'Streamly.Prelude.foldMany'/
--
{-# INLINE manyPost #-}
manyPost :: Monad m => Fold m a b -> Fold m b c -> Fold m a c
manyPost :: Fold m a b -> Fold m b c -> Fold m a c
manyPost (Fold s -> a -> m (Step s b)
sstep m (Step s b)
sinitial s -> m b
sextract) (Fold s -> b -> m (Step s c)
cstep m (Step s c)
cinitial s -> m c
cextract) =
    (Tuple' s s -> a -> m (Step (Tuple' s s) c))
-> m (Step (Tuple' s s) c) -> (Tuple' s s -> m c) -> Fold m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold Tuple' s s -> a -> m (Step (Tuple' s s) c)
step m (Step (Tuple' s s) c)
initial Tuple' s s -> m c
extract

    where

    -- cs = collect state
    -- ss = split state
    -- cres = collect state result
    -- sres = split state result
    -- cb = collect done
    -- sb = split done

    -- Caution! There is mutual recursion here, inlining the right functions is
    -- important.

    {-# INLINE split #-}
    split :: s -> Step s b -> m (Step (Tuple' s s) c)
split s
cs Step s b
sres =
        case Step s b
sres of
            Partial s
ss1 -> Step (Tuple' s s) c -> m (Step (Tuple' s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' s s) c -> m (Step (Tuple' s s) c))
-> Step (Tuple' s s) c -> m (Step (Tuple' s s) c)
forall a b. (a -> b) -> a -> b
$ Tuple' s s -> Step (Tuple' s s) c
forall s b. s -> Step s b
Partial (Tuple' s s -> Step (Tuple' s s) c)
-> Tuple' s s -> Step (Tuple' s s) c
forall a b. (a -> b) -> a -> b
$ s -> s -> Tuple' s s
forall a b. a -> b -> Tuple' a b
Tuple' s
ss1 s
cs
            Done b
sb -> s -> b -> m (Step s c)
cstep s
cs b
sb m (Step s c)
-> (Step s c -> m (Step (Tuple' s s) c)) -> m (Step (Tuple' s s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Step s c -> m (Step (Tuple' s s) c)
collect

    collect :: Step s c -> m (Step (Tuple' s s) c)
collect Step s c
cres =
        case Step s c
cres of
            Partial s
cs -> m (Step s b)
sinitial m (Step s b)
-> (Step s b -> m (Step (Tuple' s s) c)) -> m (Step (Tuple' s s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Step s b -> m (Step (Tuple' s s) c)
split s
cs
            Done c
cb -> Step (Tuple' s s) c -> m (Step (Tuple' s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' s s) c -> m (Step (Tuple' s s) c))
-> Step (Tuple' s s) c -> m (Step (Tuple' s s) c)
forall a b. (a -> b) -> a -> b
$ c -> Step (Tuple' s s) c
forall s b. b -> Step s b
Done c
cb

    initial :: m (Step (Tuple' s s) c)
initial = m (Step s c)
cinitial m (Step s c)
-> (Step s c -> m (Step (Tuple' s s) c)) -> m (Step (Tuple' s s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Step s c -> m (Step (Tuple' s s) c)
collect

    {-# INLINE step #-}
    step :: Tuple' s s -> a -> m (Step (Tuple' s s) c)
step (Tuple' s
ss s
cs) a
a = s -> a -> m (Step s b)
sstep s
ss a
a m (Step s b)
-> (Step s b -> m (Step (Tuple' s s) c)) -> m (Step (Tuple' s s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> Step s b -> m (Step (Tuple' s s) c)
split s
cs

    extract :: Tuple' s s -> m c
extract (Tuple' s
ss s
cs) = do
        Step s c
cres <- s -> m b
sextract s
ss m b -> (b -> m (Step s c)) -> m (Step s c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> b -> m (Step s c)
cstep s
cs
        case Step s c
cres of
            Partial s
s -> s -> m c
cextract s
s
            Done c
b -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
b

-- | @chunksOf n split collect@ repeatedly applies the @split@ fold to chunks
-- of @n@ items in the input stream and supplies the result to the @collect@
-- fold.
--
-- >>> twos = Fold.chunksOf 2 Fold.toList Fold.toList
-- >>> Stream.fold twos $ Stream.fromList [1..10]
-- [[1,2],[3,4],[5,6],[7,8],[9,10]]
--
-- > chunksOf n split = many (take n split)
--
-- Stops when @collect@ stops.
--
-- @since 0.8.0
--
{-# INLINE chunksOf #-}
chunksOf :: Monad m => Int -> Fold m a b -> Fold m b c -> Fold m a c
chunksOf :: Int -> Fold m a b -> Fold m b c -> Fold m a c
chunksOf Int
n Fold m a b
split = Fold m a b -> Fold m b c -> Fold m a c
forall (m :: * -> *) a b c.
Monad m =>
Fold m a b -> Fold m b c -> Fold m a c
many (Int -> Fold m a b -> Fold m a b
forall (m :: * -> *) a b.
Monad m =>
Int -> Fold m a b -> Fold m a b
take Int
n Fold m a b
split)

------------------------------------------------------------------------------
-- Refold and Fold Combinators
------------------------------------------------------------------------------

-- | Like 'many' but uses a 'Refold' for collecting.
--
{-# INLINE refoldMany #-}
refoldMany :: Monad m => Fold m a b -> Refold m x b c -> Refold m x a c
refoldMany :: Fold m a b -> Refold m x b c -> Refold m x a c
refoldMany (Fold s -> a -> m (Step s b)
sstep m (Step s b)
sinitial s -> m b
sextract) (Refold s -> b -> m (Step s c)
cstep x -> m (Step s c)
cinject s -> m c
cextract) =
    (Tuple' s (Either s s) -> a -> m (Step (Tuple' s (Either s s)) c))
-> (x -> m (Step (Tuple' s (Either s s)) c))
-> (Tuple' s (Either s s) -> m c)
-> Refold m x a c
forall (m :: * -> *) c a b s.
(s -> a -> m (Step s b))
-> (c -> m (Step s b)) -> (s -> m b) -> Refold m c a b
Refold Tuple' s (Either s s) -> a -> m (Step (Tuple' s (Either s s)) c)
step x -> m (Step (Tuple' s (Either s s)) c)
forall b. x -> m (Step (Tuple' s (Either s b)) c)
inject Tuple' s (Either s s) -> m c
forall a. Tuple' s (Either a s) -> m c
extract

    where

    -- cs = collect state
    -- ss = split state
    -- cres = collect state result
    -- sres = split state result
    -- cb = collect done
    -- sb = split done

    -- Caution! There is mutual recursion here, inlining the right functions is
    -- important.

    {-# INLINE split #-}
    split :: s
-> (s -> Either s b)
-> Step s b
-> m (Step (Tuple' s (Either s b)) c)
split s
cs s -> Either s b
f Step s b
sres =
        case Step s b
sres of
            Partial s
ss -> Step (Tuple' s (Either s b)) c
-> m (Step (Tuple' s (Either s b)) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' s (Either s b)) c
 -> m (Step (Tuple' s (Either s b)) c))
-> Step (Tuple' s (Either s b)) c
-> m (Step (Tuple' s (Either s b)) c)
forall a b. (a -> b) -> a -> b
$ Tuple' s (Either s b) -> Step (Tuple' s (Either s b)) c
forall s b. s -> Step s b
Partial (Tuple' s (Either s b) -> Step (Tuple' s (Either s b)) c)
-> Tuple' s (Either s b) -> Step (Tuple' s (Either s b)) c
forall a b. (a -> b) -> a -> b
$ s -> Either s b -> Tuple' s (Either s b)
forall a b. a -> b -> Tuple' a b
Tuple' s
cs (s -> Either s b
f s
ss)
            Done b
sb -> s -> b -> m (Step s c)
cstep s
cs b
sb m (Step s c)
-> (Step s c -> m (Step (Tuple' s (Either s b)) c))
-> m (Step (Tuple' s (Either s b)) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Step s c -> m (Step (Tuple' s (Either s b)) c)
collect

    collect :: Step s c -> m (Step (Tuple' s (Either s b)) c)
collect Step s c
cres =
        case Step s c
cres of
            Partial s
cs -> m (Step s b)
sinitial m (Step s b)
-> (Step s b -> m (Step (Tuple' s (Either s b)) c))
-> m (Step (Tuple' s (Either s b)) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s
-> (s -> Either s b)
-> Step s b
-> m (Step (Tuple' s (Either s b)) c)
split s
cs s -> Either s b
forall a b. a -> Either a b
Left
            Done c
cb -> Step (Tuple' s (Either s b)) c
-> m (Step (Tuple' s (Either s b)) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' s (Either s b)) c
 -> m (Step (Tuple' s (Either s b)) c))
-> Step (Tuple' s (Either s b)) c
-> m (Step (Tuple' s (Either s b)) c)
forall a b. (a -> b) -> a -> b
$ c -> Step (Tuple' s (Either s b)) c
forall s b. b -> Step s b
Done c
cb

    inject :: x -> m (Step (Tuple' s (Either s b)) c)
inject x
x = x -> m (Step s c)
cinject x
x m (Step s c)
-> (Step s c -> m (Step (Tuple' s (Either s b)) c))
-> m (Step (Tuple' s (Either s b)) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Step s c -> m (Step (Tuple' s (Either s b)) c)
forall b. Step s c -> m (Step (Tuple' s (Either s b)) c)
collect

    {-# INLINE step_ #-}
    step_ :: s -> s -> a -> m (Step (Tuple' s (Either s s)) c)
step_ s
ss s
cs a
a = s -> a -> m (Step s b)
sstep s
ss a
a m (Step s b)
-> (Step s b -> m (Step (Tuple' s (Either s s)) c))
-> m (Step (Tuple' s (Either s s)) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s
-> (s -> Either s s)
-> Step s b
-> m (Step (Tuple' s (Either s s)) c)
forall b.
s
-> (s -> Either s b)
-> Step s b
-> m (Step (Tuple' s (Either s b)) c)
split s
cs s -> Either s s
forall a b. b -> Either a b
Right

    {-# INLINE step #-}
    step :: Tuple' s (Either s s) -> a -> m (Step (Tuple' s (Either s s)) c)
step (Tuple' s
cs (Left s
ss)) a
a = s -> s -> a -> m (Step (Tuple' s (Either s s)) c)
step_ s
ss s
cs a
a
    step (Tuple' s
cs (Right s
ss)) a
a = s -> s -> a -> m (Step (Tuple' s (Either s s)) c)
step_ s
ss s
cs a
a

    -- Do not extract the split fold if no item was consumed.
    extract :: Tuple' s (Either a s) -> m c
extract (Tuple' s
cs (Left a
_)) = s -> m c
cextract s
cs
    extract (Tuple' s
cs (Right s
ss )) = do
        Step s c
cres <- s -> m b
sextract s
ss m b -> (b -> m (Step s c)) -> m (Step s c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> b -> m (Step s c)
cstep s
cs
        case Step s c
cres of
            Partial s
s -> s -> m c
cextract s
s
            Done c
b -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
b

{-# ANN type ConsumeManyState Fuse #-}
data ConsumeManyState x cs ss = ConsumeMany x cs (Either ss ss)

-- | Like 'many' but uses a 'Refold' for splitting.
--
-- /Internal/
{-# INLINE refoldMany1 #-}
refoldMany1 :: Monad m => Refold m x a b -> Fold m b c -> Refold m x a c
refoldMany1 :: Refold m x a b -> Fold m b c -> Refold m x a c
refoldMany1 (Refold s -> a -> m (Step s b)
sstep x -> m (Step s b)
sinject s -> m b
sextract) (Fold s -> b -> m (Step s c)
cstep m (Step s c)
cinitial s -> m c
cextract) =
    (ConsumeManyState x s s
 -> a -> m (Step (ConsumeManyState x s s) c))
-> (x -> m (Step (ConsumeManyState x s s) c))
-> (ConsumeManyState x s s -> m c)
-> Refold m x a c
forall (m :: * -> *) c a b s.
(s -> a -> m (Step s b))
-> (c -> m (Step s b)) -> (s -> m b) -> Refold m c a b
Refold ConsumeManyState x s s -> a -> m (Step (ConsumeManyState x s s) c)
step x -> m (Step (ConsumeManyState x s s) c)
inject ConsumeManyState x s s -> m c
forall x. ConsumeManyState x s s -> m c
extract

    where

    -- cs = collect state
    -- ss = split state
    -- cres = collect state result
    -- sres = split state result
    -- cb = collect done
    -- sb = split done

    -- Caution! There is mutual recursion here, inlining the right functions is
    -- important.

    {-# INLINE split #-}
    split :: x
-> s
-> (s -> Either s s)
-> Step s b
-> m (Step (ConsumeManyState x s s) c)
split x
x s
cs s -> Either s s
f Step s b
sres =
        case Step s b
sres of
            Partial s
ss -> Step (ConsumeManyState x s s) c
-> m (Step (ConsumeManyState x s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConsumeManyState x s s) c
 -> m (Step (ConsumeManyState x s s) c))
-> Step (ConsumeManyState x s s) c
-> m (Step (ConsumeManyState x s s) c)
forall a b. (a -> b) -> a -> b
$ ConsumeManyState x s s -> Step (ConsumeManyState x s s) c
forall s b. s -> Step s b
Partial (ConsumeManyState x s s -> Step (ConsumeManyState x s s) c)
-> ConsumeManyState x s s -> Step (ConsumeManyState x s s) c
forall a b. (a -> b) -> a -> b
$ x -> s -> Either s s -> ConsumeManyState x s s
forall x cs ss. x -> cs -> Either ss ss -> ConsumeManyState x cs ss
ConsumeMany x
x s
cs (s -> Either s s
f s
ss)
            Done b
sb -> s -> b -> m (Step s c)
cstep s
cs b
sb m (Step s c)
-> (Step s c -> m (Step (ConsumeManyState x s s) c))
-> m (Step (ConsumeManyState x s s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> Step s c -> m (Step (ConsumeManyState x s s) c)
collect x
x

    collect :: x -> Step s c -> m (Step (ConsumeManyState x s s) c)
collect x
x Step s c
cres =
        case Step s c
cres of
            Partial s
cs -> x -> m (Step s b)
sinject x
x m (Step s b)
-> (Step s b -> m (Step (ConsumeManyState x s s) c))
-> m (Step (ConsumeManyState x s s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x
-> s
-> (s -> Either s s)
-> Step s b
-> m (Step (ConsumeManyState x s s) c)
split x
x s
cs s -> Either s s
forall a b. a -> Either a b
Left
            Done c
cb -> Step (ConsumeManyState x s s) c
-> m (Step (ConsumeManyState x s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConsumeManyState x s s) c
 -> m (Step (ConsumeManyState x s s) c))
-> Step (ConsumeManyState x s s) c
-> m (Step (ConsumeManyState x s s) c)
forall a b. (a -> b) -> a -> b
$ c -> Step (ConsumeManyState x s s) c
forall s b. b -> Step s b
Done c
cb

    inject :: x -> m (Step (ConsumeManyState x s s) c)
inject x
x = m (Step s c)
cinitial m (Step s c)
-> (Step s c -> m (Step (ConsumeManyState x s s) c))
-> m (Step (ConsumeManyState x s s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x -> Step s c -> m (Step (ConsumeManyState x s s) c)
collect x
x

    {-# INLINE step_ #-}
    step_ :: x -> s -> s -> a -> m (Step (ConsumeManyState x s s) c)
step_ x
x s
ss s
cs a
a = s -> a -> m (Step s b)
sstep s
ss a
a m (Step s b)
-> (Step s b -> m (Step (ConsumeManyState x s s) c))
-> m (Step (ConsumeManyState x s s) c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= x
-> s
-> (s -> Either s s)
-> Step s b
-> m (Step (ConsumeManyState x s s) c)
split x
x s
cs s -> Either s s
forall a b. b -> Either a b
Right

    {-# INLINE step #-}
    step :: ConsumeManyState x s s -> a -> m (Step (ConsumeManyState x s s) c)
step (ConsumeMany x
x s
cs (Left s
ss)) a
a = x -> s -> s -> a -> m (Step (ConsumeManyState x s s) c)
step_ x
x s
ss s
cs a
a
    step (ConsumeMany x
x s
cs (Right s
ss)) a
a = x -> s -> s -> a -> m (Step (ConsumeManyState x s s) c)
step_ x
x s
ss s
cs a
a

    -- Do not extract the split fold if no item was consumed.
    extract :: ConsumeManyState x s s -> m c
extract (ConsumeMany x
_ s
cs (Left s
_)) = s -> m c
cextract s
cs
    extract (ConsumeMany x
_ s
cs (Right s
ss )) = do
        Step s c
cres <- s -> m b
sextract s
ss m b -> (b -> m (Step s c)) -> m (Step s c)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> b -> m (Step s c)
cstep s
cs
        case Step s c
cres of
            Partial s
s -> s -> m c
cextract s
s
            Done c
b -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return c
b

-- | Extract the output of a fold and refold it using a 'Refold'.
--
-- /Internal/
{-# INLINE refold #-}
refold :: Monad m => Fold m a b -> Refold m b a b -> Fold m a b
refold :: Fold m a b -> Refold m b a b -> Fold m a b
refold Fold m a b
f (Refold s -> a -> m (Step s b)
step b -> m (Step s b)
inject s -> m b
extract) = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step (Fold m a b -> m b
forall (m :: * -> *) a b. Monad m => Fold m a b -> m b
finish Fold m a b
f m b -> (b -> m (Step s b)) -> m (Step s b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m (Step s b)
inject) s -> m b
extract