{-# 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.
--
-- == Cleanup Action
--
-- Fold may use other folds in the downstream pipeline. When a fold is done and
-- it wants to terminate it needs to wait for the downstream folds before it
-- returns. For example, if the downstream fold is an async fold we need to
-- wait for the async fold to finish and return the final result.
--
-- To be able to support this use case we need a cleanup action in the fold.
-- The fold gets finalized once the cleanup is called and we can use extract to
-- get the final state/result of the fold.
--
-- Similar to folds we may have a cleanup action in streams as well. Currently,
-- we rely on GC to cleanup the streams, if we use a cleanup action then we can
-- perform cleanup quickly. Also, similar to folds we can also have an
-- "initial" action in streams as well to generate the initial state. It could
-- decouple the initialization of the stream from the first element being
-- pulled. For example, you may want to start a timer at initialization rather
-- than at the first element pull of the stream.
--
-- == 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
    (
      module Streamly.Internal.Data.Fold.Step

    -- * Fold Type
    , Fold (..)

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

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

    -- * Combinators

    -- ** Mapping output
    , rmapM

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

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

    -- ** Trimming
    , take
    , taking
    , takeEndBy_
    , takeEndBy
    , 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"

#if !MIN_VERSION_base(4,18,0)
import Control.Applicative (liftA2)
#endif
import Control.Monad ((>=>), void)
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.Maybe.Strict (Maybe'(..), toMaybe)
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
import Streamly.Internal.Data.Refold.Type (Refold(..))

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

import Prelude hiding (Foldable(..), concatMap, filter, map, take)

-- Entire module is exported, do not import selectively
import Streamly.Internal.Data.Fold.Step

#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".

-- An alternative to using an "extract" function is to use "Partial s b" style
-- partial value so that we always emit the output value and there is no need
-- to extract. Then extract can be used for cleanup purposes. But in this case
-- in some cases we may need a "Continue" constructor where an output value is
-- not available, this was implicit earlier. Also, "b" should be lazy here so
-- that we do not always compute it even if we do not need it.
--
-- Partial s b  --> extract :: s -> b
-- Continue     --> extract :: s -> Maybe b
--
-- But keeping 'b' lazy does not let the fold optimize well. It leads to
-- significant regressions in the key-value folds.
--
-- The "final" function complicates combinators that take other folds as
-- argument because we need to call their finalizers at right places. An
-- alternative to reduce this complexity where it is not required is to use a
-- separate type for bracketed folds but then we need to manage the complexity
-- of two different fold types.

-- The "final" function could be (s -> m (Step s b)), like in parsers so that
-- it can be called in a loop to drain the fold.

-- | The type @Fold m a b@ represents a consumer of an input stream of values
-- of type @a@ and returning a final value of type @b@ in 'Monad' @m@. The
-- constructor of a fold is @Fold step initial extract final@.
--
-- The fold uses an internal state of type @s@. The initial value of the state
-- @s@ is created by @initial@. This function is called once and only once
-- before the fold starts consuming input. Any resource allocation can be done
-- in this function.
--
-- The @step@ function is called on each input, it consumes an input and
-- returns the next intermediate state (see 'Step') or the final result @b@ if
-- the fold terminates.
--
-- If the fold is used as a scan, the @extract@ function is used by the scan
-- driver to map the current state @s@ of the fold to the fold result. Thus
-- @extract@ can be called multiple times. In some folds, where scanning does
-- not make sense, this function is left unimplemented; such folds cannot be
-- used as scans.
--
-- Before a fold terminates, @final@ is called once and only once (unless the
-- fold terminated in @initial@ itself). Any resources allocated by @initial@
-- can be released in @final@. In folds that do not require any cleanup
-- @extract@ and @final@ are typically the same.
--
-- When implementing fold combinators, care should be taken to cleanup any
-- state of the argument folds held by the fold by calling the respective
-- @final@ at all exit points of the fold. Also, @final@ should not be called
-- more than once. Note that if a fold terminates by 'Done' constructor, there
-- is no state to cleanup.
--
-- NOTE: The constructor is not yet released, smart constructors are provided
-- to create folds.
--
data Fold m a b =
  -- | @Fold@ @step@ @initial@ @extract@ @final@
  forall s. Fold (s -> a -> m (Step s b)) (m (Step s b)) (s -> m 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 s -> m b
final) =
    (s -> a -> m (Step s c))
-> m (Step s c) -> (s -> m c) -> (s -> m c) -> Fold m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s c)
step1 m (Step s c)
initial1 (s -> m b
extract (s -> m b) -> (b -> m c) -> s -> m c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> m c
f) (s -> m b
final (s -> m b) -> (b -> m c) -> s -> m c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> m c
f)

    where

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

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

-- | Make a fold from a left fold style pure step function and initial value of
-- the accumulator.
--
-- If your 'Fold' returns only 'Partial' (i.e. never returns a 'Done') then you
-- can use @foldl'*@ constructors.
--
-- A fold with an extract function can be expressed using fmap:
--
-- @
-- mkfoldlx :: Monad m => (s -> a -> s) -> s -> (s -> b) -> Fold m a b
-- mkfoldlx step initial extract = fmap extract (foldl' step initial)
-- @
--
{-# 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 =
    (b -> a -> m (Step b b))
-> m (Step b b) -> (b -> m b) -> (b -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold
        (\b
s a
a -> Step b b -> m (Step b b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step b b -> m (Step b b)) -> Step b b -> m (Step b b)
forall a b. (a -> b) -> a -> b
$ b -> Step b b
forall s b. s -> Step s b
Partial (b -> Step b b) -> b -> Step b b
forall a b. (a -> b) -> a -> b
$ b -> a -> b
step b
s a
a)
        (Step b b -> m (Step b b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> Step b b
forall s b. s -> Step s b
Partial b
initial))
        b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
        b -> m b
forall a. a -> m a
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 =
    (b -> a -> m (Step b b))
-> m (Step b b) -> (b -> m b) -> (b -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold (\b
s a
a -> b -> Step b b
forall s b. s -> Step s b
Partial (b -> Step b b) -> m b -> m (Step b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> a -> m b
step b
s a
a) (b -> Step b b
forall s b. s -> Step s b
Partial (b -> Step b b) -> m b -> m (Step b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
initial) b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b -> m b
forall a. a -> m a
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 = (Maybe' a -> Maybe a) -> Fold m a (Maybe' a) -> Fold m a (Maybe a)
forall a b. (a -> b) -> Fold m a a -> Fold m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe' a -> Maybe a
forall a. Maybe' a -> Maybe a
toMaybe (Fold m a (Maybe' a) -> Fold m a (Maybe a))
-> Fold m a (Maybe' a) -> Fold m a (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Maybe' a -> a -> Maybe' a) -> Maybe' a -> Fold m a (Maybe' a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' Maybe' a -> a -> Maybe' a
step1 Maybe' a
forall a. Maybe' a
Nothing'

    where

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

-- | 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 = (Maybe' a -> Maybe a) -> Fold m a (Maybe' a) -> Fold m a (Maybe a)
forall a b. (a -> b) -> Fold m a a -> Fold m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe' a -> Maybe a
forall a. Maybe' a -> Maybe a
toMaybe (Fold m a (Maybe' a) -> Fold m a (Maybe a))
-> Fold m a (Maybe' a) -> Fold m a (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Maybe' a -> a -> m (Maybe' a))
-> m (Maybe' a) -> Fold m a (Maybe' a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
foldlM' Maybe' a -> a -> m (Maybe' a)
step1 (Maybe' a -> m (Maybe' a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe' a
forall a. Maybe' a
Nothing')

    where

    step1 :: Maybe' a -> a -> m (Maybe' a)
step1 Maybe' a
Nothing' a
a = Maybe' a -> m (Maybe' a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe' a -> m (Maybe' a)) -> Maybe' a -> m (Maybe' a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe' a
forall a. a -> Maybe' a
Just' a
a
    step1 (Just' a
x) a
a = a -> Maybe' a
forall a. a -> Maybe' a
Just' (a -> Maybe' a) -> m a -> m (Maybe' a)
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 = ((b -> b) -> b) -> Fold m a (b -> b) -> Fold m a b
forall a b. (a -> b) -> Fold m a a -> Fold m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ b
z) (Fold m a (b -> b) -> Fold m a b)
-> Fold m a (b -> b) -> Fold m a b
forall a b. (a -> b) -> a -> b
$ ((b -> b) -> a -> b -> b) -> (b -> b) -> Fold m a (b -> b)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' (\b -> b
g a
x -> b -> b
g (b -> b) -> (b -> b) -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> b
f a
x) b -> b
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 = (a -> b -> b) -> b -> Fold m a b
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 =
    ((b -> m b) -> m b) -> Fold m a (b -> m b) -> Fold m a b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Fold m a b -> Fold m a c
rmapM (m b
z m b -> (b -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) (Fold m a (b -> m b) -> Fold m a b)
-> Fold m a (b -> m b) -> Fold m a b
forall a b. (a -> b) -> a -> b
$ ((b -> m b) -> a -> m (b -> m b))
-> m (b -> m b) -> Fold m a (b -> m b)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
foldlM' (\b -> m b
f a
x -> (b -> m b) -> m (b -> m b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((b -> m b) -> m (b -> m b)) -> (b -> m b) -> m (b -> m b)
forall a b. (a -> b) -> a -> b
$ a -> b -> m b
g a
x (b -> m b) -> (b -> m b) -> b -> m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> b -> m b
f) ((b -> m b) -> m (b -> m b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b -> m b
forall a. a -> m a
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 =
    (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold
        (\s
s a
a -> Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ s -> a -> Step s b
step s
s a
a)
        (Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
initial)
        (b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> (s -> b) -> s -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> b
extract)
        (b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> (s -> b) -> s -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> b
extract)

-- | 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' s -> a -> m (Step s b)
step m (Step s b)
initial s -> m b
extract = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step m (Step s b)
initial s -> m b
extract s -> m b
extract

------------------------------------------------------------------------------
-- 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 =
    (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (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 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 = (() -> a -> ()) -> () -> Fold m a ()
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' (\()
_ a
_ -> ()) ()

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

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

--  xn : ... : x2 : x1 : []
{-# INLINE toStreamKRev #-}
toStreamKRev :: Monad m => Fold m a (K.StreamK n a)
toStreamKRev :: forall (m :: * -> *) a (n :: * -> *).
Monad m =>
Fold m a (StreamK n a)
toStreamKRev = (StreamK n a -> a -> StreamK n a)
-> StreamK n a -> Fold m a (StreamK n a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' ((a -> StreamK n a -> StreamK n a)
-> StreamK n a -> a -> StreamK n a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> StreamK n a -> StreamK n a
forall a (m :: * -> *). a -> StreamK m a -> StreamK m a
K.cons) StreamK n a
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 = (a -> StreamK n a -> StreamK n a)
-> StreamK n a -> Fold m a (StreamK n a)
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Fold m a b
foldr a -> StreamK n a -> StreamK n a
forall a (m :: * -> *). a -> StreamK m a -> StreamK m a
K.cons StreamK n a
forall (m :: * -> *) a. StreamK m a
K.nil

-- | Like 'length', except with a more general 'Num' return value
--
-- Definition:
--
-- >>> lengthGeneric = fmap getSum $ Fold.foldMap (Sum . const  1)
-- >>> lengthGeneric = Fold.foldl' (\n _ -> n + 1) 0
--
-- /Pre-release/
{-# INLINE lengthGeneric #-}
lengthGeneric :: (Monad m, Num b) => Fold m a b
lengthGeneric :: forall (m :: * -> *) b a. (Monad m, Num b) => Fold m a b
lengthGeneric = (b -> a -> b) -> b -> Fold m a b
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' (\b
n a
_ -> b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1) b
0

-- | Determine the length of the input stream.
--
-- Definition:
--
-- >>> length = Fold.lengthGeneric
-- >>> length = fmap getSum $ Fold.foldMap (Sum . const  1)
--
{-# INLINE length #-}
length :: Monad m => Fold m a Int
length :: forall (m :: * -> *) a. Monad m => Fold m a Int
length = Fold m a Int
forall (m :: * -> *) b a. (Monad m, Num b) => Fold m a b
lengthGeneric

------------------------------------------------------------------------------
-- 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 s -> m a
final) =
        (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step m (Step s b)
initial ((a -> b) -> (s -> m a) -> s -> m b
forall {f :: * -> *} {f :: * -> *} {a} {b}.
(Functor f, Functor f) =>
(a -> b) -> f (f a) -> f (f b)
fmap2 a -> b
f s -> m a
extract) ((a -> b) -> (s -> m a) -> s -> m b
forall {f :: * -> *} {f :: * -> *} {a} {b}.
(Functor f, Functor f) =>
(a -> b) -> f (f a) -> f (f b)
fmap2 a -> b
f s -> m a
final)

        where

        initial :: m (Step s b)
initial = (a -> b) -> m (Step s a) -> m (Step s b)
forall {f :: * -> *} {f :: * -> *} {a} {b}.
(Functor f, Functor f) =>
(a -> b) -> f (f a) -> f (f b)
fmap2 a -> b
f m (Step s a)
initial1
        step :: s -> a -> m (Step s b)
step s
s a
b = (a -> b) -> m (Step s a) -> m (Step s b)
forall {f :: * -> *} {f :: * -> *} {a} {b}.
(Functor f, Functor f) =>
(a -> b) -> f (f a) -> f (f b)
fmap2 a -> b
f (s -> a -> m (Step s a)
step1 s
s a
b)
        fmap2 :: (a -> b) -> f (f a) -> f (f b)
fmap2 a -> b
g = (f a -> f b) -> f (f a) -> f (f b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> f a -> f b
forall a b. (a -> b) -> f a -> f b
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 = (b -> a -> m (Step b b))
-> m (Step b b) -> (b -> m b) -> (b -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold b -> a -> m (Step b b)
forall a. HasCallStack => a
undefined (Step b b -> m (Step b b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step b b -> m (Step b b)) -> Step b b -> m (Step b b)
forall a b. (a -> b) -> a -> b
$ b -> Step b b
forall s b. b -> Step s b
Done b
b) b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b -> m b
forall a. a -> m a
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 = (b -> a -> m (Step b b))
-> m (Step b b) -> (b -> m b) -> (b -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold b -> a -> m (Step b b)
forall a. HasCallStack => a
undefined (b -> Step b b
forall s b. b -> Step s b
Done (b -> Step b b) -> m b -> m (Step b b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
b) b -> m b
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b -> m b
forall a. a -> m a
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.
--
-- For larger number of compositions you can convert the fold to a parser and
-- use ParserK.
--
-- /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
_ s -> m a
finalL)
    (Fold s -> x -> m (Step s b)
stepR m (Step s b)
initialR s -> m b
_ s -> m b
finalR) =
    (SeqFoldState s (b -> c) s
 -> x -> m (Step (SeqFoldState s (b -> c) s) c))
-> m (Step (SeqFoldState s (b -> c) s) c)
-> (SeqFoldState s (b -> c) s -> m c)
-> (SeqFoldState s (b -> c) s -> m c)
-> Fold m x c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (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
forall {p} {a}. p -> a
extract SeqFoldState s (b -> c) s -> m c
final

    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 = (a -> SeqFoldState sl (c -> d) a)
-> (c -> d) -> p a c -> p (SeqFoldState sl (c -> d) a) d
forall a b c d. (a -> b) -> (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((c -> d) -> a -> SeqFoldState sl (c -> d) a
forall sl f sr. f -> sr -> SeqFoldState sl f sr
SeqFoldR c -> d
f) c -> d
f (p a c -> p (SeqFoldState sl (c -> d) a) d)
-> f (p a c) -> f (p (SeqFoldState sl (c -> d) a) d)
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
        (s1 -> m (SeqFoldState s1 (b -> c) s))
-> (a -> m (Step (SeqFoldState s1 (b -> c) s) c))
-> Step s1 a
-> m (Step (SeqFoldState s1 (b -> c) s) c)
forall (m :: * -> *) s1 s2 a b.
Applicative m =>
(s1 -> m s2) -> (a -> m (Step s2 b)) -> Step s1 a -> m (Step s2 b)
chainStepM (SeqFoldState s1 (b -> c) s -> m (SeqFoldState s1 (b -> c) s)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (SeqFoldState s1 (b -> c) s -> m (SeqFoldState s1 (b -> c) s))
-> (s1 -> SeqFoldState s1 (b -> c) s)
-> s1
-> m (SeqFoldState s1 (b -> c) s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s1 -> SeqFoldState s1 (b -> c) s
forall sl f sr. sl -> SeqFoldState sl f sr
SeqFoldL) (m (Step s b) -> (b -> c) -> m (Step (SeqFoldState s1 (b -> c) s) c)
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 ((b -> c) -> m (Step (SeqFoldState s1 (b -> c) s) c))
-> (a -> b -> c) -> a -> m (Step (SeqFoldState s1 (b -> c) s) c)
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 = m (Step s a) -> m (Step (SeqFoldState s (b -> c) s) c)
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 = m (Step s a) -> m (Step (SeqFoldState s (b -> c) s) c)
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 = m (Step s b) -> (b -> c) -> m (Step (SeqFoldState s (b -> c) s) c)
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

    -- XXX splitWith should not be used for scanning
    -- It would rarely make sense and resource tracking and cleanup would be
    -- expensive. especially when multiple splitWith are chained.
    extract :: p -> a
extract p
_ = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"splitWith: cannot be used for scanning"

    final :: SeqFoldState s (b -> c) s -> m c
final (SeqFoldR b -> c
f s
sR) = (b -> c) -> m b -> m c
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f (s -> m b
finalR s
sR)
    final (SeqFoldL s
sL) = do
        a
rL <- s -> m a
finalL s
sL
        Step s b
res <- m (Step s b)
initialR
        (b -> c) -> m b -> m c
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b -> c
func a
rL)
            (m b -> m c) -> m b -> m c
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                Partial s
sR -> s -> m b
finalR s
sR
                Done b
rR -> b -> m b
forall a. a -> m a
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 = (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
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
_ s -> m a
finalL) (Fold s -> x -> m (Step s b)
stepR m (Step s b)
initialR s -> m b
_ s -> m b
finalR) =
    (SeqFoldState_ s s -> x -> m (Step (SeqFoldState_ s s) b))
-> m (Step (SeqFoldState_ s s) b)
-> (SeqFoldState_ s s -> m b)
-> (SeqFoldState_ s s -> m b)
-> Fold m x b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold SeqFoldState_ s s -> x -> m (Step (SeqFoldState_ s s) b)
step m (Step (SeqFoldState_ s s) b)
initial SeqFoldState_ s s -> m b
forall {p} {a}. p -> a
extract SeqFoldState_ s s -> m b
final

    where

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

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

    -- XXX split_ should not be used for scanning
    -- See splitWith for more details.
    extract :: p -> a
extract p
_ = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"split_: cannot be used for scanning"

    final :: SeqFoldState_ s s -> m b
final (SeqFoldR_ s
sR) = s -> m b
finalR s
sR
    final (SeqFoldL_ s
sL) = do
        a
_ <- s -> m a
finalL s
sL
        Step s b
res <- m (Step s b)
initialR
        case Step s b
res of
            Partial s
sR -> s -> m b
finalR s
sR
            Done b
rR -> b -> m b
forall a. a -> m a
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 = a -> Fold m a a
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
(<*>) = ((a -> b) -> 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 (a -> b) -> a -> b
forall a. a -> a
id

    {-# INLINE (*>) #-}
    *> :: forall a b. Fold m a a -> Fold m a b -> Fold m 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 = Fold m a (b -> c) -> Fold m a b -> Fold m a c
forall a b. Fold m a (a -> b) -> Fold m a a -> Fold m a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ((a -> b -> c) -> Fold m a a -> Fold m a (b -> c)
forall a b. (a -> b) -> Fold m a a -> Fold m a 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 s -> m a
finalL)
    (Fold s -> x -> m (Step s b)
stepR m (Step s b)
initialR s -> m b
extractR s -> m b
finalR) =
    (TeeState s s a b -> x -> m (Step (TeeState s s a b) c))
-> m (Step (TeeState s s a b) c)
-> (TeeState s s a b -> m c)
-> (TeeState s s a b -> m c)
-> Fold m x c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (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 TeeState s s a b -> m c
final

    where

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

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

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

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

    final :: TeeState s s a b -> m c
final (TeeBoth s
sL s
sR) = a -> b -> c
f (a -> b -> c) -> m a -> m (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m a
finalL s
sL m (b -> c) -> m b -> m c
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m b
finalR s
sR
    final (TeeLeft b
bR s
sL) = (a -> b -> c
`f` b
bR) (a -> c) -> m a -> m c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m a
finalL s
sL
    final (TeeRight a
bL s
sR) = a -> b -> c
f a
bL (b -> c) -> m b -> m c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
finalR 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 s -> m b
finalL)
    (Fold s -> a -> m (Step s c)
stepR m (Step s c)
initialR s -> m c
extractR s -> m c
finalR) =
    (TeeFstState s s c -> a -> m (Step (TeeFstState s s c) d))
-> m (Step (TeeFstState s s c) d)
-> (TeeFstState s s c -> m d)
-> (TeeFstState s s c -> m d)
-> Fold m a d
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (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 TeeFstState s s c -> m d
final

    where

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

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

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

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

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

    final :: TeeFstState s s c -> m d
final (TeeFstBoth s
sL s
sR) = b -> c -> d
f (b -> c -> d) -> m b -> m (c -> d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
finalL s
sL m (c -> d) -> m c -> m d
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m c
finalR s
sR
    final (TeeFstLeft c
bR s
sL) = (b -> c -> d
`f` c
bR) (b -> d) -> m b -> m d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
finalL 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 s -> m b
finalL)
    (Fold s -> a -> m (Step s c)
stepR m (Step s c)
initialR s -> m c
extractR s -> m c
finalR) =
    (Tuple' s s -> a -> m (Step (Tuple' s s) d))
-> m (Step (Tuple' s s) d)
-> (Tuple' s s -> m d)
-> (Tuple' s s -> m d)
-> Fold m a d
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (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 Tuple' s s -> m d
final

    where

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

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

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

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

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

    final :: Tuple' s s -> m d
final (Tuple' s
sL s
sR) = b -> c -> d
f (b -> c -> d) -> m b -> m (c -> d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
finalL s
sL m (c -> d) -> m c -> m d
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m c
finalR 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 s -> m a
finalL) (Fold s -> x -> m (Step s b)
stepR m (Step s b)
initialR s -> m b
_ s -> m b
finalR) =
    (Tuple' s s -> x -> m (Step (Tuple' s s) (Either a b)))
-> m (Step (Tuple' s s) (Either a b))
-> (Tuple' s s -> m (Either a b))
-> (Tuple' s s -> m (Either a b))
-> Fold m x (Either a b)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold Tuple' s s -> x -> m (Step (Tuple' s s) (Either a b))
step m (Step (Tuple' s s) (Either a b))
initial Tuple' s s -> m (Either a b)
forall {b} {b}. Tuple' s b -> m (Either a b)
extract Tuple' s s -> m (Either a b)
forall {b}. Tuple' s s -> m (Either a b)
final

    where

    {-# INLINE runBoth #-}
    runBoth :: m (Step s a) -> m (Step s b) -> m (Step (Tuple' s s) (Either a b))
runBoth m (Step s a)
actionL m (Step s b)
actionR = do
        Step s a
resL <- m (Step s a)
actionL
        Step s b
resR <- m (Step s b)
actionR
        case Step s a
resL of
            Partial s
sL ->
                case Step s b
resR of
                    Partial s
sR -> Step (Tuple' s s) (Either a b)
-> m (Step (Tuple' s s) (Either a b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' s s) (Either a b)
 -> m (Step (Tuple' s s) (Either a b)))
-> Step (Tuple' s s) (Either a b)
-> m (Step (Tuple' s s) (Either a b))
forall a b. (a -> b) -> a -> b
$ Tuple' s s -> Step (Tuple' s s) (Either a b)
forall s b. s -> Step s b
Partial (Tuple' s s -> Step (Tuple' s s) (Either a b))
-> Tuple' s s -> Step (Tuple' s s) (Either a b)
forall a b. (a -> b) -> a -> b
$ s -> s -> Tuple' s s
forall a b. a -> b -> Tuple' a b
Tuple' s
sL s
sR
                    Done b
bR -> s -> m a
finalL s
sL m a
-> m (Step (Tuple' s s) (Either a b))
-> m (Step (Tuple' s s) (Either a b))
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step (Tuple' s s) (Either a b)
-> m (Step (Tuple' s s) (Either a b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> Step (Tuple' s s) (Either a b)
forall s b. b -> Step s b
Done (b -> Either a b
forall a b. b -> Either a b
Right b
bR))
            Done a
bL -> do
                case Step s b
resR of
                    Partial s
sR -> m b -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (s -> m b
finalR s
sR)
                    Done b
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Step (Tuple' s s) (Either a b)
-> m (Step (Tuple' s s) (Either a b))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> Step (Tuple' s s) (Either a b)
forall s b. b -> Step s b
Done (a -> Either a b
forall a b. a -> Either a b
Left a
bL))

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

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

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

    final :: Tuple' s s -> m (Either a b)
final (Tuple' s
sL s
sR) = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> m a -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m a
finalL s
sL m (Either a b) -> m b -> m (Either a b)
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* s -> m b
finalR s
sR

{-# 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
_ s -> m a
finalL)
    (Fold s -> x -> m (Step s b)
stepR m (Step s b)
initialR s -> m b
_ s -> m b
finalR) =
    (LongestState s s -> x -> m (Step (LongestState s s) (Either a b)))
-> m (Step (LongestState s s) (Either a b))
-> (LongestState s s -> m (Either a b))
-> (LongestState s s -> m (Either a b))
-> Fold m x (Either a b)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold LongestState s s -> x -> m (Step (LongestState s s) (Either a b))
step m (Step (LongestState s s) (Either a b))
forall {b}. m (Step (LongestState s s) (Either a b))
initial LongestState s s -> m (Either a b)
forall {p} {a}. p -> a
extract LongestState s s -> m (Either a b)
final

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

    initial :: m (Step (LongestState s s) (Either a b))
initial = m (Step s a)
-> m (Step s b) -> m (Step (LongestState s s) (Either a b))
forall {m :: * -> *} {sL} {a} {sR} {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 = m (Step s a)
-> m (Step s b) -> m (Step (LongestState s s) (Either a b))
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 = (s -> LongestState s s)
-> (a -> Either a b)
-> Step s a
-> Step (LongestState s s) (Either a b)
forall a b c d. (a -> b) -> (c -> d) -> Step a c -> Step b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap s -> LongestState s s
forall sL sR. sL -> LongestState sL sR
LongestLeft a -> Either a b
forall a b. a -> Either a b
Left (Step s a -> Step (LongestState s s) (Either a b))
-> m (Step s a) -> m (Step (LongestState s s) (Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> x -> m (Step s a)
stepL s
sL x
a
    step (LongestRight s
sR) x
a = (s -> LongestState s s)
-> (b -> Either a b)
-> Step s b
-> Step (LongestState s s) (Either a b)
forall a b c d. (a -> b) -> (c -> d) -> Step a c -> Step b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap s -> LongestState s s
forall sL sR. sR -> LongestState sL sR
LongestRight b -> Either a b
forall a b. b -> Either a b
Right (Step s b -> Step (LongestState s s) (Either a b))
-> m (Step s b) -> m (Step (LongestState s s) (Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> x -> m (Step s b)
stepR s
sR x
a

    -- XXX Scan with this may not make sense as we cannot determine the longest
    -- until one of them have exhausted.
    extract :: p -> a
extract p
_ = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"longest: scan is not allowed as longest cannot be "
        [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"determined until one fold has exhausted."

    final :: LongestState s s -> m (Either a b)
final (LongestLeft s
sL) = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> m a -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m a
finalL s
sL
    final (LongestRight s
sR) = b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> m b -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
finalR s
sR
    final (LongestBoth s
sL s
sR) = a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> m a -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m a
finalL s
sL m (Either a b) -> m b -> m (Either a b)
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* s -> m b
finalR s
sR

data ConcatMapState m sa a b c
    = B !sa (sa -> m b)
    | forall s. C (s -> a -> m (Step s c)) !s (s -> m c) (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
_ s -> m b
finala) =
    (ConcatMapState m s a b c
 -> a -> m (Step (ConcatMapState m s a b c) c))
-> m (Step (ConcatMapState m s a b c) c)
-> (ConcatMapState m s a b c -> m c)
-> (ConcatMapState m s a b c -> m c)
-> Fold m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold ConcatMapState m s a b c
-> a -> m (Step (ConcatMapState m s a b c) c)
forall {b}.
ConcatMapState m s a b c
-> a -> m (Step (ConcatMapState m s a b c) c)
stepc m (Step (ConcatMapState m s a b c) c)
initialc ConcatMapState m s a b c -> m c
forall {p} {a}. p -> a
extractc ConcatMapState m s a b c -> m c
forall {sa} {a}. ConcatMapState m sa a b c -> m c
finalc
  where
    initialc :: m (Step (ConcatMapState m s a b c) c)
initialc = do
        Step s b
r <- m (Step s b)
initiala
        case Step s b
r of
            Partial s
s -> Step (ConcatMapState m s a b c) c
-> m (Step (ConcatMapState m s a b c) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatMapState m s a b c) c
 -> m (Step (ConcatMapState m s a b c) c))
-> Step (ConcatMapState m s a b c) c
-> m (Step (ConcatMapState m s a b c) c)
forall a b. (a -> b) -> a -> b
$ ConcatMapState m s a b c -> Step (ConcatMapState m s a b c) c
forall s b. s -> Step s b
Partial (s -> (s -> m b) -> ConcatMapState m s a b c
forall (m :: * -> *) sa a b c.
sa -> (sa -> m b) -> ConcatMapState m sa a b c
B s
s s -> m b
finala)
            Done b
b -> Fold m a c -> m (Step (ConcatMapState m s a b c) c)
forall {m :: * -> *} {a} {b} {sa} {b}.
Monad m =>
Fold m a b -> m (Step (ConcatMapState m sa a b b) b)
initInnerFold (b -> Fold m a c
f b
b)

    stepc :: ConcatMapState m s a b c
-> a -> m (Step (ConcatMapState m s a b c) c)
stepc (B s
s s -> m b
fin) a
a = do
        Step s b
r <- s -> a -> m (Step s b)
stepa s
s a
a
        case Step s b
r of
            Partial s
s1 -> Step (ConcatMapState m s a b c) c
-> m (Step (ConcatMapState m s a b c) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatMapState m s a b c) c
 -> m (Step (ConcatMapState m s a b c) c))
-> Step (ConcatMapState m s a b c) c
-> m (Step (ConcatMapState m s a b c) c)
forall a b. (a -> b) -> a -> b
$ ConcatMapState m s a b c -> Step (ConcatMapState m s a b c) c
forall s b. s -> Step s b
Partial (s -> (s -> m b) -> ConcatMapState m s a b c
forall (m :: * -> *) sa a b c.
sa -> (sa -> m b) -> ConcatMapState m sa a b c
B s
s1 s -> m b
fin)
            Done b
b -> Fold m a c -> m (Step (ConcatMapState m s a b c) c)
forall {m :: * -> *} {a} {b} {sa} {b}.
Monad m =>
Fold m a b -> m (Step (ConcatMapState m sa a b 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 s -> m c
fin) a
a = do
        Step s c
r <- s -> a -> m (Step s c)
stepInner s
s a
a
        Step (ConcatMapState m s a b c) c
-> m (Step (ConcatMapState m s a b c) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatMapState m s a b c) c
 -> m (Step (ConcatMapState m s a b c) c))
-> Step (ConcatMapState m s a b c) c
-> m (Step (ConcatMapState m s a b c) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Partial s
sc -> ConcatMapState m s a b c -> Step (ConcatMapState m s a b c) c
forall s b. s -> Step s b
Partial ((s -> a -> m (Step s c))
-> s -> (s -> m c) -> (s -> m c) -> ConcatMapState m s a b c
forall (m :: * -> *) sa a b c s.
(s -> a -> m (Step s c))
-> s -> (s -> m c) -> (s -> m c) -> ConcatMapState m sa a b c
C s -> a -> m (Step s c)
stepInner s
sc s -> m c
extractInner s -> m c
fin)
            Done c
c -> c -> Step (ConcatMapState m s a b c) c
forall s b. b -> Step s b
Done c
c

    -- XXX Cannot use for scanning
    extractc :: p -> a
extractc p
_ = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"concatMap: cannot be used for scanning"

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

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

    finalc :: ConcatMapState m sa a b c -> m c
finalc (B sa
s sa -> m b
fin) = do
        b
r <- sa -> m b
fin sa
s
        Fold m a c -> m c
forall {m :: * -> *} {a} {b}. Monad m => Fold m a b -> m b
initFinalize (b -> Fold m a c
f b
r)
    finalc (C s -> a -> m (Step s c)
_ s
sInner s -> m c
_ s -> m c
fin) = s -> m c
fin s
sInner

------------------------------------------------------------------------------
-- 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 s -> m r
final) = (s -> a -> m (Step s r))
-> m (Step s r) -> (s -> m r) -> (s -> m r) -> Fold m a r
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s r)
step' m (Step s r)
begin s -> m r
done s -> m r
final
    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 s -> m r
final) = (s -> a -> m (Step s r))
-> m (Step s r) -> (s -> m r) -> (s -> m r) -> Fold m a r
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s r)
step' m (Step s r)
begin s -> m r
done s -> m r
final
    where
    step' :: s -> a -> m (Step s r)
step' s
x a
a = a -> m b
f a
a m b -> (b -> m (Step s r)) -> m (Step s r)
forall a b. m a -> (a -> m b) -> m b
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 s -> m b
finalL)
    (Fold s -> b -> m (Step s c)
stepR m (Step s c)
initialR s -> m c
extractR s -> m c
finalR) =
    ((s, s) -> a -> m (Step (s, s) c))
-> m (Step (s, s) c)
-> ((s, s) -> m c)
-> ((s, s) -> m c)
-> Fold m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold (s, s) -> a -> m (Step (s, s) c)
step m (Step (s, s) c)
initial (s, s) -> m c
forall {a}. (a, s) -> m c
extract (s, s) -> m c
final

    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 -> c -> Step (s, s) c
forall s b. b -> Step s b
Done (c -> Step (s, s) c) -> m c -> m (Step (s, s) c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
finalR s
sR1
                    Done c
bR -> Step (s, s) c -> m (Step (s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, s) c -> m (Step (s, s) c))
-> Step (s, s) c -> m (Step (s, s) c)
forall a b. (a -> b) -> a -> b
$ c -> Step (s, s) c
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
                case Step s c
rR of
                    Partial s
sR1 -> Step (s, s) c -> m (Step (s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, s) c -> m (Step (s, s) c))
-> Step (s, s) c -> m (Step (s, s) c)
forall a b. (a -> b) -> a -> b
$ (s, s) -> Step (s, s) c
forall s b. s -> Step s b
Partial (s
sL, s
sR1)
                    Done c
bR -> s -> m b
finalL s
sL m b -> m (Step (s, s) c) -> m (Step (s, s) c)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step (s, s) c -> m (Step (s, s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> Step (s, s) c
forall s b. b -> Step s b
Done c
bR)

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

    -- XXX should use Tuple'
    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 (s -> m c) -> ((a, s) -> s) -> (a, s) -> m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, s) -> s
forall a b. (a, b) -> b
snd

    final :: (s, s) -> m c
final (s
sL, s
sR) = s -> m b
finalL s
sL m b -> m c -> m c
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> s -> m c
finalR s
sR

------------------------------------------------------------------------------
-- 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 s -> m b
final) = (s -> Maybe a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m (Maybe a) b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m 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 s -> m b
final

    where

    step1 :: s -> Maybe a -> m (Step s b)
step1 s
s Maybe a
a =
        case Maybe a
a of
            Maybe a
Nothing -> Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ s -> Step s 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 = Fold m a (Maybe b) -> Fold m (Maybe b) c -> Fold m a c
forall (m :: * -> *) a b c.
Monad m =>
Fold m a b -> Fold m b c -> Fold m a c
postscan Fold m a (Maybe b)
f1 (Fold m b c -> Fold m (Maybe b) c
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 = (Maybe a -> a -> Maybe a) -> Maybe a -> Fold m a (Maybe a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' Maybe a -> a -> Maybe a
forall {p}. p -> a -> Maybe a
step Maybe a
forall a. Maybe a
Nothing

    where

    step :: p -> a -> Maybe a
step p
_ a
a = if a -> Bool
f a
a then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
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
extract s -> m r
final) = (s -> a -> m (Step s r))
-> m (Step s r) -> (s -> m r) -> (s -> m r) -> Fold m a r
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s r)
step' m (Step s r)
begin s -> m r
extract s -> m r
final
    where
    step' :: s -> a -> m (Step s r)
step' s
x a
a = if a -> Bool
f a
a then s -> a -> m (Step s r)
step s
x a
a else Step s r -> m (Step s r)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s r -> m (Step s r)) -> Step s r -> m (Step s r)
forall a b. (a -> b) -> a -> b
$ s -> Step s r
forall s b. s -> Step s b
Partial s
x

-- | Like 'filter' but with a monadic predicate.
--
-- >>> 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
extract s -> m r
final) = (s -> a -> m (Step s r))
-> m (Step s r) -> (s -> m r) -> (s -> m r) -> Fold m a r
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s r)
step' m (Step s r)
begin s -> m r
extract s -> m r
final
    where
    step' :: s -> a -> m (Step s r)
step' s
x a
a = do
      Bool
use <- a -> m Bool
f a
a
      if Bool
use then s -> a -> m (Step s r)
step s
x a
a else Step s r -> m (Step s r)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s r -> m (Step s r)) -> Step s r -> m (Step s r)
forall a b. (a -> b) -> a -> b
$ s -> Step s r
forall s b. s -> Step s b
Partial s
x

------------------------------------------------------------------------------
-- 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 = (Either a b -> Bool)
-> Fold m (Either a b) c -> Fold m (Either a b) c
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Fold m a r -> Fold m a r
filter Either a b -> Bool
forall a b. Either a b -> Bool
isLeft (Fold m (Either a b) c -> Fold m (Either a b) c)
-> (Fold m a c -> Fold m (Either a b) c)
-> Fold m a c
-> Fold m (Either a b) c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either a b -> a) -> Fold m a c -> Fold m (Either a b) c
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (a -> Either a b -> a
forall a b. a -> Either a b -> a
fromLeft a
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 = (Either a b -> Bool)
-> Fold m (Either a b) c -> Fold m (Either a b) c
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Fold m a r -> Fold m a r
filter Either a b -> Bool
forall a b. Either a b -> Bool
isRight (Fold m (Either a b) c -> Fold m (Either a b) c)
-> (Fold m b c -> Fold m (Either a b) c)
-> Fold m b c
-> Fold m (Either a b) c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either a b -> b) -> Fold m b c -> Fold m (Either a b) c
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (b -> Either a b -> b
forall b a. b -> Either a b -> b
fromRight b
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 = (Either a a -> a) -> Fold m a b -> Fold m (Either a a) b
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap ((a -> a) -> (a -> a) -> Either a a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id a -> a
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 -> [Char] -> [Char]
[Tuple'Fused a b] -> [Char] -> [Char]
Tuple'Fused a b -> [Char]
(Int -> Tuple'Fused a b -> [Char] -> [Char])
-> (Tuple'Fused a b -> [Char])
-> ([Tuple'Fused a b] -> [Char] -> [Char])
-> Show (Tuple'Fused a b)
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
forall a b.
(Show a, Show b) =>
Int -> Tuple'Fused a b -> [Char] -> [Char]
forall a b.
(Show a, Show b) =>
[Tuple'Fused a b] -> [Char] -> [Char]
forall a b. (Show a, Show b) => Tuple'Fused a b -> [Char]
$cshowsPrec :: forall a b.
(Show a, Show b) =>
Int -> Tuple'Fused a b -> [Char] -> [Char]
showsPrec :: Int -> Tuple'Fused a b -> [Char] -> [Char]
$cshow :: forall a b. (Show a, Show b) => Tuple'Fused a b -> [Char]
show :: Tuple'Fused a b -> [Char]
$cshowList :: forall a b.
(Show a, Show b) =>
[Tuple'Fused a b] -> [Char] -> [Char]
showList :: [Tuple'Fused a b] -> [Char] -> [Char]
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 = (Tuple'Fused Int (Maybe a)
 -> a -> Step (Tuple'Fused Int (Maybe a)) (Maybe a))
-> Step (Tuple'Fused Int (Maybe a)) (Maybe a)
-> (Tuple'Fused Int (Maybe a) -> Maybe a)
-> Fold m a (Maybe a)
forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
foldt' Tuple'Fused Int (Maybe a)
-> a -> Step (Tuple'Fused Int (Maybe a)) (Maybe a)
forall {a} {b} {a}.
(Ord a, Num a) =>
Tuple'Fused a b -> a -> Step (Tuple'Fused a (Maybe a)) (Maybe a)
step Step (Tuple'Fused Int (Maybe a)) (Maybe a)
forall {a} {a}. Step (Tuple'Fused Int (Maybe a)) (Maybe a)
initial Tuple'Fused Int (Maybe a) -> Maybe a
forall {a} {b}. Tuple'Fused a b -> b
extract

    where

    initial :: Step (Tuple'Fused Int (Maybe a)) (Maybe a)
initial =
        if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
        then Maybe a -> Step (Tuple'Fused Int (Maybe a)) (Maybe a)
forall s b. b -> Step s b
Done Maybe a
forall a. Maybe a
Nothing
        else Tuple'Fused Int (Maybe a)
-> Step (Tuple'Fused Int (Maybe a)) (Maybe a)
forall s b. s -> Step s b
Partial (Int -> Maybe a -> Tuple'Fused Int (Maybe a)
forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused Int
n Maybe a
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1
        then Tuple'Fused a (Maybe a) -> Step (Tuple'Fused a (Maybe a)) (Maybe a)
forall s b. s -> Step s b
Partial (a -> Maybe a -> Tuple'Fused a (Maybe a)
forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused (a
i a -> a -> a
forall a. Num a => a -> a -> a
- a
1) (a -> Maybe a
forall a. a -> Maybe a
Just a
a))
        else Maybe a -> Step (Tuple'Fused a (Maybe a)) (Maybe a)
forall s b. b -> Step s b
Done (a -> Maybe a
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 = (Tuple'Fused Int (Maybe a)
 -> a -> Step (Tuple'Fused Int (Maybe a)) (Maybe a))
-> Step (Tuple'Fused Int (Maybe a)) (Maybe a)
-> (Tuple'Fused Int (Maybe a) -> Maybe a)
-> Fold m a (Maybe a)
forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
foldt' Tuple'Fused Int (Maybe a)
-> a -> Step (Tuple'Fused Int (Maybe a)) (Maybe a)
forall {a} {b} {a} {b}.
(Ord a, Num a) =>
Tuple'Fused a b -> a -> Step (Tuple'Fused a (Maybe a)) b
step Step (Tuple'Fused Int (Maybe a)) (Maybe a)
forall {a} {b}. Step (Tuple'Fused Int (Maybe a)) b
initial Tuple'Fused Int (Maybe a) -> Maybe a
forall {a} {b}. Tuple'Fused a b -> b
extract

    where

    initial :: Step (Tuple'Fused Int (Maybe a)) b
initial = Tuple'Fused Int (Maybe a) -> Step (Tuple'Fused Int (Maybe a)) b
forall s b. s -> Step s b
Partial (Int -> Maybe a -> Tuple'Fused Int (Maybe a)
forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused Int
n Maybe a
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0
        then Tuple'Fused a (Maybe a) -> Step (Tuple'Fused a (Maybe a)) b
forall s b. s -> Step s b
Partial (a -> Maybe a -> Tuple'Fused a (Maybe a)
forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused (a
i a -> a -> a
forall a. Num a => a -> a -> a
- a
1) Maybe a
forall a. Maybe a
Nothing)
        else Tuple'Fused a (Maybe a) -> Step (Tuple'Fused a (Maybe a)) b
forall s b. s -> Step s b
Partial (a -> Maybe a -> Tuple'Fused a (Maybe a)
forall a b. a -> b -> Tuple'Fused a b
Tuple'Fused a
i (a -> Maybe a
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 s -> m b
ffinal) = (Tuple'Fused Int s -> a -> m (Step (Tuple'Fused Int s) b))
-> m (Step (Tuple'Fused Int s) b)
-> (Tuple'Fused Int s -> m b)
-> (Tuple'Fused Int s -> m b)
-> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold Tuple'Fused Int s -> a -> m (Step (Tuple'Fused Int s) b)
step m (Step (Tuple'Fused Int s) b)
initial Tuple'Fused Int s -> m b
forall {a}. Tuple'Fused a s -> m b
extract Tuple'Fused Int s -> m b
forall {a}. Tuple'Fused a s -> m b
final

    where

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

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

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

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

    final :: Tuple'Fused a s -> m b
final (Tuple'Fused a
_ s
r) = s -> m b
ffinal s
r

-- Note: Keep this consistent with S.splitOn. In fact we should eliminate
-- S.splitOn in favor of the fold.
--
-- XXX Use Fold.many instead once it is fixed.
-- > Stream.splitOnSuffix p f = Stream.foldMany (Fold.takeEndBy_ p f)

-- | Like 'takeEndBy' but drops the element on which the predicate succeeds.
--
-- Example:
--
-- >>> input = Stream.fromList "hello\nthere\n"
-- >>> line = Fold.takeEndBy_ (== '\n') Fold.toList
-- >>> Stream.fold line input
-- "hello"
--
-- >>> Stream.fold Fold.toList $ Stream.foldMany line input
-- ["hello","there"]
--
{-# INLINE takeEndBy_ #-}
takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b
-- takeEndBy_ predicate = scanMaybe (takingEndBy_ predicate)
takeEndBy_ :: forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Fold m a r -> Fold m a r
takeEndBy_ a -> Bool
predicate (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract s -> m b
ffinal) =
    (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step m (Step s b)
finitial s -> m b
fextract s -> m b
ffinal

    where

    step :: s -> a -> m (Step s b)
step s
s a
a =
        if Bool -> Bool
not (a -> Bool
predicate a
a)
        then s -> a -> m (Step s b)
fstep s
s a
a
        else b -> Step s b
forall s b. b -> Step s b
Done (b -> Step s b) -> m b -> m (Step s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s

-- Note:
-- > Stream.splitWithSuffix p f = Stream.foldMany (Fold.takeEndBy p f)

-- | Take the input, stop when the predicate succeeds taking the succeeding
-- element as well.
--
-- Example:
--
-- >>> input = Stream.fromList "hello\nthere\n"
-- >>> line = Fold.takeEndBy (== '\n') Fold.toList
-- >>> Stream.fold line input
-- "hello\n"
--
-- >>> Stream.fold Fold.toList $ Stream.foldMany line input
-- ["hello\n","there\n"]
--
{-# INLINE takeEndBy #-}
takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b
-- takeEndBy predicate = scanMaybe (takingEndBy predicate)
takeEndBy :: forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Fold m a r -> Fold m a r
takeEndBy a -> Bool
predicate (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract s -> m b
ffinal) =
    (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step m (Step s b)
finitial s -> m b
fextract s -> m b
ffinal

    where

    step :: s -> a -> m (Step s b)
step s
s a
a = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
a
        if Bool -> Bool
not (a -> Bool
predicate a
a)
        then Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res
        else do
            case Step s b
res of
                Partial s
s1 -> b -> Step s b
forall s b. b -> Step s b
Done (b -> Step s b) -> m b -> m (Step s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s1
                Done b
b -> Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ b -> Step s b
forall s b. b -> Step s b
Done b
b

------------------------------------------------------------------------------
-- 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 s -> m b
final1) =
    (s -> a -> m (Step s (Fold m a b)))
-> m (Step s (Fold m a b))
-> (s -> m (Fold m a b))
-> (s -> m (Fold m a b))
-> Fold m a (Fold m a b)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s (Fold m a b))
forall {m :: * -> *} {a}.
Applicative m =>
s -> a -> m (Step s (Fold m a b))
step m (Step s (Fold m a b))
forall {a}. m (Step s (Fold m a b))
initial s -> m (Fold m a b)
forall {a}. a
extract s -> m (Fold m a b)
forall {f :: * -> *}. Applicative f => s -> f (Fold m a b)
final

    where

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

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

    -- Scanning may be problematic due to multiple finalizations.
    extract :: a
extract = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"duplicate: scanning may be problematic"

    final :: s -> f (Fold m a b)
final s
s = Fold m a b -> f (Fold m a b)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fold m a b -> f (Fold m a b)) -> Fold m a b -> f (Fold m a b)
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ s -> Step s b
forall s b. s -> Step s b
Partial s
s) s -> m b
extract1 s -> m b
final1

-- 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 s -> m b
final) = do
    Step s b
i <- m (Step s b)
initial
    Fold m a b -> m (Fold m a b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fold m a b -> m (Fold m a b)) -> Fold m a b -> m (Fold m a b)
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step (Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
i) s -> m b
extract s -> m b
final

-- 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 s -> m b
ffinal) m a
action =
    (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
fstep m (Step s b)
initial s -> m b
fextract s -> m b
ffinal

    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 m a -> (a -> m (Step s b)) -> m (Step s b)
forall a b. m a -> (a -> m b) -> m b
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 -> Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ b -> Step s 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 s -> m b
ffinal) a
a =
    (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
fstep m (Step s b)
initial s -> m b
fextract s -> m b
ffinal

    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 -> Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ b -> Step s 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 s -> m b
final) 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 m a -> (a -> m (Step s b)) -> m (Step s b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> a -> m (Step s b)
step s
fs
          Done b
_ -> Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res
    Fold m a b -> m (Fold m a b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fold m a b -> m (Fold m a b)) -> Fold m a b -> m (Fold m a b)
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step (Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
r) s -> m b
extract s -> m b
final

-- 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 s -> m b
final) a
a = do
    Step s b
res <- m (Step s b)
initial
    Step s b
r <- case Step s b
res of
          Partial s
fs -> s -> a -> m (Step s b)
step s
fs a
a
          Done b
_ -> Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
res
    Fold m a b -> m (Fold m a b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Fold m a b -> m (Fold m a b)) -> Fold m a b -> m (Fold m a b)
forall a b. (a -> b) -> a -> b
$ (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step (Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
r) s -> m b
extract s -> m b
final

-- | 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 = (Fold m a b -> a -> m (Fold m a b))
-> a -> Fold m a b -> m (Fold m a b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Fold m a b -> a -> m (Fold m a b)
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 s -> m b
_) = do
    Step s b
res <- m (Step s b)
initial
    case Step s b
res of
          Partial s
fs -> s -> m b
extract s
fs
          Done b
b -> b -> m b
forall a. a -> m a
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
_ s -> m b
final1) =
    (Any -> a -> m (Step Any b))
-> m (Step Any b) -> (Any -> m b) -> (Any -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold Any -> a -> m (Step Any b)
forall a. HasCallStack => a
undefined m (Step Any b)
forall {s}. m (Step s b)
initial Any -> m b
forall a. HasCallStack => a
undefined Any -> m b
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 -> b -> Step s b
forall s b. b -> Step s b
Done (b -> Step s b) -> m b -> m (Step s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
final1 s
s
              Done b
b -> Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ b -> Step s 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
_ s -> m b
_) = do
    Step s b
res <- m (Step s b)
initial
    Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
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 s -> m b
sfinal)
    (Fold s -> b -> m (Step s c)
cstep m (Step s c)
cinitial s -> m c
cextract s -> m c
cfinal) =
    (ManyState s s -> a -> m (Step (ManyState s s) c))
-> m (Step (ManyState s s) c)
-> (ManyState s s -> m c)
-> (ManyState s s -> m c)
-> Fold m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (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 ManyState s s -> m c
final

    where

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

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

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

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

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

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

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

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

    final :: ManyState s s -> m c
final (ManyFirst s
ss s
cs) = s -> m b
sfinal s
ss m b -> m c -> m c
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> s -> m c
cfinal s
cs
    final (ManyLoop s
ss s
cs) = do
        Step s c
cres <- s -> m b
sfinal s
ss m b -> (b -> m (Step s c)) -> m (Step s c)
forall a b. m a -> (a -> m b) -> m b
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
cfinal s
s
            Done c
b -> c -> m c
forall a. a -> m a
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 s -> m b
sfinal)
    (Fold s -> b -> m (Step s c)
cstep m (Step s c)
cinitial s -> m c
cextract s -> m c
cfinal) =
    (Tuple' s s -> a -> m (Step (Tuple' s s) c))
-> m (Step (Tuple' s s) c)
-> (Tuple' s s -> m c)
-> (Tuple' s s -> m c)
-> Fold m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (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 Tuple' s s -> m c
final

    where

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

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

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

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

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

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

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

    final :: Tuple' s s -> m c
final (Tuple' s
ss s
cs) = do
        Step s c
cres <- s -> m b
sfinal s
ss m b -> (b -> m (Step s c)) -> m (Step s c)
forall a b. m a -> (a -> m b) -> m b
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
cfinal s
s
            Done c
b -> c -> m c
forall a. a -> m a
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 = Fold m a b -> Fold m b c -> Fold m a c
forall (m :: * -> *) a b c.
Monad m =>
Fold m a b -> Fold m b c -> Fold m a c
many (Int -> Fold m a b -> Fold m a b
forall (m :: * -> *) a b.
Monad m =>
Int -> Fold m a b -> Fold m a b
take Int
n Fold m a b
split)

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

-- | Like 'many' but uses a 'Refold' for collecting.
--
{-# INLINE refoldMany #-}
refoldMany :: Monad m => Fold m a b -> Refold m x b c -> Refold m x a c
refoldMany :: 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 s -> m b
_sfinal)
    -- XXX We will need a "final" in refold as well
    (Refold s -> b -> m (Step s c)
cstep x -> m (Step s c)
cinject s -> m c
cextract) =
    (Tuple' s (Either s s) -> a -> m (Step (Tuple' s (Either s s)) c))
-> (x -> m (Step (Tuple' s (Either s s)) c))
-> (Tuple' s (Either s s) -> m c)
-> Refold m x a c
forall (m :: * -> *) c a b s.
(s -> a -> m (Step s b))
-> (c -> m (Step s b)) -> (s -> m b) -> Refold m c a b
Refold Tuple' s (Either s s) -> a -> m (Step (Tuple' s (Either s s)) c)
step x -> m (Step (Tuple' s (Either s s)) c)
forall {b}. x -> m (Step (Tuple' s (Either s b)) c)
inject Tuple' s (Either s s) -> m c
forall {a}. Tuple' s (Either a s) -> m c
extract

    where

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

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

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

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

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

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

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

    -- Do not extract the split fold if no item was consumed.
    extract :: Tuple' s (Either a s) -> m c
extract (Tuple' s
cs (Left a
_)) = s -> m c
cextract s
cs
    extract (Tuple' s
cs (Right s
ss )) = do
        Step s c
cres <- s -> m b
sextract s
ss m b -> (b -> m (Step s c)) -> m (Step s c)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> b -> m (Step s c)
cstep s
cs
        case Step s c
cres of
            Partial s
s -> s -> m c
cextract s
s
            Done c
b -> c -> m c
forall a. a -> m a
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 s -> m c
_cfinal) =
    (ConsumeManyState x s s
 -> a -> m (Step (ConsumeManyState x s s) c))
-> (x -> m (Step (ConsumeManyState x s s) c))
-> (ConsumeManyState x s s -> m c)
-> Refold m x a c
forall (m :: * -> *) c a b s.
(s -> a -> m (Step s b))
-> (c -> m (Step s b)) -> (s -> m b) -> Refold m c a b
Refold ConsumeManyState x s s -> a -> m (Step (ConsumeManyState x s s) c)
step x -> m (Step (ConsumeManyState x s s) c)
inject ConsumeManyState x s s -> m c
forall {x}. ConsumeManyState x s s -> m c
extract

    where

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

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

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

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

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

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

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

    -- Do not extract the split fold if no item was consumed.
    extract :: ConsumeManyState x s s -> m c
extract (ConsumeMany x
_ s
cs (Left s
_)) = s -> m c
cextract s
cs
    extract (ConsumeMany x
_ s
cs (Right s
ss )) = do
        Step s c
cres <- s -> m b
sextract s
ss m b -> (b -> m (Step s c)) -> m (Step s c)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> b -> m (Step s c)
cstep s
cs
        case Step s c
cres of
            Partial s
s -> s -> m c
cextract s
s
            Done c
b -> c -> m c
forall a. a -> m a
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 =
    (s -> a -> m (Step s c))
-> m (Step s c) -> (s -> m c) -> (s -> m c) -> Fold m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s c)
step (Fold m a b -> m b
forall {m :: * -> *} {a} {b}. Monad m => Fold m a b -> m b
extractM Fold m a b
f m b -> (b -> m (Step s c)) -> m (Step s c)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m (Step s c)
inject) s -> m c
extract 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 s -> m b
final) =
    (s -> a -> n (Step s b))
-> n (Step s b) -> (s -> n b) -> (s -> n b) -> Fold n a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold (\s
x a
a -> m (Step s b) -> n (Step s b)
forall x. m x -> n x
f (m (Step s b) -> n (Step s b)) -> m (Step s b) -> n (Step s b)
forall a b. (a -> b) -> a -> b
$ s -> a -> m (Step s b)
step s
x a
a) (m (Step s b) -> n (Step s b)
forall x. m x -> n x
f m (Step s b)
initial) (m b -> n b
forall x. m x -> n x
f (m b -> n b) -> (s -> m b) -> s -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m b
extract) (m b -> n b
forall x. m x -> n x
f (m b -> n b) -> (s -> m b) -> s -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m b
final)

-- | 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 x. Identity x -> m x) -> Fold Identity a b -> Fold m a b
forall (m :: * -> *) (n :: * -> *) a b.
(forall x. m x -> n x) -> Fold m a b -> Fold n a b
morphInner (x -> m x
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> m x) -> (Identity x -> x) -> Identity x -> m x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity x -> x
forall a. Identity a -> a
runIdentity)