{-# LANGUAGE CPP #-}
-- |
-- 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: Tee/Zip is simple, cannot be appended, good for scanning.
-- * Terminating folds: Tee/Zip varies based on termination, can be appended,
--   good for scanning, nesting (many) is easy.
-- * Non-failing (backtracking only) parsers: cannot be used as scans because
--   of backtracking, nesting is complicated because of backtracking, appending
--   is efficient because of no Alternative, Alternative does not make sense
--   because it cannot fail.
-- * Parsers: Alternative on failure, appending is not as efficient because of
--   buffering for Alternative.
--
-- First two are represented by the 'Fold' type and the last two by the
-- 'Parser' type.
--
-- == Folds that never terminate (Accumulators)
--
-- An @Accumulator@ is the simplest type of fold, it never fails and never
-- terminates. It can always accept more inputs (never terminates) and the
-- accumulator is always valid.  For example 'Streamly.Internal.Data.Fold.sum'.
-- Traditional Haskell left folds like 'foldl' are accumulators.
--
-- Accumulators can be composed in parallel where we distribute the input
-- stream to all accumulators.  Since accumulators never terminate they cannot
-- be appended.
--
-- An accumulator can be represented as:
--
-- @
-- data Fold0 m a b =
--   forall s. Fold0
--      (s -> a -> m s) -- step
--      (m s)           -- initial
--      (s -> m b)      -- extract
-- @
--
-- This is just a traditional left fold, compare with @foldl@. The driver of
-- the fold would call @initial@ at the beginning and then keep accumulating
-- inputs into its result using @step@ and finally extract the result using
-- @extract@.
--
-- == Folds that terminate after one or more input
--
-- @Terminating folds@ are accumulators that can terminate, like accumulators
-- they do not fail. Once a fold terminates it no longer accepts any more
-- inputs.  Terminating folds can be appended, the next fold can be
-- applied after the first one terminates.  Because they cannot fail, 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 process the stream into chunks of
-- fixed size.
--
-- A terminating fold can be represented as:
--
-- @
-- data Step s b
--     = Partial !s -- the fold can accept more input
--     | Done !b    -- the fold is done
--
-- data Fold1 m a b =
--   forall s. Fold1
--      (s -> a -> m (Step s b)) -- step
--      (m s)                    -- initial
--      (s -> m b)               -- extract
-- @
--
-- The fold driver stops driving the fold as soon as the fold returns a @Done@.
-- @extract@ is required only if the fold has not stopped yet and the input
-- ends. @extract@ can never be called if the fold is @Done@.
--
-- Notice that the @initial@ of `Fold1` type does not return a "Step" type,
-- therefore, it cannot say "Done" in initial. It always has to consume at
-- least one element before it can say "Done" for termination, via the @step@
-- function.
--
-- == Folds that terminate after 0 or more input
--
-- The `Fold1` type makes combinators like @take 0@ impossible to implement
-- because they need to terminate even before they can consume any elements at
-- all.  Implementing this requires the @initial@ function to be able to return
-- @Done@.
--
-- @
-- data Fold m a b =
--   forall s. Fold
--      (s -> a -> m (Step s b)) -- step
--      (m (Step s b))           -- initial
--      (s -> m b)               -- extract
-- @
--
-- This is also required if we want to compose terminating folds using an
-- Applicative or Monadic composition. @pure@ needs to yield an output without
-- having to consume an input.
--
-- @initial@ now has the ability to terminate the fold without consuming any
-- input based on the state of the monad.
--
-- In some cases it does not make sense to use a fold that does not consume any
-- items at all, and it may even lead to an infinite loop. It might make sense
-- to use a `Fold1` type for such cases because it guarantees to consume at
-- least one input, therefore, guarantees progress. For example, in
-- classifySessionsBy or any other splitting operations it may not make sense
-- to pass a fold that never consumes an input. However, we do not have a
-- separate Fold1 type for the sake of simplicity of types/API.
--
-- Adding this capability adds a certain amount of complexity in the
-- implementation of fold combinators. @initial@ has to always handle two cases
-- now.  We could potentially not implement this in folds to keep fold
-- implementation simpler, and these use cases can be transferred to the parser
-- type. However, it would be a bit inconvenient to not have a `take` operation
-- or to not be able to use `take 0` if we have it. Also, applicative and
-- monadic composition of folds would not be possible.
--
-- == Terminating Folds with backtracking
--
-- 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 the unconsumed input to the fold driver.
--
-- Single element leftover case is quite common and its easy to implement it in
-- terminating folds by adding 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 most important one is that we
-- cannot use such folds for scanning. We cannot backtrack after producing an
-- output in a scan.
--
-- === Nested backtracking
--
-- Nesting of backtracking folds increases the amount of backtracking required
-- exponentially.
--
-- For example, the combinator @many inner outer@ applies the outer fold on the
-- input stream and applies the inner fold on the results of the outer fold.
--
-- many :: Monad m => Fold m b c -> Fold m a b -> Fold m a c
--
-- If the inner fold itself returns a @Done1@ then we need to backtrack all
-- the elements that have been consumed by the outer fold to generate that
-- value. We need backtracking of more than one element.
--
-- Arbitrary backtracking requires arbitrary buffering. However, we do not want
-- to buffer unconditionally, only if the buffer is needed. One way to do this
-- is to use a "Continue" constructor like parsers. When we have nested folds,
-- the top level fold always returns a "Continue" to the driver until an output
-- is generated by it, this means the top level driver keeps buffering until an
-- output is generated via Partial or Done. Intermediate level "Continue" keep
-- propagating up to the top level.
--
-- === Parallel backtracking
--
-- In compositions like Alternative and Distributive we may have several
-- branches. Each branch can backtrack independently. We need to keep the input
-- as long as any of the branches need it. We can use a single copy of the
-- buffer and maintain it based on all the branches, or we can make each branch
-- have its own buffer. The latter approach may be simpler to implement.
-- Whenever we branch we can introduce an independent buffer for backtracking.
-- Or we can use a newtype that allows branched composition to handle
-- backtracking.
--
-- === Implementation Approach
--
-- To avoid these issues we can enforce, by using types, that the collecting
-- folds can never return a leftover.  This leads us to define a type that can
-- never return a leftover. The use cases of single leftover can be 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.
--
-- A proposed design is to use the same Step type with Error in Folds as well
-- as Parsers. Folds won't use the Error constructor and even if they use, it
-- will be equivalent to just throwing an error. They won't have an
-- alternative.
--
-- Because of the complexity of implementing a distributive composition in
-- presence of backtracking we could possibly have a type without backtracking
-- but with the "Continue" constructor, and use either the Parser type or
-- another type for backtracking.
--
-- == Folds with an additional input
--
-- The `Fold` type does not allow a dynamic input to be used to generate the
-- initial value of the fold accumulator. We can extend the type further to
-- allow that:
--
-- @
-- data Refold m i a b =
--   forall s. Refold
--      (s -> a -> m (Step s b)) -- step
--      (i -> m (Step s b))      -- initial
--      (s -> m b)               -- extract
-- @
--
-- == 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.
--
-- We add @Error@ and @Continue@ to the @Step@ type of fold. @Continue@ is to
-- skip producing an output or to backtrack. We also add the ability to
-- backtrack in @Partial@ and @Done@.:
--
-- Also @extract@ now needs to be able to express an error. We could have it
-- return the @Step@ type as well but that makes the implementation more
-- complicated.
--
-- @
-- data Step s b =
--       Partial Int s   -- partial result and how much to backtrack
--     | Done Int b      -- final result and how much to backtrack
--     | Continue Int s  -- no result and how much to backtrack
--     | Error String    -- error
--
-- data Parser a m b =
--   forall s. Fold
--      (s -> a -> m (Step s b))   -- step
--      (m (Step s b))             -- initial
--      (s -> m (Either String b)) -- extract
-- @
--
-- = Types for Stream Consumers
--
-- We do not have a 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 return @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.
--
-- = 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.
--
module Streamly.Internal.Data.Fold.Type
    (
    -- * Imports
    -- $setup

    -- * Types
      Step (..)
    , Fold (..)

    -- * Constructors
    , foldl'
    , foldlM'
    , foldl1'
    , foldlM1'
    , foldt'
    , foldtM'
    , foldr'
    , foldrM'

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

    -- * Combinators

    -- ** Mapping output
    , rmapM

    -- ** Mapping Input
    , lmap
    , lmapM
    , postscan

    -- ** Filtering
    , catMaybes
    , scanMaybe
    , filter
    , filtering
    , filterM
    , catLefts
    , catRights
    , catEithers

    -- ** Trimming
    , take
    , taking
    , dropping

    -- ** Sequential application
    , splitWith -- rename to "append"
    , split_

    -- ** Repeated Application (Splitting)
    , ManyState
    , many
    , manyPost
    , groupsOf
    , refoldMany
    , refoldMany1

    -- ** Nested Application
    , concatMap
    , duplicate
    , refold

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

    -- ** Parallel Alternative
    , shortest
    , longest

    -- * Running A Fold
    , extractM
    , reduce
    , snoc
    , addOne
    , snocM
    , snocl
    , snoclM
    , close
    , isClosed

    -- * Transforming inner monad
    , morphInner
    , generalizeInner

    -- * Deprecated
    , foldr
    , serialWith
    )
where

#include "inline.hs"

import Control.Applicative (liftA2)
import Control.Monad ((>=>))
import Data.Bifunctor (Bifunctor(..))
import Data.Either (fromLeft, fromRight, isLeft, isRight)
import Data.Functor.Identity (Identity(..))
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)

#include "DocTestDataFold.hs"

------------------------------------------------------------------------------
-- 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 released, smart constructors are provided
-- to create folds.
--
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.
--
{-# INLINE rmapM #-}
rmapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c
rmapM :: forall (m :: * -> *) b c a.
Monad m =>
(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) = 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 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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)
-- @
--
{-# INLINE foldl' #-}
foldl' :: Monad m => (b -> a -> b) -> b -> Fold m a b
foldl' :: forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' b -> a -> b
step b
initial =
    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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial forall a b. (a -> b) -> a -> b
$ b -> a -> b
step b
s a
a)
        (forall (m :: * -> *) a. Monad m => a -> m a
return (forall s b. s -> Step s b
Partial b
initial))
        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)
-- @
--
{-# INLINE foldlM' #-}
foldlM' :: Monad m => (b -> a -> m b) -> m b -> Fold m a b
foldlM' :: forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
foldlM' b -> a -> m b
step m b
initial =
    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 -> forall s b. s -> Step s b
Partial forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> a -> m b
step b
s a
a) (forall s b. s -> Step s b
Partial forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
initial) 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.
--
-- /Pre-release/
{-# INLINE foldl1' #-}
foldl1' :: Monad m => (a -> a -> a) -> Fold m a (Maybe a)
foldl1' :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
foldl1' a -> a -> a
step = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe' a -> Maybe a
toMaybe forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' Maybe' a -> a -> Maybe' a
step1 forall a. Maybe' a
Nothing'

    where

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

-- | Like 'foldl1\'' but with a monadic step function.
--
-- /Pre-release/
{-# INLINE foldlM1' #-}
foldlM1' :: Monad m => (a -> a -> m a) -> Fold m a (Maybe a)
foldlM1' :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> m a) -> Fold m a (Maybe a)
foldlM1' a -> a -> m a
step = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe' a -> Maybe a
toMaybe forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
foldlM' Maybe' a -> a -> m (Maybe' a)
step1 (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe' a
Nothing')

    where

    step1 :: Maybe' a -> a -> m (Maybe' a)
step1 Maybe' a
Nothing' a
a = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe' a
Just' a
a
    step1 (Just' a
x) a
a = forall a. a -> Maybe' a
Just' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> m 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 a strict right fold can only be useful for constructing strict
-- structures in memory. For reductions this will be very inefficient.
--
-- Definitions:
--
-- >>> foldr' f z = fmap (flip appEndo z) $ Fold.foldMap (Endo . f)
-- >>> foldr' f z = fmap ($ z) $ Fold.foldl' (\g x -> g . f x) id
--
-- Example:
--
-- >>> Stream.fold (Fold.foldr' (:) []) $ Stream.enumerateFromTo 1 5
-- [1,2,3,4,5]
--
{-# INLINE foldr' #-}
foldr' :: Monad m => (a -> b -> b) -> b -> Fold m a b
foldr' :: forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Fold m a b
foldr' a -> b -> b
f b
z = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ b
z) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' (\b -> b
g a
x -> b -> b
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> b
f a
x) forall a. a -> a
id

{-# DEPRECATED foldr "Please use foldr' instead." #-}
{-# INLINE foldr #-}
foldr :: Monad m => (a -> b -> b) -> b -> Fold m a b
foldr :: forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Fold m a b
foldr = forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Fold m a b
foldr'

-- 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.
--
-- Example:
--
-- >>> toList = Fold.foldrM' (\a xs -> return $ a : xs) (return [])
--
-- See also: 'Streamly.Internal.Data.Stream.foldrM'
--
-- /Pre-release/
{-# INLINE foldrM' #-}
foldrM' :: Monad m => (a -> b -> m b) -> m b -> Fold m a b
foldrM' :: forall (m :: * -> *) a b.
Monad m =>
(a -> b -> m b) -> m b -> Fold m a b
foldrM' a -> b -> m b
g m b
z =
    forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Fold m a b -> Fold m a c
rmapM (m b
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
foldlM' (\b -> m b
f a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a -> b -> m b
g a
x forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> m b
f) (forall (m :: * -> *) a. Monad m => a -> m a
return 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 foldt' #-}
foldt' :: Monad m => (s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
foldt' :: forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
foldt' s -> a -> Step s b
step Step s b
initial s -> b
extract =
    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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ s -> a -> Step s b
step s
s a
a) (forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
initial) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> b
extract)

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

------------------------------------------------------------------------------
-- 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 :: forall (m :: * -> *) c a b. 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 =
    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 = Fold.drainMapM (const (return ()))
-- >>> drain = Fold.foldl' (\_ _ -> ()) ()
--
{-# INLINE drain #-}
drain :: Monad m => Fold m a ()
drain :: forall (m :: * -> *) a. Monad m => Fold m a ()
drain = 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"
-- instead.
--
-- >>> toList = Fold.foldr' (:) []
--
{-# INLINE toList #-}
toList :: Monad m => Fold m a [a]
toList :: forall (m :: * -> *) a. Monad m => Fold m a [a]
toList = 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.StreamK n a)
toStreamKRev :: forall (m :: * -> *) a (n :: * -> *).
Monad m =>
Fold m a (StreamK n a)
toStreamKRev = forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a (m :: * -> *). a -> StreamK m a -> StreamK m a
K.cons) forall (m :: * -> *) a. StreamK 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.StreamK n a)
toStreamK :: forall (m :: * -> *) a (n :: * -> *).
Monad m =>
Fold m a (StreamK n a)
toStreamK = forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Fold m a b
foldr forall a (m :: * -> *). a -> StreamK m a -> StreamK m a
K.cons forall (m :: * -> *) a. StreamK 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 :: forall a b. (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) = 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 (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 = 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 = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
g)

-- XXX These are singleton folds that are closed for input. The correspondence
-- to a nil stream would be a nil fold that returns "Done" in "initial" i.e. it
-- does not produce any accumulator value. However, we do not have a
-- representation of an empty value in folds, because the Done constructor
-- always produces a value (Done b). We can potentially use "Partial s b" and
-- "Done" to make the type correspond to the stream type. That may be possible
-- if we introduce the "Skip" constructor as well because after the last
-- "Partial s b" we have to emit a "Skip to Done" state to keep cranking the
-- fold until it is done.
--
-- There is also the asymmetry between folds and streams because folds have an
-- "initial" to initialize the fold without any input. A similar concept is
-- possible in streams as well to stop the stream. That would be a "closing"
-- operation for the stream which can be called even without consuming any item
-- from the stream or when we are done consuming.
--
-- However, the initial action in folds creates a discrepancy with the CPS
-- folds, and the same may be the case if we have a stop/cleanup operation in
-- streams.

-- | Make a fold that yields the supplied value without consuming any further
-- input.
--
-- /Pre-release/
--
{-# INLINE fromPure #-}
fromPure :: Applicative m => b -> Fold m a b
fromPure :: forall (m :: * -> *) b a. Applicative m => b -> Fold m a b
fromPure b
b = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold forall a. HasCallStack => a
undefined (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall s b. b -> Step s b
Done b
b) forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Make a fold that yields the result of the supplied effectful action
-- without consuming any further input.
--
-- /Pre-release/
--
{-# INLINE fromEffect #-}
fromEffect :: Applicative m => m b -> Fold m a b
fromEffect :: forall (m :: * -> *) b a. Applicative m => m b -> Fold m a b
fromEffect m b
b = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold forall a. HasCallStack => a
undefined (forall s b. b -> Step s b
Done forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
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.
--
-- Example:
--
-- >>> header = Fold.take 8 Fold.toList
-- >>> line = Fold.takeEndBy (== '\n') Fold.toList
-- >>> f = Fold.splitWith (,) header line
-- >>> Stream.fold f $ Stream.fromList "header: hello\n"
-- ("header: ","hello\n")
--
-- Note: This is dual to appending streams using 'Data.Stream.append'.
--
-- 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. When you need
-- scaling use parser monad instead.
--
-- /Time: O(n^2) where n is the number of compositions./
--
{-# INLINE splitWith #-}
splitWith :: Monad m =>
    (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
splitWith :: forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
splitWith 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) =
    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 a c) -> (c -> d) -> f (p (SeqFoldState sl (c -> d) a) d)
runR f (p a c)
action c -> d
f = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall sl f sr. f -> sr -> SeqFoldState sl f sr
SeqFoldR c -> d
f) c -> d
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (p a c)
action

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

    initial :: m (Step (SeqFoldState s (b -> c) s) c)
initial = forall {s1}.
m (Step s1 a) -> m (Step (SeqFoldState s1 (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 = forall {s1}.
m (Step s1 a) -> m (Step (SeqFoldState s1 (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 = forall {f :: * -> *} {p :: * -> * -> *} {a} {c} {d} {sl}.
(Functor f, Bifunctor p) =>
f (p a c) -> (c -> d) -> f (p (SeqFoldState sl (c -> d) a) 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) = 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
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
func a
rL)
            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 -> forall (m :: * -> *) a. Monad m => a -> m a
return b
rR

{-# DEPRECATED serialWith "Please use \"splitWith\" instead" #-}
{-# INLINE serialWith #-}
serialWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
serialWith :: forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
serialWith = forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
splitWith

{-# 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 splitWith, but the current benchmarks show that it has the same
-- performance. So do not expose it unless some benchmark shows benefit.
--
{-# INLINE split_ #-}
split_ :: Monad m => Fold m x a -> Fold m x b -> Fold m x b
split_ :: forall (m :: * -> *) x a b.
Monad m =>
Fold m x a -> Fold m x b -> Fold m x b
split_ (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) =
    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 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial forall a b. (a -> b) -> a -> b
$ forall sl sr. sl -> SeqFoldState_ sl sr
SeqFoldL_ s
sl
            Done a
_ -> do
                Step s b
resR <- m (Step s b)
initialR
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial (forall sl sr. sl -> SeqFoldState_ sl sr
SeqFoldL_ s
s)
            Done a
_ -> do
                Step s b
resR <- m (Step s b)
initialR
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first 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
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return b
rR

-- | 'Applicative' form of 'splitWith'. Split the input serially over two
-- folds. Note that this fuses but performance degrades quadratically with
-- respect to the number of compositions. It should be good to use for less
-- than 8 compositions.
instance Monad m => Applicative (Fold m a) where
    {-# INLINE pure #-}
    pure :: forall a. a -> Fold m a a
pure = forall (m :: * -> *) b a. Applicative m => b -> Fold m a b
fromPure

    {-# INLINE (<*>) #-}
    <*> :: forall a b. Fold m a (a -> b) -> Fold m a a -> Fold m a b
(<*>) = forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
splitWith forall a. a -> a
id

    {-# INLINE (*>) #-}
    *> :: forall a b. Fold m a a -> Fold m a b -> Fold m a b
(*>) = forall (m :: * -> *) x a b.
Monad m =>
Fold m x a -> Fold m x b -> Fold m x b
split_

    {-# INLINE liftA2 #-}
    liftA2 :: forall a b c.
(a -> b -> c) -> Fold m a a -> Fold m a b -> Fold m a c
liftA2 a -> b -> c
f Fold m a a
x = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b -> c
f Fold m a a
x)

{-# 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@.
--
-- Definition:
--
-- >>> teeWith k f1 f2 = fmap (uncurry k) (Fold.tee f1 f2)
--
-- Example:
--
-- >>> avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length)
-- >>> Stream.fold avg $ Stream.fromList [1.0..100.0]
-- 50.5
--
-- For applicative composition using this combinator see
-- "Streamly.Data.Fold.Tee".
--
-- See also: "Streamly.Data.Fold.Tee"
--
-- Note that nested applications of teeWith do not fuse.
--
{-# INLINE teeWith #-}
teeWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
teeWith :: forall (m :: * -> *) a b c x.
Monad m =>
(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) =
    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
        forall (m :: * -> *) a. Monad m => a -> m a
return
            forall a b. (a -> b) -> a -> b
$ case Step sL a
resL of
                  Partial sL
sl ->
                      forall s b. s -> Step s b
Partial
                          forall a b. (a -> b) -> a -> b
$ case Step sR b
resR of
                                Partial sR
sr -> forall sL sR bL bR. sL -> sR -> TeeState sL sR bL bR
TeeBoth sL
sl sR
sr
                                Done b
br -> forall sL sR bL bR. bR -> sL -> TeeState sL sR bL bR
TeeLeft b
br sL
sl
                  Done a
bl -> forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (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 = 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 = 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 = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall sL sR bL bR. bR -> sL -> TeeState sL sR bL bR
TeeLeft b
bR) (a -> b -> c
`f` b
bR) 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 = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall sL sR bL bR. bL -> sR -> TeeState sL sR bL bR
TeeRight a
bL) (a -> b -> c
f a
bL) 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m a
extractL s
sL 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) 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 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 :: forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
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) =
    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 ->
                forall (m :: * -> *) a. Monad m => a -> m a
return
                    forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial
                    forall a b. (a -> b) -> a -> b
$ case Step s c
resR of
                        Partial s
sr -> forall sL sR b. sL -> sR -> TeeFstState sL sR b
TeeFstBoth sL
sl s
sr
                        Done c
br -> forall sL sR b. b -> sL -> TeeFstState sL sR b
TeeFstLeft c
br sL
sl
            Done b
bl -> do
                forall s b. b -> Step s b
Done forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c -> d
f b
bl 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return c
br

    initial :: m (Step (TeeFstState s s c) d)
initial = 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 = 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 = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall sL sR b. b -> sL -> TeeFstState sL sR b
TeeFstLeft c
bR) (b -> c -> d
`f` c
bR) 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
sL 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) 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 :: forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
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) =
    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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> Tuple' a b
Tuple' s
sl s
sr
                    Done c
br -> forall s b. b -> Step s b
Done forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> c -> d
`f` c
br) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
sl

            Done b
bl -> do
                forall s b. b -> Step s b
Done forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> c -> d
f b
bl 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 -> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
sL 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 :: forall (m :: * -> *) x a b.
Monad m =>
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
_) =
    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 forall {b} {b}. Tuple' s b -> m (Either a b)
extract

    where

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

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

    initial :: m (Step (LongestState s s) (Either a b))
initial = forall {m :: * -> *} {sL} {a} {sR} {c} {b}.
Monad m =>
m (Step sL a)
-> m (Step sR c) -> 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 = forall {m :: * -> *} {sL} {a} {sR} {c} {b}.
Monad m =>
m (Step sL a)
-> m (Step sR c) -> 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 = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall sL sR. sL -> LongestState sL sR
LongestLeft forall a b. a -> Either a b
Left 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 = forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall sL sR. sR -> LongestState sL sR
LongestRight forall a b. b -> Either a b
Right 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 = forall a b. a -> Either a b
Left 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) = forall {b}. s -> m (Either a b)
left s
sL
    extract (LongestRight s
sR) = forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractR s
sR
    extract (LongestBoth s
sL s
_) = 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)

-- | 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.one
-- >>> total n = Fold.take n Fold.sum
-- >>> Stream.fold (Fold.concatMap total count) $ Stream.fromList [10,9..1]
-- 45
--
-- This does not fuse completely, see 'refold' for a fusible alternative.
--
-- /Time: O(n^2) where @n@ is the number of compositions./
--
-- See also: 'Streamly.Internal.Data.Stream.foldIterateM', 'refold'
--
{-# INLINE concatMap #-}
concatMap :: Monad m => (b -> Fold m a c) -> Fold m a b -> Fold m a c
concatMap :: forall (m :: * -> *) b a c.
Monad m =>
(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) = 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 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial (forall (m :: * -> *) sa a c. sa -> ConcatMapState m sa a c
B s
s)
            Done b
b -> 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial (forall (m :: * -> *) sa a c. sa -> ConcatMapState m sa a c
B s
s1)
            Done b
b -> 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
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Partial s
sc -> forall s b. s -> Step s b
Partial (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 -> 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
        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
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Partial s
s -> forall s b. s -> Step s b
Partial (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 -> 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 -> 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.
--
-- Definition:
--
-- >>> lmap = Fold.lmapM return
--
-- Example:
--
-- >>> sumSquared = Fold.lmap (\x -> x * x) Fold.sum
-- >>> Stream.fold sumSquared (Stream.enumerateFromTo 1 100)
-- 338350
--
{-# INLINE lmap #-}
lmap :: (a -> b) -> Fold m b r -> Fold m a r
lmap :: forall a b (m :: * -> *) r. (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) = 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.
--
{-# INLINE lmapM #-}
lmapM :: Monad m => (a -> m b) -> Fold m b r -> Fold m a r
lmapM :: forall (m :: * -> *) a b r.
Monad m =>
(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) = 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> b -> m (Step s r)
step s
x

-- | Postscan the input of a 'Fold' to change it in a stateful manner using
-- another 'Fold'.
--
-- @postscan scanner collector@
--
-- /Pre-release/
{-# INLINE postscan #-}
postscan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c
postscan :: forall (m :: * -> *) a b c.
Monad m =>
Fold m a b -> Fold m b c -> Fold m a c
postscan (Fold s -> a -> m (Step s b)
stepL m (Step s b)
initialL s -> m b
extractL) (Fold s -> b -> m (Step s c)
stepR m (Step s c)
initialR s -> m c
extractR) =
    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 -> m (Step (s, s) c)
step m (Step (s, s) c)
initial forall {a}. (a, s) -> m c
extract

    where

    {-# INLINE runStep #-}
    runStep :: m (Step s b) -> s -> m (Step (s, s) c)
runStep m (Step s b)
actionL s
sR = do
        Step s b
rL <- m (Step s b)
actionL
        case Step s b
rL of
            Done b
bL -> do
                Step s c
rR <- s -> b -> m (Step s c)
stepR s
sR b
bL
                case Step s c
rR of
                    Partial s
sR1 -> forall s b. b -> Step s b
Done forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
extractR s
sR1
                    Done c
bR -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. b -> Step s b
Done c
bR
            Partial s
sL -> do
                !b
b <- s -> m b
extractL s
sL
                Step s c
rR <- s -> b -> m (Step s c)
stepR s
sR b
b
                forall (m :: * -> *) a. Monad m => a -> m a
return
                    forall a b. (a -> b) -> a -> b
$ case Step s c
rR of
                        Partial s
sR1 -> forall s b. s -> Step s b
Partial (s
sL, s
sR1)
                        Done c
bR -> forall s b. b -> Step s b
Done c
bR

    initial :: m (Step (s, s) c)
initial = do
        Step s c
r <- m (Step s c)
initialR
        Step s b
rL <- m (Step s b)
initialL
        case Step s c
r of
            Partial s
sR ->
                case Step s b
rL of
                    Done b
_ -> forall s b. b -> Step s b
Done forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
extractR s
sR
                    Partial s
sL -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial (s
sL, s
sR)
            Done c
b -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. b -> Step s b
Done c
b

    step :: (s, s) -> a -> m (Step (s, s) c)
step (s
sL, s
sR) a
x = m (Step s b) -> s -> m (Step (s, s) c)
runStep (s -> a -> m (Step s b)
stepL s
sL a
x) s
sR

    extract :: (a, s) -> m c
extract = s -> m c
extractR forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd

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

-- | Modify a fold to receive a 'Maybe' input, the 'Just' values are unwrapped
-- and sent to the original fold, 'Nothing' values are discarded.
--
-- >>> catMaybes = Fold.mapMaybe id
-- >>> catMaybes = Fold.filter isJust . Fold.lmap fromJust
--
{-# INLINE_NORMAL catMaybes #-}
catMaybes :: Monad m => Fold m a b -> Fold m (Maybe a) b
catMaybes :: forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Fold m (Maybe a) b
catMaybes (Fold s -> a -> m (Step s b)
step m (Step s b)
initial s -> m b
extract) = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> Maybe a -> m (Step s b)
step1 m (Step s b)
initial s -> m b
extract

    where

    step1 :: s -> Maybe a -> m (Step s b)
step1 s
s Maybe a
a =
        case Maybe a
a of
            Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial s
s
            Just a
x -> s -> a -> m (Step s b)
step s
s a
x

-- | Use a 'Maybe' returning fold as a filtering scan.
--
-- >>> scanMaybe p f = Fold.postscan p (Fold.catMaybes f)
--
-- /Pre-release/
{-# INLINE scanMaybe #-}
scanMaybe :: Monad m => Fold m a (Maybe b) -> Fold m b c -> Fold m a c
scanMaybe :: forall (m :: * -> *) a b c.
Monad m =>
Fold m a (Maybe b) -> Fold m b c -> Fold m a c
scanMaybe Fold m a (Maybe b)
f1 Fold m b c
f2 = forall (m :: * -> *) a b c.
Monad m =>
Fold m a b -> Fold m b c -> Fold m a c
postscan Fold m a (Maybe b)
f1 (forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Fold m (Maybe a) b
catMaybes Fold m b c
f2)

-- | A scanning fold for filtering elements based on a predicate.
--
{-# INLINE filtering #-}
filtering :: Monad m => (a -> Bool) -> Fold m a (Maybe a)
filtering :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Fold m a (Maybe a)
filtering a -> Bool
f = forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' forall {p}. p -> a -> Maybe a
step forall a. Maybe a
Nothing

    where

    step :: p -> a -> Maybe a
step p
_ a
a = if a -> Bool
f a
a then forall a. a -> Maybe a
Just a
a else forall a. Maybe a
Nothing

-- | Include only those elements that pass a predicate.
--
-- >>> Stream.fold (Fold.filter (> 5) Fold.sum) $ Stream.fromList [1..10]
-- 40
--
-- >>> filter p = Fold.scanMaybe (Fold.filtering p)
-- >>> filter p = Fold.filterM (return . p)
-- >>> filter p = Fold.mapMaybe (\x -> if p x then Just x else Nothing)
--
{-# INLINE filter #-}
filter :: Monad m => (a -> Bool) -> Fold m a r -> Fold m a r
-- filter p = scanMaybe (filtering p)
filter :: forall (m :: * -> *) a r.
Monad m =>
(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) = 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 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial s
x

-- | Like 'filter' but with a monadic predicate.
--
-- >>> f p x = p x >>= \r -> return $ if r then Just x else Nothing
-- >>> filterM p = Fold.mapMaybeM (f p)
--
{-# INLINE filterM #-}
filterM :: Monad m => (a -> m Bool) -> Fold m a r -> Fold m a r
filterM :: forall (m :: * -> *) a r.
Monad m =>
(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) = 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 forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial s
x

------------------------------------------------------------------------------
-- Either streams
------------------------------------------------------------------------------

-- | Discard 'Right's and unwrap 'Left's in an 'Either' stream.
--
-- /Pre-release/
--
{-# INLINE catLefts #-}
catLefts :: (Monad m) => Fold m a c -> Fold m (Either a b) c
catLefts :: forall (m :: * -> *) a c b.
Monad m =>
Fold m a c -> Fold m (Either a b) c
catLefts = forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Fold m a r -> Fold m a r
filter forall a b. Either a b -> Bool
isLeft forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (forall a b. a -> Either a b -> a
fromLeft forall a. HasCallStack => a
undefined)

-- | Discard 'Left's and unwrap 'Right's in an 'Either' stream.
--
-- /Pre-release/
--
{-# INLINE catRights #-}
catRights :: (Monad m) => Fold m b c -> Fold m (Either a b) c
catRights :: forall (m :: * -> *) b c a.
Monad m =>
Fold m b c -> Fold m (Either a b) c
catRights = forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Fold m a r -> Fold m a r
filter forall a b. Either a b -> Bool
isRight forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (forall b a. b -> Either a b -> b
fromRight forall a. HasCallStack => a
undefined)

-- | Remove the either wrapper and flatten both lefts and as well as rights in
-- the output stream.
--
-- Definition:
--
-- >>> catEithers = Fold.lmap (either id id)
--
-- /Pre-release/
--
{-# INLINE catEithers #-}
catEithers :: Fold m a b -> Fold m (Either a a) b
catEithers :: forall (m :: * -> *) a b. Fold m a b -> Fold m (Either a a) b
catEithers = forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id)

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

-- Required to fuse "take" with "many" in "groupsOf", 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
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

{-# INLINE taking #-}
taking :: Monad m => Int -> Fold m a (Maybe a)
taking :: forall (m :: * -> *) a. Monad m => Int -> Fold m a (Maybe a)
taking Int
n = forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
foldt' forall {a} {b} {a}.
(Ord a, Num a) =>
Tuple'Fused a b -> a -> Step (Tuple'Fused a (Maybe a)) (Maybe a)
step forall {a} {a}. Step (Tuple'Fused Int (Maybe a)) (Maybe a)
initial forall {a} {b}. Tuple'Fused a b -> b
extract

    where

    initial :: Step (Tuple'Fused Int (Maybe a)) (Maybe a)
initial =
        if Int
n forall a. Ord a => a -> a -> Bool
<= Int
0
        then forall s b. b -> Step s b
Done forall a. Maybe a
Nothing
        else forall s b. s -> Step s b
Partial (forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused Int
n forall a. Maybe a
Nothing)

    step :: Tuple'Fused a b -> a -> Step (Tuple'Fused a (Maybe a)) (Maybe a)
step (Tuple'Fused a
i b
_) a
a =
        if a
i forall a. Ord a => a -> a -> Bool
> a
1
        then forall s b. s -> Step s b
Partial (forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused (a
i forall a. Num a => a -> a -> a
- a
1) (forall a. a -> Maybe a
Just a
a))
        else forall s b. b -> Step s b
Done (forall a. a -> Maybe a
Just a
a)

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

{-# INLINE dropping #-}
dropping :: Monad m => Int -> Fold m a (Maybe a)
dropping :: forall (m :: * -> *) a. Monad m => Int -> Fold m a (Maybe a)
dropping Int
n = forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
foldt' forall {a} {b} {a} {b}.
(Ord a, Num a) =>
Tuple'Fused a b -> a -> Step (Tuple'Fused a (Maybe a)) b
step forall {a} {b}. Step (Tuple'Fused Int (Maybe a)) b
initial forall {a} {b}. Tuple'Fused a b -> b
extract

    where

    initial :: Step (Tuple'Fused Int (Maybe a)) b
initial = forall s b. s -> Step s b
Partial (forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused Int
n forall a. Maybe a
Nothing)

    step :: Tuple'Fused a b -> a -> Step (Tuple'Fused a (Maybe a)) b
step (Tuple'Fused a
i b
_) a
a =
        if a
i forall a. Ord a => a -> a -> Bool
> a
0
        then forall s b. s -> Step s b
Partial (forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused (a
i forall a. Num a => a -> a -> a
- a
1) forall a. Maybe a
Nothing)
        else forall s b. s -> Step s b
Partial (forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused a
i (forall a. a -> Maybe a
Just a
a))

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

-- | 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]
--
{-# INLINE take #-}
take :: Monad m => Int -> Fold m a b -> Fold m a b
-- take n = scanMaybe (taking n)
take :: forall (m :: * -> *) a b.
Monad m =>
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) = 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 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 forall a. Num a => a -> a -> a
+ Int
1
                    s1 :: Tuple'Fused Int s
s1 = forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused Int
i1 s
s
                if Int
i1 forall a. Ord a => a -> a -> Bool
< Int
n
                then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial Tuple'Fused Int s
s1
                else forall s b. b -> Step s b
Done forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
fextract s
s
            Done b
b -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> 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 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 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
------------------------------------------------------------------------------

-- Similar to the comonad "duplicate" operation.

-- | '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.
--
-- '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 :: forall (m :: * -> *) a b.
Monad m =>
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) =
    forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {a}.
Applicative m =>
s -> a -> m (Step s (Fold m a b))
step forall {a}. m (Step s (Fold m a b))
initial (\s
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> 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 (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> 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 = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall (m :: * -> *) b a. Applicative m => b -> Fold m a b
fromPure 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 = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall (m :: * -> *) b a. Applicative m => b -> Fold m a b
fromPure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> a -> m (Step s b)
step1 s
s a
a

-- If there were a finalize/flushing action in the stream type that would be
-- equivalent to running initialize in Fold. But we do not have a flushing
-- action in streams.

-- | Evaluate the initialization effect of a fold. If we are building the fold
-- by chaining lazy actions in fold init this would reduce the actions to a
-- strict accumulator value.
--
-- /Pre-release/
{-# INLINE reduce #-}
reduce :: Monad m => Fold m a b -> m (Fold m a b)
reduce :: forall (m :: * -> *) a b. Monad m => Fold m a b -> m (Fold m a b)
reduce (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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> 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 (forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
i) s -> m b
extract

-- This is the dual of Stream @cons@.

-- | Append an effect to the fold lazily, in other words run a single
-- step of the fold.
--
-- /Pre-release/
{-# INLINE snoclM #-}
snoclM :: Monad m => Fold m a b -> m a -> Fold m a b
snoclM :: forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> m a -> Fold m a b
snoclM (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) m a
action = 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)
fstep m (Step s b)
initial s -> m b
fextract

    where

    initial :: m (Step s b)
initial = do
        Step s b
res <- m (Step s b)
finitial
        case Step s b
res of
            Partial s
fs -> m a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> a -> m (Step s b)
fstep s
fs
            Done b
b -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. b -> Step s b
Done b
b

-- | Append a singleton value to the fold lazily, in other words run a single
-- step of the fold.
--
-- Definition:
--
-- >>> snocl f = Fold.snoclM f . return
--
-- Example:
--
-- >>> import qualified Data.Foldable as Foldable
-- >>> Fold.extractM $ Foldable.foldl Fold.snocl Fold.toList [1..3]
-- [1,2,3]
--
-- /Pre-release/
{-# INLINE snocl #-}
snocl :: Monad m => Fold m a b -> a -> Fold m a b
-- snocl f = snoclM f . return
snocl :: forall (m :: * -> *) a b. Monad m => Fold m a b -> a -> Fold m a b
snocl (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) a
a = 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)
fstep m (Step s b)
initial s -> m b
fextract

    where

    initial :: m (Step s b)
initial = do
        Step s b
res <- m (Step s b)
finitial
        case Step s b
res of
            Partial s
fs -> s -> a -> m (Step s b)
fstep s
fs a
a
            Done b
b -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. b -> Step s b
Done b
b

-- | Append a singleton value to the fold in other words run a single step of
-- the fold.
--
-- Definition:
--
-- >>> snocM f = Fold.reduce . Fold.snoclM f
--
-- /Pre-release/
{-# INLINE snocM #-}
snocM :: Monad m => Fold m a b -> m a -> m (Fold m a b)
snocM :: forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> m a -> m (Fold m a b)
snocM (Fold s -> a -> m (Step s b)
step m (Step s b)
initial s -> m b
extract) m a
action = do
    Step s b
res <- m (Step s b)
initial
    Step s b
r <- case Step s b
res of
          Partial s
fs -> m a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> a -> m (Step s b)
step s
fs
          Done b
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> 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 (forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
r) s -> m b
extract

-- Definitions:
--
-- >>> snoc f = Fold.reduce . Fold.snocl f
-- >>> snoc f = Fold.snocM f . return

-- | Append a singleton value to the fold, in other words run a single step of
-- the fold.
--
-- Example:
--
-- >>> import qualified Data.Foldable as Foldable
-- >>> Foldable.foldlM Fold.snoc Fold.toList [1..3] >>= Fold.drive Stream.nil
-- [1,2,3]
--
-- /Pre-release/
{-# INLINE snoc #-}
snoc :: Monad m => Fold m a b -> a -> m (Fold m a b)
snoc :: forall (m :: * -> *) a b.
Monad m =>
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
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> 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 (forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
r) s -> m b
extract

-- | Append a singleton value to the fold.
--
-- See examples under 'addStream'.
--
-- /Pre-release/
{-# INLINE addOne #-}
addOne :: Monad m => a -> Fold m a b -> m (Fold m a b)
addOne :: forall (m :: * -> *) a b.
Monad m =>
a -> Fold m a b -> m (Fold m a b)
addOne = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> a -> m (Fold m a b)
snoc

-- Similar to the comonad "extract" operation.
-- XXX rename to extract. We can use "extr" for the fold extract function.

-- | Extract the accumulated result of the fold.
--
-- Definition:
--
-- >>> extractM = Fold.drive Stream.nil
--
-- Example:
--
-- >>> Fold.extractM Fold.toList
-- []
--
-- /Pre-release/
{-# INLINE extractM #-}
extractM :: Monad m => Fold m a b -> m b
extractM :: forall {m :: * -> *} {a} {b}. Monad m => Fold m a b -> m b
extractM (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 -> forall (m :: * -> *) a. Monad m => a -> m a
return b
b

-- | Close a fold so that it does not accept any more input.
{-# INLINE close #-}
close :: Monad m => Fold m a b -> Fold m a b
close :: forall (m :: * -> *) a b. Monad m => Fold m a b -> Fold m a b
close (Fold s -> a -> m (Step s b)
_ m (Step s b)
initial1 s -> m b
extract1) = forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold forall a. HasCallStack => a
undefined forall {s}. m (Step s b)
initial forall a. HasCallStack => a
undefined

    where

    initial :: m (Step s b)
initial = do
        Step s b
res <- m (Step s b)
initial1
        case Step s b
res of
              Partial s
s -> forall s b. b -> Step s b
Done forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extract1 s
s
              Done b
b -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. b -> Step s b
Done b
b

-- Corresponds to the null check for streams.

-- | Check if the fold has terminated and can take no more input.
--
-- /Pre-release/
{-# INLINE isClosed #-}
isClosed :: Monad m => Fold m a b -> m Bool
isClosed :: forall (m :: * -> *) a b. Monad m => Fold m a b -> m Bool
isClosed (Fold s -> a -> m (Step s b)
_ m (Step s b)
initial s -> m b
_) = do
    Step s b
res <- m (Step s b)
initial
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Step s b
res of
          Partial s
_ -> Bool
False
          Done b
_ -> Bool
True

------------------------------------------------------------------------------
-- 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 first second@ applies
-- the @first@ fold repeatedly on the input stream and accumulates it's results
-- using the @second@ fold.
--
-- >>> 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 @second@ fold stops.
--
-- See also: 'Data.Stream.concatMap', 'Data.Stream.foldMany'
--
{-# INLINE many #-}
many :: Monad m => Fold m a b -> Fold m b c -> Fold m a c
many :: forall (m :: * -> *) a b c.
Monad m =>
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) =
    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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial 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 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 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 forall s1 s2. s1 -> s2 -> ManyState s1 s2
ManyFirst s
cs
            Done c
cb -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 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 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 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 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return c
b

-- | Like many, but the "first" fold emits an output at the end even if no
-- input is received.
--
-- /Internal/
--
-- See also: 'Data.Stream.concatMap', 'Data.Stream.foldMany'
--
{-# INLINE manyPost #-}
manyPost :: Monad m => Fold m a b -> Fold m b c -> Fold m a c
manyPost :: forall (m :: * -> *) a b c.
Monad m =>
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) =
    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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial forall a b. (a -> b) -> a -> b
$ 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 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 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. b -> Step s b
Done c
cb

    initial :: m (Step (Tuple' s s) c)
initial = m (Step s c)
cinitial 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 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 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return c
b

-- | @groupsOf 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.
--
-- Definition:
--
-- >>> groupsOf n split = Fold.many (Fold.take n split)
--
-- Example:
--
-- >>> twos = Fold.groupsOf 2 Fold.toList Fold.toList
-- >>> Stream.fold twos $ Stream.fromList [1..10]
-- [[1,2],[3,4],[5,6],[7,8],[9,10]]
--
-- Stops when @collect@ stops.
--
{-# INLINE groupsOf #-}
groupsOf :: Monad m => Int -> Fold m a b -> Fold m b c -> Fold m a c
groupsOf :: forall (m :: * -> *) a b c.
Monad m =>
Int -> Fold m a b -> Fold m b c -> Fold m a c
groupsOf Int
n Fold m a b
split = forall (m :: * -> *) a b c.
Monad m =>
Fold m a b -> Fold m b c -> Fold m a c
many (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 :: forall (m :: * -> *) a b x c.
Monad m =>
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) =
    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 forall {b}. x -> m (Step (Tuple' s (Either s b)) c)
inject 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial forall a b. (a -> b) -> a -> 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 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 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 forall a b. a -> Either a b
Left
            Done c
cb -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {b}.
s
-> (s -> Either s b)
-> Step s b
-> m (Step (Tuple' s (Either s b)) c)
split s
cs 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 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 -> 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 :: forall (m :: * -> *) x a b c.
Monad m =>
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) =
    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 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall s b. s -> Step s b
Partial forall a b. (a -> b) -> a -> b
$ 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 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 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 forall a b. a -> Either a b
Left
            Done c
cb -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 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 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 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 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return c
b

-- | Extract the output of a fold and refold it using a 'Refold'.
--
-- A fusible alternative to 'concatMap'.
--
-- /Internal/
{-# INLINE refold #-}
refold :: Monad m => Refold m b a c -> Fold m a b -> Fold m a c
refold :: forall (m :: * -> *) b a c.
Monad m =>
Refold m b a c -> Fold m a b -> Fold m a c
refold (Refold s -> a -> m (Step s c)
step b -> m (Step s c)
inject s -> m c
extract) Fold m a b
f =
    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)
step (forall {m :: * -> *} {a} {b}. Monad m => Fold m a b -> m b
extractM Fold m a b
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m (Step s c)
inject) s -> m c
extract

------------------------------------------------------------------------------
-- morphInner
------------------------------------------------------------------------------

-- | Change the underlying monad of a fold. Also known as hoist.
--
-- /Pre-release/
morphInner :: (forall x. m x -> n x) -> Fold m a b -> Fold n a b
morphInner :: forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x) -> Fold m a b -> Fold n a b
morphInner forall x. m x -> n x
f (Fold s -> a -> m (Step s b)
step m (Step s b)
initial s -> m b
extract) =
    forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold (\s
x a
a -> forall x. m x -> n x
f forall a b. (a -> b) -> a -> b
$ s -> a -> m (Step s b)
step s
x a
a) (forall x. m x -> n x
f m (Step s b)
initial) (forall x. m x -> n x
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m b
extract)

-- | Adapt a pure fold to any monad.
--
-- >>> generalizeInner = Fold.morphInner (return . runIdentity)
--
-- /Pre-release/
generalizeInner :: Monad m => Fold Identity a b -> Fold m a b
generalizeInner :: forall (m :: * -> *) a b.
Monad m =>
Fold Identity a b -> Fold m a b
generalizeInner = forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x) -> Fold m a b -> Fold n a b
morphInner (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Identity a -> a
runIdentity)