-- |
-- Module      : Streamly.Internal.Data.Fold
-- Copyright   : (c) 2019 Composewell Technologies
--               (c) 2013 Gabriel Gonzalez
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- See "Streamly.Data.Fold" for an overview and
-- "Streamly.Internal.Data.Fold.Types" for design notes.
--
-- IMPORTANT: keep the signatures consistent with the folds in Streamly.Prelude

module Streamly.Internal.Data.Fold
    (
    -- * Fold Type
      Step (..)
    , Fold (..)

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

    -- * Folds
    -- ** Identity
    , fromPure
    , fromEffect

    -- ** Accumulators
    -- *** Semigroups and Monoids
    , sconcat
    , mconcat
    , foldMap
    , foldMapM

    -- *** Reducers
    , drain
    , drainBy
    , last
    , length
    , mean
    , variance
    , stdDev
    , rollingHash
    , rollingHashWithSalt
    , rollingHashFirstN
    -- , rollingHashLastN

    -- *** Saturating Reducers
    -- | 'product' terminates if it becomes 0. Other folds can theoretically
    -- saturate on bounded types, and therefore terminate, however, they will
    -- run forever on unbounded types like Integer/Double.
    , sum
    , product
    , maximumBy
    , maximum
    , minimumBy
    , minimum

    -- *** Collectors
    -- | Avoid using these folds in scalable or performance critical
    -- applications, they buffer all the input in GC memory which can be
    -- detrimental to performance if the input is large.
    , toList
    , toListRev
    -- $toListRev
    , toStream
    , toStreamRev

    -- ** Terminating Folds
    , drainN
    -- , lastN
    -- , (!!)
    , genericIndex
    , index
    , head
    -- , findM
    , find
    , lookup
    , findIndex
    , elemIndex
    , null
    , elem
    , notElem
    , all
    , any
    , and
    , or
    -- , the

    -- * Combinators
    -- ** Utilities
    , with

    -- ** Transforming the Monad
    , hoist
    , generally

    -- ** Mapping on output
    , rmapM

    -- ** Mapping on Input
    , transform
    , map
    , lmap
    --, lsequence
    , lmapM
    , indexed

    -- ** Filtering
    , filter
    , filterM
    , sampleFromthen
    -- , ldeleteBy
    -- , luniq

    -- ** Mapping Filters
    , catMaybes
    , mapMaybe
    -- , mapMaybeM

    {-
    -- ** Scanning Filters
    , findIndices
    , elemIndices

    -- ** Insertion
    -- | Insertion adds more elements to the stream.

    , insertBy
    , intersperseM

    -- ** Reordering
    , reverse
    -}

    -- ** Trimming
    , take
    , takeInterval

    -- By elements
    , takeEndBy
    , takeEndBy_
    -- , takeEndBySeq
    {-
    , drop
    , dropWhile
    , dropWhileM
    -}

    -- ** Serial Append
    , serialWith
    -- , tail
    -- , init
    , splitAt -- spanN
    -- , splitIn -- sessionN

    -- ** Parallel Distribution
    , teeWith
    , tee
    , teeWithFst
    , teeWithMin
    , distribute
    -- , distributeFst
    -- , distributeMin

    -- ** Parallel Alternative
    , shortest
    , longest

    -- ** Partitioning
    , partitionByM
    , partitionByFstM
    , partitionByMinM
    , partitionBy
    , partition

    -- ** Demultiplexing
    -- | Direct values in the input stream to different folds using an n-ary
    -- fold selector.
    , demux        -- XXX rename this to demux_
    , demuxWith
    , demuxDefault -- XXX rename this to demux
    , demuxDefaultWith
    -- , demuxWithSel
    -- , demuxWithMin

    -- ** Classifying
    -- | In an input stream of key value pairs fold values for different keys
    -- in individual output buckets using the given fold.
    , classify
    , classifyWith
    -- , classifyWithSel
    -- , classifyWithMin

    -- ** Unzipping
    , unzip
    -- These two can be expressed using lmap/lmapM and unzip
    , unzipWith
    , unzipWithM
    , unzipWithFstM
    , unzipWithMinM

    -- ** Zipping
    , zipWithM
    , zip

    -- ** Splitting
    , many
    , intervalsOf
    , chunksOf
    , chunksBetween

    -- ** Nesting
    , concatSequence
    , concatMap

    -- * Running Partially
    , initialize
    , runStep
    , duplicate

    -- * Fold2
    , drainBy2

    -- * Deprecated
    , sequence
    , mapM
    )
where

import Control.Monad (void)
import Data.Bifunctor (first)
import Data.Functor.Identity (Identity(..))
import Data.Int (Int64)
import Data.Map.Strict (Map)
import Data.Maybe (isJust, fromJust)
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup (Semigroup((<>)))
#endif
import Streamly.Internal.Data.Either.Strict
    (Either'(..), fromLeft', fromRight', isLeft', isRight')
import Streamly.Internal.Data.Pipe.Type (Pipe (..), PipeState(..))
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))
import Streamly.Internal.Data.Stream.Serial (SerialT)

import qualified Data.Map.Strict as Map
import qualified Streamly.Internal.Data.Pipe.Type as Pipe
import qualified Streamly.Internal.Data.Stream.IsStream.Enumeration as Stream
import qualified Streamly.Internal.Data.Stream.StreamK as K
import qualified Prelude

import Prelude hiding
       ( filter, foldl1, drop, dropWhile, take, takeWhile, zipWith
       , foldl, foldr, map, mapM_, sequence, all, any, sum, product, elem
       , notElem, maximum, minimum, head, last, tail, length, null
       , reverse, iterate, init, and, or, lookup, (!!)
       , scanl, scanl1, replicate, concatMap, mconcat, foldMap, unzip
       , span, splitAt, break, mapM, zip)
import Streamly.Internal.Data.Fold.Type

-- $setup
-- >>> :m
-- >>> import Prelude hiding (break, map, span, splitAt)
-- >>> import qualified Streamly.Prelude as Stream
-- >>> import qualified Streamly.Internal.Data.Stream.IsStream as Stream (parse, foldMany)
-- >>> import qualified Streamly.Data.Fold as Fold
-- >>> import qualified Streamly.Internal.Data.Fold as Fold
-- >>> import qualified Streamly.Internal.Data.Parser as Parser

------------------------------------------------------------------------------
-- hoist
------------------------------------------------------------------------------

-- | Change the underlying monad of a fold
--
-- /Pre-release/
hoist :: (forall x. m x -> n x) -> Fold m a b -> Fold n a b
hoist :: (forall x. m x -> n x) -> Fold m a b -> Fold n a b
hoist 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 -> a -> n (Step s b))
-> n (Step s 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) -> 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)

-- | Adapt a pure fold to any monad
--
-- > generally = Fold.hoist (return . runIdentity)
--
-- /Pre-release/
generally :: Monad m => Fold Identity a b -> Fold m a b
generally :: Fold Identity a b -> Fold m a b
generally = (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
hoist (x -> m x
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)

------------------------------------------------------------------------------
-- Transformations on fold inputs
------------------------------------------------------------------------------

-- | Flatten the monadic output of a fold to pure output.
--
-- @since 0.7.0
{-# DEPRECATED sequence "Use \"rmapM id\" instead" #-}
{-# INLINE sequence #-}
sequence :: Monad m => Fold m a (m b) -> Fold m a b
sequence :: Fold m a (m b) -> Fold m a b
sequence = (m b -> m b) -> Fold m a (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 -> m b
forall a. a -> a
id

-- | Map a monadic function on the output of a fold.
--
-- @since 0.7.0
{-# DEPRECATED mapM "Use rmapM instead" #-}
{-# INLINE mapM #-}
mapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c
mapM :: (b -> m c) -> Fold m a b -> Fold m a c
mapM = (b -> m c) -> Fold m a b -> Fold m a c
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Fold m a b -> Fold m a c
rmapM

-- | @mapMaybe f fold@ maps a 'Maybe' returning function @f@ on the input of
-- the fold, filters out 'Nothing' elements, and return the values extracted
-- from 'Just'.
--
-- >>> f x = if even x then Just x else Nothing
-- >>> fld = Fold.mapMaybe f Fold.toList
-- >>> Stream.fold fld (Stream.enumerateFromTo 1 10)
-- [2,4,6,8,10]
--
-- @since 0.8.0
{-# INLINE mapMaybe #-}
mapMaybe :: (Monad m) => (a -> Maybe b) -> Fold m b r -> Fold m a r
mapMaybe :: (a -> Maybe b) -> Fold m b r -> Fold m a r
mapMaybe a -> Maybe b
f = (a -> Maybe b) -> Fold m (Maybe b) r -> Fold m a r
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
map a -> Maybe b
f (Fold m (Maybe b) r -> Fold m a r)
-> (Fold m b r -> Fold m (Maybe b) r) -> Fold m b r -> Fold m a r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe b -> Bool) -> Fold m (Maybe b) r -> Fold m (Maybe b) r
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Fold m a r -> Fold m a r
filter Maybe b -> Bool
forall a. Maybe a -> Bool
isJust (Fold m (Maybe b) r -> Fold m (Maybe b) r)
-> (Fold m b r -> Fold m (Maybe b) r)
-> Fold m b r
-> Fold m (Maybe b) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe b -> b) -> Fold m b r -> Fold m (Maybe b) r
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
map Maybe b -> b
forall a. HasCallStack => Maybe a -> a
fromJust

------------------------------------------------------------------------------
-- Transformations on fold inputs
------------------------------------------------------------------------------

-- rename to lpipe?
--
-- | Apply a transformation on a 'Fold' using a 'Pipe'.
--
-- /Pre-release/
{-# INLINE transform #-}
transform :: Monad m => Pipe m a b -> Fold m b c -> Fold m a c
transform :: Pipe m a b -> Fold m b c -> Fold m a c
transform (Pipe s1 -> a -> m (Step (PipeState s1 s2) b)
pstep1 s2 -> m (Step (PipeState s1 s2) b)
pstep2 s1
pinitial) (Fold s -> b -> m (Step s c)
fstep m (Step s c)
finitial s -> m c
fextract) =
    (Tuple' s1 s -> a -> m (Step (Tuple' s1 s) c))
-> m (Step (Tuple' s1 s) c) -> (Tuple' s1 s -> m c) -> Fold m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold Tuple' s1 s -> a -> m (Step (Tuple' s1 s) c)
step m (Step (Tuple' s1 s) c)
initial Tuple' s1 s -> m c
forall a. Tuple' a s -> m c
extract

    where

    initial :: m (Step (Tuple' s1 s) c)
initial = (s -> Tuple' s1 s) -> Step s c -> Step (Tuple' s1 s) c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (s1 -> s -> Tuple' s1 s
forall a b. a -> b -> Tuple' a b
Tuple' s1
pinitial) (Step s c -> Step (Tuple' s1 s) c)
-> m (Step s c) -> m (Step (Tuple' s1 s) c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Step s c)
finitial

    step :: Tuple' s1 s -> a -> m (Step (Tuple' s1 s) c)
step (Tuple' s1
ps s
fs) a
x = do
        Step (PipeState s1 s2) b
r <- s1 -> a -> m (Step (PipeState s1 s2) b)
pstep1 s1
ps a
x
        s -> Step (PipeState s1 s2) b -> m (Step (Tuple' s1 s) c)
go s
fs Step (PipeState s1 s2) b
r

        where

        -- XXX use SPEC?
        go :: s -> Step (PipeState s1 s2) b -> m (Step (Tuple' s1 s) c)
go s
acc (Pipe.Yield b
b (Consume s1
ps')) = do
            Step s c
acc' <- s -> b -> m (Step s c)
fstep s
acc b
b
            Step (Tuple' s1 s) c -> m (Step (Tuple' s1 s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return
                (Step (Tuple' s1 s) c -> m (Step (Tuple' s1 s) c))
-> Step (Tuple' s1 s) c -> m (Step (Tuple' s1 s) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
acc' of
                      Partial s
s -> Tuple' s1 s -> Step (Tuple' s1 s) c
forall s b. s -> Step s b
Partial (Tuple' s1 s -> Step (Tuple' s1 s) c)
-> Tuple' s1 s -> Step (Tuple' s1 s) c
forall a b. (a -> b) -> a -> b
$ s1 -> s -> Tuple' s1 s
forall a b. a -> b -> Tuple' a b
Tuple' s1
ps' s
s
                      Done c
b2 -> c -> Step (Tuple' s1 s) c
forall s b. b -> Step s b
Done c
b2
        go s
acc (Pipe.Yield b
b (Produce s2
ps')) = do
            Step s c
acc' <- s -> b -> m (Step s c)
fstep s
acc b
b
            Step (PipeState s1 s2) b
r <- s2 -> m (Step (PipeState s1 s2) b)
pstep2 s2
ps'
            case Step s c
acc' of
                Partial s
s -> s -> Step (PipeState s1 s2) b -> m (Step (Tuple' s1 s) c)
go s
s Step (PipeState s1 s2) b
r
                Done c
b2 -> Step (Tuple' s1 s) c -> m (Step (Tuple' s1 s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' s1 s) c -> m (Step (Tuple' s1 s) c))
-> Step (Tuple' s1 s) c -> m (Step (Tuple' s1 s) c)
forall a b. (a -> b) -> a -> b
$ c -> Step (Tuple' s1 s) c
forall s b. b -> Step s b
Done c
b2
        go s
acc (Pipe.Continue (Consume s1
ps')) =
            Step (Tuple' s1 s) c -> m (Step (Tuple' s1 s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' s1 s) c -> m (Step (Tuple' s1 s) c))
-> Step (Tuple' s1 s) c -> m (Step (Tuple' s1 s) c)
forall a b. (a -> b) -> a -> b
$ Tuple' s1 s -> Step (Tuple' s1 s) c
forall s b. s -> Step s b
Partial (Tuple' s1 s -> Step (Tuple' s1 s) c)
-> Tuple' s1 s -> Step (Tuple' s1 s) c
forall a b. (a -> b) -> a -> b
$ s1 -> s -> Tuple' s1 s
forall a b. a -> b -> Tuple' a b
Tuple' s1
ps' s
acc
        go s
acc (Pipe.Continue (Produce s2
ps')) = do
            Step (PipeState s1 s2) b
r <- s2 -> m (Step (PipeState s1 s2) b)
pstep2 s2
ps'
            s -> Step (PipeState s1 s2) b -> m (Step (Tuple' s1 s) c)
go s
acc Step (PipeState s1 s2) b
r

    extract :: Tuple' a s -> m c
extract (Tuple' a
_ s
fs) = s -> m c
fextract s
fs

------------------------------------------------------------------------------
-- Left folds
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Run Effects
------------------------------------------------------------------------------

-- |
-- > drainBy f = lmapM f drain
-- > drainBy = Fold.foldMapM (void . f)
--
-- Drain all input after passing it through a monadic function. This is the
-- dual of mapM_ on stream producers.
--
-- See also: 'Streamly.Prelude.mapM_'
--
-- @since 0.7.0
{-# INLINABLE drainBy #-}
drainBy ::  Monad m => (a -> m b) -> Fold m a ()
drainBy :: (a -> m b) -> Fold m a ()
drainBy a -> m b
f = (a -> m b) -> Fold m b () -> Fold m a ()
forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> Fold m b r -> Fold m a r
lmapM a -> m b
f Fold m b ()
forall (m :: * -> *) a. Monad m => Fold m a ()
drain

-- |
--
-- /Internal/
{-# INLINABLE drainBy2 #-}
drainBy2 ::  Monad m => (a -> m b) -> Fold2 m c a ()
drainBy2 :: (a -> m b) -> Fold2 m c a ()
drainBy2 a -> m b
f = (() -> a -> m ()) -> (c -> m ()) -> (() -> m ()) -> Fold2 m c a ()
forall (m :: * -> *) c a b s.
(s -> a -> m s) -> (c -> m s) -> (s -> m b) -> Fold2 m c a b
Fold2 ((a -> m ()) -> () -> a -> m ()
forall a b. a -> b -> a
const (m b -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m b -> m ()) -> (a -> m b) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f)) (\c
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Extract the last element of the input stream, if any.
--
-- > last = fmap getLast $ Fold.foldMap (Last . Just)
--
-- @since 0.7.0
{-# INLINABLE last #-}
last :: Monad m => Fold m a (Maybe a)
last :: Fold m a (Maybe a)
last = (a -> a -> a) -> Fold m a (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
foldl1' (\a
_ a
x -> a
x)

------------------------------------------------------------------------------
-- To Summary
------------------------------------------------------------------------------

-- | Like 'length', except with a more general 'Num' return value
--
-- > genericLength = fmap getSum $ foldMap (Sum . const  1)
--
-- /Pre-release/
{-# INLINE genericLength #-}
genericLength :: (Monad m, Num b) => Fold m a b
genericLength :: Fold m a b
genericLength = (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.
--
-- > length = fmap getSum $ Fold.foldMap (Sum . const  1)
--
-- @since 0.7.0
{-# INLINE length #-}
length :: Monad m => Fold m a Int
length :: Fold m a Int
length = Fold m a Int
forall (m :: * -> *) b a. (Monad m, Num b) => Fold m a b
genericLength

-- | Determine the sum of all elements of a stream of numbers. Returns additive
-- identity (@0@) when the stream is empty. Note that this is not numerically
-- stable for floating point numbers.
--
-- > sum = fmap getSum $ Fold.foldMap Sum
--
-- @since 0.7.0
{-# INLINE sum #-}
sum :: (Monad m, Num a) => Fold m a a
sum :: Fold m a a
sum =  (a -> a -> a) -> a -> Fold m a a
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0

-- | Determine the product of all elements of a stream of numbers. Returns
-- multiplicative identity (@1@) when the stream is empty. The fold terminates
-- when it encounters (@0@) in its input.
--
-- Compare with @Fold.foldMap Product@.
--
-- @since 0.7.0
-- /Since 0.8.0 (Added 'Eq' constraint)/
{-# INLINE product #-}
product :: (Monad m, Num a, Eq a) => Fold m a a
product :: Fold m a a
product =  (a -> a -> Step a a) -> Step a a -> Fold m a a
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> Step b b) -> Step b b -> Fold m a b
mkFold_ a -> a -> Step a a
forall s b. (Eq s, Num s, Num b) => s -> s -> Step s b
step (a -> Step a a
forall s b. s -> Step s b
Partial a
1)

    where

    step :: s -> s -> Step s b
step s
x s
a =
        if s
a s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
0
        then b -> Step s b
forall s b. b -> Step s b
Done b
0
        else s -> Step s b
forall s b. s -> Step s b
Partial (s -> Step s b) -> s -> Step s b
forall a b. (a -> b) -> a -> b
$ s
x s -> s -> s
forall a. Num a => a -> a -> a
* s
a

------------------------------------------------------------------------------
-- To Summary (Maybe)
------------------------------------------------------------------------------

-- | Determine the maximum element in a stream using the supplied comparison
-- function.
--
-- @since 0.7.0
{-# INLINE maximumBy #-}
maximumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)
maximumBy :: (a -> a -> Ordering) -> Fold m a (Maybe a)
maximumBy a -> a -> Ordering
cmp = (a -> a -> a) -> Fold m a (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
foldl1' a -> a -> a
max'

    where

    max' :: a -> a -> a
max' a
x a
y =
        case a -> a -> Ordering
cmp a
x a
y of
            Ordering
GT -> a
x
            Ordering
_ -> a
y

-- |
-- @
-- maximum = Fold.maximumBy compare
-- @
--
-- Determine the maximum element in a stream.
--
-- Compare with @Fold.foldMap Max@.
--
-- @since 0.7.0
{-# INLINE maximum #-}
maximum :: (Monad m, Ord a) => Fold m a (Maybe a)
maximum :: Fold m a (Maybe a)
maximum = (a -> a -> a) -> Fold m a (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
foldl1' a -> a -> a
forall a. Ord a => a -> a -> a
max

-- | Computes the minimum element with respect to the given comparison function
--
-- @since 0.7.0
{-# INLINE minimumBy #-}
minimumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)
minimumBy :: (a -> a -> Ordering) -> Fold m a (Maybe a)
minimumBy a -> a -> Ordering
cmp = (a -> a -> a) -> Fold m a (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
foldl1' a -> a -> a
min'

    where

    min' :: a -> a -> a
min' a
x a
y =
        case a -> a -> Ordering
cmp a
x a
y of
            Ordering
GT -> a
y
            Ordering
_ -> a
x

-- | Determine the minimum element in a stream using the supplied comparison
-- function.
--
-- @
-- minimum = 'minimumBy' compare
-- @
--
-- Compare with @Fold.foldMap Min@.
--
-- @since 0.7.0
{-# INLINE minimum #-}
minimum :: (Monad m, Ord a) => Fold m a (Maybe a)
minimum :: Fold m a (Maybe a)
minimum = (a -> a -> a) -> Fold m a (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
foldl1' a -> a -> a
forall a. Ord a => a -> a -> a
min

------------------------------------------------------------------------------
-- To Summary (Statistical)
------------------------------------------------------------------------------

-- | Compute a numerically stable arithmetic mean of all elements in the input
-- stream.
--
-- @since 0.7.0
{-# INLINABLE mean #-}
mean :: (Monad m, Fractional a) => Fold m a a
mean :: Fold m a a
mean = (Tuple' a a -> a) -> Fold m a (Tuple' a a) -> Fold m a a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tuple' a a -> a
forall a b. Tuple' a b -> a
done (Fold m a (Tuple' a a) -> Fold m a a)
-> Fold m a (Tuple' a a) -> Fold m a a
forall a b. (a -> b) -> a -> b
$ (Tuple' a a -> a -> Tuple' a a)
-> Tuple' a a -> Fold m a (Tuple' a a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' Tuple' a a -> a -> Tuple' a a
forall b. Fractional b => Tuple' b b -> b -> Tuple' b b
step Tuple' a a
begin

    where

    begin :: Tuple' a a
begin = a -> a -> Tuple' a a
forall a b. a -> b -> Tuple' a b
Tuple' a
0 a
0

    step :: Tuple' b b -> b -> Tuple' b b
step (Tuple' b
x b
n) b
y =
        let n1 :: b
n1 = b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1
         in b -> b -> Tuple' b b
forall a b. a -> b -> Tuple' a b
Tuple' (b
x b -> b -> b
forall a. Num a => a -> a -> a
+ (b
y b -> b -> b
forall a. Num a => a -> a -> a
- b
x) b -> b -> b
forall a. Fractional a => a -> a -> a
/ b
n1) b
n1

    done :: Tuple' a b -> a
done (Tuple' a
x b
_) = a
x

-- | Compute a numerically stable (population) variance over all elements in
-- the input stream.
--
-- @since 0.7.0
{-# INLINABLE variance #-}
variance :: (Monad m, Fractional a) => Fold m a a
variance :: Fold m a a
variance = (Tuple3' a a a -> a) -> Fold m a (Tuple3' a a a) -> Fold m a a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tuple3' a a a -> a
forall a b. Fractional a => Tuple3' a b a -> a
done (Fold m a (Tuple3' a a a) -> Fold m a a)
-> Fold m a (Tuple3' a a a) -> Fold m a a
forall a b. (a -> b) -> a -> b
$ (Tuple3' a a a -> a -> Tuple3' a a a)
-> Tuple3' a a a -> Fold m a (Tuple3' a a a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' Tuple3' a a a -> a -> Tuple3' a a a
forall b. Fractional b => Tuple3' b b b -> b -> Tuple3' b b b
step Tuple3' a a a
begin

    where

    begin :: Tuple3' a a a
begin = a -> a -> a -> Tuple3' a a a
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' a
0 a
0 a
0

    step :: Tuple3' b b b -> b -> Tuple3' b b b
step (Tuple3' b
n b
mean_ b
m2) b
x = b -> b -> b -> Tuple3' b b b
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' b
n' b
mean' b
m2'

        where

        n' :: b
n' = b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1
        mean' :: b
mean' = (b
n b -> b -> b
forall a. Num a => a -> a -> a
* b
mean_ b -> b -> b
forall a. Num a => a -> a -> a
+ b
x) b -> b -> b
forall a. Fractional a => a -> a -> a
/ (b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)
        delta :: b
delta = b
x b -> b -> b
forall a. Num a => a -> a -> a
- b
mean_
        m2' :: b
m2' = b
m2 b -> b -> b
forall a. Num a => a -> a -> a
+ b
delta b -> b -> b
forall a. Num a => a -> a -> a
* b
delta b -> b -> b
forall a. Num a => a -> a -> a
* b
n b -> b -> b
forall a. Fractional a => a -> a -> a
/ (b
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1)

    done :: Tuple3' a b a -> a
done (Tuple3' a
n b
_ a
m2) = a
m2 a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
n

-- | Compute a numerically stable (population) standard deviation over all
-- elements in the input stream.
--
-- @since 0.7.0
{-# INLINABLE stdDev #-}
stdDev :: (Monad m, Floating a) => Fold m a a
stdDev :: Fold m a a
stdDev = a -> a
forall a. Floating a => a -> a
sqrt (a -> a) -> Fold m a a -> Fold m a a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold m a a
forall (m :: * -> *) a. (Monad m, Fractional a) => Fold m a a
variance

-- | Compute an 'Int' sized polynomial rolling hash
--
-- > H = salt * k ^ n + c1 * k ^ (n - 1) + c2 * k ^ (n - 2) + ... + cn * k ^ 0
--
-- Where @c1@, @c2@, @cn@ are the elements in the input stream and @k@ is a
-- constant.
--
-- This hash is often used in Rabin-Karp string search algorithm.
--
-- See https://en.wikipedia.org/wiki/Rolling_hash
--
-- @since 0.8.0
{-# INLINABLE rollingHashWithSalt #-}
rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64
rollingHashWithSalt :: Int64 -> Fold m a Int64
rollingHashWithSalt = (Int64 -> a -> Int64) -> Int64 -> Fold m a Int64
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' Int64 -> a -> Int64
forall a. Enum a => Int64 -> a -> Int64
step

    where

    k :: Int64
k = Int64
2891336453 :: Int64

    step :: Int64 -> a -> Int64
step Int64
cksum a
a = Int64
cksum Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
k Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int
forall a. Enum a => a -> Int
fromEnum a
a)

-- | A default salt used in the implementation of 'rollingHash'.
{-# INLINE defaultSalt #-}
defaultSalt :: Int64
defaultSalt :: Int64
defaultSalt = -Int64
2578643520546668380

-- | Compute an 'Int' sized polynomial rolling hash of a stream.
--
-- > rollingHash = Fold.rollingHashWithSalt defaultSalt
--
-- @since 0.8.0
{-# INLINABLE rollingHash #-}
rollingHash :: (Monad m, Enum a) => Fold m a Int64
rollingHash :: Fold m a Int64
rollingHash = Int64 -> Fold m a Int64
forall (m :: * -> *) a.
(Monad m, Enum a) =>
Int64 -> Fold m a Int64
rollingHashWithSalt Int64
defaultSalt

-- | Compute an 'Int' sized polynomial rolling hash of the first n elements of
-- a stream.
--
-- > rollingHashFirstN = Fold.take n Fold.rollingHash
--
-- /Pre-release/
{-# INLINABLE rollingHashFirstN #-}
rollingHashFirstN :: (Monad m, Enum a) => Int -> Fold m a Int64
rollingHashFirstN :: Int -> Fold m a Int64
rollingHashFirstN Int
n = Int -> Fold m a Int64 -> Fold m a Int64
forall (m :: * -> *) a b.
Monad m =>
Int -> Fold m a b -> Fold m a b
take Int
n Fold m a Int64
forall (m :: * -> *) a. (Monad m, Enum a) => Fold m a Int64
rollingHash

------------------------------------------------------------------------------
-- Monoidal left folds
------------------------------------------------------------------------------

-- | Append the elements of an input stream to a provided starting value.
--
-- >>> Stream.fold (Fold.sconcat 10) (Stream.map Data.Monoid.Sum $ Stream.enumerateFromTo 1 10)
-- Sum {getSum = 65}
--
-- @
-- sconcat = Fold.foldl' (<>)
-- @
--
-- @since 0.8.0
{-# INLINE sconcat #-}
sconcat :: (Monad m, Semigroup a) => a -> Fold m a a
sconcat :: a -> Fold m a a
sconcat = (a -> a -> a) -> a -> Fold m a a
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

-- | Fold an input stream consisting of monoidal elements using 'mappend'
-- and 'mempty'.
--
-- >>> Stream.fold Fold.mconcat (Stream.map Data.Monoid.Sum $ Stream.enumerateFromTo 1 10)
-- Sum {getSum = 55}
--
-- > mconcat = Fold.sconcat mempty
--
-- @since 0.7.0
{-# INLINE mconcat #-}
mconcat ::
    ( Monad m
#if !MIN_VERSION_base(4,11,0)
    , Semigroup a
#endif
    , Monoid a) => Fold m a a
mconcat :: Fold m a a
mconcat = a -> Fold m a a
forall (m :: * -> *) a. (Monad m, Semigroup a) => a -> Fold m a a
sconcat a
forall a. Monoid a => a
mempty

-- |
-- > foldMap f = Fold.lmap f Fold.mconcat
--
-- Make a fold from a pure function that folds the output of the function
-- using 'mappend' and 'mempty'.
--
-- >>> Stream.fold (Fold.foldMap Data.Monoid.Sum) $ Stream.enumerateFromTo 1 10
-- Sum {getSum = 55}
--
-- @since 0.7.0
{-# INLINABLE foldMap #-}
foldMap :: (Monad m, Monoid b
#if !MIN_VERSION_base(4,11,0)
    , Semigroup b
#endif
    ) => (a -> b) -> Fold m a b
foldMap :: (a -> b) -> Fold m a b
foldMap a -> b
f = (a -> b) -> Fold m b b -> Fold m a b
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap a -> b
f Fold m b b
forall (m :: * -> *) a. (Monad m, Monoid a) => Fold m a a
mconcat

-- |
-- > foldMapM f = Fold.lmapM f Fold.mconcat
--
-- Make a fold from a monadic function that folds the output of the function
-- using 'mappend' and 'mempty'.
--
-- >>> Stream.fold (Fold.foldMapM (return . Data.Monoid.Sum)) $ Stream.enumerateFromTo 1 10
-- Sum {getSum = 55}
--
-- @since 0.7.0
{-# INLINABLE foldMapM #-}
foldMapM ::  (Monad m, Monoid b) => (a -> m b) -> Fold m a b
foldMapM :: (a -> m b) -> Fold m a b
foldMapM a -> m b
act = (b -> a -> m b) -> m b -> Fold m a b
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
foldlM' b -> a -> m b
step (b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Monoid a => a
mempty)

    where

    step :: b -> a -> m b
step b
m a
a = do
        b
m' <- a -> m b
act a
a
        b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$! b -> b -> b
forall a. Monoid a => a -> a -> a
mappend b
m b
m'

------------------------------------------------------------------------------
-- To Containers
------------------------------------------------------------------------------

-- $toListRev
-- This is more efficient than 'Streamly.Internal.Data.Fold.toList'. toList is
-- exactly the same as reversing the list after 'toListRev'.

-- | Buffers the input stream to a list in the reverse order of the input.
--
-- > toListRev = Fold.foldl' (flip (:)) []
--
-- /Warning!/ working on large lists accumulated as buffers in memory could be
-- very inefficient, consider using "Streamly.Array" instead.
--
-- @since 0.8.0

--  xn : ... : x2 : x1 : []
{-# INLINABLE toListRev #-}
toListRev :: Monad m => Fold m a [a]
toListRev :: Fold m a [a]
toListRev = ([a] -> a -> [a]) -> [a] -> Fold m a [a]
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' ((a -> [a] -> [a]) -> [a] -> a -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) []

------------------------------------------------------------------------------
-- Partial Folds
------------------------------------------------------------------------------

-- | A fold that drains the first n elements of its input, running the effects
-- and discarding the results.
--
-- > drainN n = Fold.take n Fold.drain
--
-- /Pre-release/
{-# INLINABLE drainN #-}
drainN :: Monad m => Int -> Fold m a ()
drainN :: Int -> Fold m a ()
drainN Int
n = Int -> Fold m a () -> Fold m a ()
forall (m :: * -> *) a b.
Monad m =>
Int -> Fold m a b -> Fold m a b
take Int
n Fold m a ()
forall (m :: * -> *) a. Monad m => Fold m a ()
drain

------------------------------------------------------------------------------
-- To Elements
------------------------------------------------------------------------------

-- | Like 'index', except with a more general 'Integral' argument
--
-- /Pre-release/
{-# INLINABLE genericIndex #-}
genericIndex :: (Integral i, Monad m) => i -> Fold m a (Maybe a)
genericIndex :: i -> Fold m a (Maybe a)
genericIndex i
i = (i -> a -> Step i (Maybe a))
-> Step i (Maybe a) -> (i -> 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
mkFold i -> a -> Step i (Maybe a)
forall a. i -> a -> Step i (Maybe a)
step (i -> Step i (Maybe a)
forall s b. s -> Step s b
Partial i
0) (Maybe a -> i -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing)

    where

    step :: i -> a -> Step i (Maybe a)
step i
j a
a =
        if i
i i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
j
        then Maybe a -> Step i (Maybe a)
forall s b. b -> Step s b
Done (Maybe a -> Step i (Maybe a)) -> Maybe a -> Step i (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a
        else i -> Step i (Maybe a)
forall s b. s -> Step s b
Partial (i
j i -> i -> i
forall a. Num a => a -> a -> a
+ i
1)

-- | Lookup the element at the given index.
--
-- See also: 'Streamly.Prelude.!!'
--
-- @since 0.7.0
{-# INLINABLE index #-}
index :: Monad m => Int -> Fold m a (Maybe a)
index :: Int -> Fold m a (Maybe a)
index = Int -> Fold m a (Maybe a)
forall i (m :: * -> *) a.
(Integral i, Monad m) =>
i -> Fold m a (Maybe a)
genericIndex

-- | Extract the first element of the stream, if any.
--
-- @since 0.7.0
{-# INLINABLE head #-}
head :: Monad m => Fold m a (Maybe a)
head :: Fold m a (Maybe a)
head = (Maybe a -> a -> Step (Maybe a) (Maybe a))
-> Step (Maybe a) (Maybe a) -> Fold m a (Maybe a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> Step b b) -> Step b b -> Fold m a b
mkFold_ ((a -> Step (Maybe a) (Maybe a))
-> Maybe a -> a -> Step (Maybe a) (Maybe a)
forall a b. a -> b -> a
const (Maybe a -> Step (Maybe a) (Maybe a)
forall s b. b -> Step s b
Done (Maybe a -> Step (Maybe a) (Maybe a))
-> (a -> Maybe a) -> a -> Step (Maybe a) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just)) (Maybe a -> Step (Maybe a) (Maybe a)
forall s b. s -> Step s b
Partial Maybe a
forall a. Maybe a
Nothing)

-- | Returns the first element that satisfies the given predicate.
--
-- @since 0.7.0
{-# INLINABLE find #-}
find :: Monad m => (a -> Bool) -> Fold m a (Maybe a)
find :: (a -> Bool) -> Fold m a (Maybe a)
find a -> Bool
predicate = (() -> a -> Step () (Maybe a))
-> Step () (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
mkFold () -> a -> Step () (Maybe a)
step (() -> Step () (Maybe a)
forall s b. s -> Step s b
Partial ()) (Maybe a -> () -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing)

    where

    step :: () -> a -> Step () (Maybe a)
step () a
a =
        if a -> Bool
predicate a
a
        then Maybe a -> Step () (Maybe a)
forall s b. b -> Step s b
Done (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
        else () -> Step () (Maybe a)
forall s b. s -> Step s b
Partial ()

-- | In a stream of (key-value) pairs @(a, b)@, return the value @b@ of the
-- first pair where the key equals the given value @a@.
--
-- > lookup = snd <$> Fold.find ((==) . fst)
--
-- @since 0.7.0
{-# INLINABLE lookup #-}
lookup :: (Eq a, Monad m) => a -> Fold m (a,b) (Maybe b)
lookup :: a -> Fold m (a, b) (Maybe b)
lookup a
a0 = (() -> (a, b) -> Step () (Maybe b))
-> Step () (Maybe b) -> (() -> Maybe b) -> Fold m (a, b) (Maybe b)
forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
mkFold () -> (a, b) -> Step () (Maybe b)
forall a. () -> (a, a) -> Step () (Maybe a)
step (() -> Step () (Maybe b)
forall s b. s -> Step s b
Partial ()) (Maybe b -> () -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing)

    where

    step :: () -> (a, a) -> Step () (Maybe a)
step () (a
a, a
b) =
        if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a0
        then Maybe a -> Step () (Maybe a)
forall s b. b -> Step s b
Done (Maybe a -> Step () (Maybe a)) -> Maybe a -> Step () (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
b
        else () -> Step () (Maybe a)
forall s b. s -> Step s b
Partial ()

-- | Returns the first index that satisfies the given predicate.
--
-- @since 0.7.0
{-# INLINABLE findIndex #-}
findIndex :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)
findIndex :: (a -> Bool) -> Fold m a (Maybe Int)
findIndex a -> Bool
predicate = (Int -> a -> Step Int (Maybe Int))
-> Step Int (Maybe Int)
-> (Int -> Maybe Int)
-> Fold m a (Maybe Int)
forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
mkFold Int -> a -> Step Int (Maybe Int)
forall s. Num s => s -> a -> Step s (Maybe s)
step (Int -> Step Int (Maybe Int)
forall s b. s -> Step s b
Partial Int
0) (Maybe Int -> Int -> Maybe Int
forall a b. a -> b -> a
const Maybe Int
forall a. Maybe a
Nothing)

    where

    step :: s -> a -> Step s (Maybe s)
step s
i a
a =
        if a -> Bool
predicate a
a
        then Maybe s -> Step s (Maybe s)
forall s b. b -> Step s b
Done (Maybe s -> Step s (Maybe s)) -> Maybe s -> Step s (Maybe s)
forall a b. (a -> b) -> a -> b
$ s -> Maybe s
forall a. a -> Maybe a
Just s
i
        else s -> Step s (Maybe s)
forall s b. s -> Step s b
Partial (s
i s -> s -> s
forall a. Num a => a -> a -> a
+ s
1)

-- | Returns the first index where a given value is found in the stream.
--
-- > elemIndex a = Fold.findIndex (== a)
--
-- @since 0.7.0
{-# INLINABLE elemIndex #-}
elemIndex :: (Eq a, Monad m) => a -> Fold m a (Maybe Int)
elemIndex :: a -> Fold m a (Maybe Int)
elemIndex a
a = (a -> Bool) -> Fold m a (Maybe Int)
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Fold m a (Maybe Int)
findIndex (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==)

------------------------------------------------------------------------------
-- To Boolean
------------------------------------------------------------------------------

-- | Return 'True' if the input stream is empty.
--
-- > null = fmap isJust Fold.head
--
-- @since 0.7.0
{-# INLINABLE null #-}
null :: Monad m => Fold m a Bool
null :: Fold m a Bool
null = (() -> a -> Step () Bool)
-> Step () Bool -> (() -> Bool) -> Fold m a Bool
forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
mkFold (\() a
_ -> Bool -> Step () Bool
forall s b. b -> Step s b
Done Bool
False) (() -> Step () Bool
forall s b. s -> Step s b
Partial ()) (Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | Returns 'True' if any of the elements of a stream satisfies a predicate.
--
-- >>> Stream.fold (Fold.any (== 0)) $ Stream.fromList [1,0,1]
-- True
--
-- > any p = Fold.lmap p Fold.or
--
-- @since 0.7.0
{-# INLINE any #-}
any :: Monad m => (a -> Bool) -> Fold m a Bool
any :: (a -> Bool) -> Fold m a Bool
any a -> Bool
predicate = (Bool -> a -> Step Bool Bool) -> Step Bool Bool -> Fold m a Bool
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> Step b b) -> Step b b -> Fold m a b
mkFold_ Bool -> a -> Step Bool Bool
forall p. p -> a -> Step Bool Bool
step Step Bool Bool
forall b. Step Bool b
initial

    where

    initial :: Step Bool b
initial = Bool -> Step Bool b
forall s b. s -> Step s b
Partial Bool
False

    step :: p -> a -> Step Bool Bool
step p
_ a
a =
        if a -> Bool
predicate a
a
        then Bool -> Step Bool Bool
forall s b. b -> Step s b
Done Bool
True
        else Bool -> Step Bool Bool
forall s b. s -> Step s b
Partial Bool
False

-- | Return 'True' if the given element is present in the stream.
--
-- > elem a = Fold.any (== a)
--
-- @since 0.7.0
{-# INLINABLE elem #-}
elem :: (Eq a, Monad m) => a -> Fold m a Bool
elem :: a -> Fold m a Bool
elem a
a = (a -> Bool) -> Fold m a Bool
forall (m :: * -> *) a. Monad m => (a -> Bool) -> Fold m a Bool
any (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==)

-- | Returns 'True' if all elements of a stream satisfy a predicate.
--
-- >>> Stream.fold (Fold.all (== 0)) $ Stream.fromList [1,0,1]
-- False
--
-- > all p = Fold.lmap p Fold.and
--
-- @since 0.7.0
{-# INLINABLE all #-}
all :: Monad m => (a -> Bool) -> Fold m a Bool
all :: (a -> Bool) -> Fold m a Bool
all a -> Bool
predicate = (Bool -> a -> Step Bool Bool) -> Step Bool Bool -> Fold m a Bool
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> Step b b) -> Step b b -> Fold m a b
mkFold_ Bool -> a -> Step Bool Bool
forall p. p -> a -> Step Bool Bool
step Step Bool Bool
forall b. Step Bool b
initial

    where

    initial :: Step Bool b
initial = Bool -> Step Bool b
forall s b. s -> Step s b
Partial Bool
True

    step :: p -> a -> Step Bool Bool
step p
_ a
a =
        if a -> Bool
predicate a
a
        then Bool -> Step Bool Bool
forall s b. s -> Step s b
Partial Bool
True
        else Bool -> Step Bool Bool
forall s b. b -> Step s b
Done Bool
False

-- | Returns 'True' if the given element is not present in the stream.
--
-- > notElem a = Fold.all (/= a)
--
-- @since 0.7.0
{-# INLINABLE notElem #-}
notElem :: (Eq a, Monad m) => a -> Fold m a Bool
notElem :: a -> Fold m a Bool
notElem a
a = (a -> Bool) -> Fold m a Bool
forall (m :: * -> *) a. Monad m => (a -> Bool) -> Fold m a Bool
all (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=)

-- | Returns 'True' if all elements are 'True', 'False' otherwise
--
-- > and = Fold.all (== True)
--
-- @since 0.7.0
{-# INLINE and #-}
and :: Monad m => Fold m Bool Bool
and :: Fold m Bool Bool
and = (Bool -> Bool) -> Fold m Bool Bool
forall (m :: * -> *) a. Monad m => (a -> Bool) -> Fold m a Bool
all (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True)

-- | Returns 'True' if any element is 'True', 'False' otherwise
--
-- > or = Fold.any (== True)
--
-- @since 0.7.0
{-# INLINE or #-}
or :: Monad m => Fold m Bool Bool
or :: Fold m Bool Bool
or = (Bool -> Bool) -> Fold m Bool Bool
forall (m :: * -> *) a. Monad m => (a -> Bool) -> Fold m a Bool
any (Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
True)

------------------------------------------------------------------------------
-- Grouping/Splitting
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Grouping without looking at elements
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Binary APIs
------------------------------------------------------------------------------

-- | @splitAt n f1 f2@ composes folds @f1@ and @f2@ such that first @n@
-- elements of its input are consumed by fold @f1@ and the rest of the stream
-- is consumed by fold @f2@.
--
-- >>> let splitAt_ n xs = Stream.fold (Fold.splitAt n Fold.toList Fold.toList) $ Stream.fromList xs
--
-- >>> splitAt_ 6 "Hello World!"
-- ("Hello ","World!")
--
-- >>> splitAt_ (-1) [1,2,3]
-- ([],[1,2,3])
--
-- >>> splitAt_ 0 [1,2,3]
-- ([],[1,2,3])
--
-- >>> splitAt_ 1 [1,2,3]
-- ([1],[2,3])
--
-- >>> splitAt_ 3 [1,2,3]
-- ([1,2,3],[])
--
-- >>> splitAt_ 4 [1,2,3]
-- ([1,2,3],[])
--
-- > splitAt n f1 f2 = Fold.serialWith (,) (Fold.take n f1) f2
--
-- /Internal/

{-# INLINE splitAt #-}
splitAt
    :: Monad m
    => Int
    -> Fold m a b
    -> Fold m a c
    -> Fold m a (b, c)
splitAt :: Int -> Fold m a b -> Fold m a c -> Fold m a (b, c)
splitAt Int
n Fold m a b
fld = (b -> c -> (b, c)) -> Fold m a b -> Fold m a c -> Fold m a (b, c)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
serialWith (,) (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
fld)

------------------------------------------------------------------------------
-- Element Aware APIs
------------------------------------------------------------------------------
--
------------------------------------------------------------------------------
-- Binary APIs
------------------------------------------------------------------------------

-- 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.
--
-- | Like 'takeEndBy' but drops the element on which the predicate succeeds.
--
-- >>> Stream.fold (Fold.takeEndBy_ (== '\n') Fold.toList) $ Stream.fromList "hello\nthere\n"
-- "hello"
--
-- >>> Stream.toList $ Stream.foldMany (Fold.takeEndBy_ (== '\n') Fold.toList) $ Stream.fromList "hello\nthere\n"
-- ["hello","there"]
--
-- > Stream.splitOnSuffix p f = Stream.foldMany (Fold.takeEndBy_ p f)
--
-- See 'Streamly.Prelude.splitOnSuffix' for more details on splitting a
-- stream using 'takeEndBy_'.
--
-- @since 0.8.0
{-# INLINE takeEndBy_ #-}
takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b
takeEndBy_ :: (a -> Bool) -> Fold m a b -> Fold m a b
takeEndBy_ a -> Bool
predicate (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) =
    (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step m (Step s b)
finitial s -> m b
fextract

    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
fextract s
s

-- | Take the input, stop when the predicate succeeds taking the succeeding
-- element as well.
--
-- >>> Stream.fold (Fold.takeEndBy (== '\n') Fold.toList) $ Stream.fromList "hello\nthere\n"
-- "hello\n"
--
-- >>> Stream.toList $ Stream.foldMany (Fold.takeEndBy (== '\n') Fold.toList) $ Stream.fromList "hello\nthere\n"
-- ["hello\n","there\n"]
--
-- > Stream.splitWithSuffix p f = Stream.foldMany (Fold.takeEndBy p f)
--
-- See 'Streamly.Prelude.splitWithSuffix' for more details on splitting a
-- stream using 'takeEndBy'.
--
-- @since 0.8.0
{-# INLINE takeEndBy #-}
takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b
takeEndBy :: (a -> Bool) -> Fold m a b -> Fold m a b
takeEndBy a -> Bool
predicate (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract) =
    (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step m (Step s b)
finitial s -> m b
fextract

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

------------------------------------------------------------------------------
-- Binary splitting on a separator
------------------------------------------------------------------------------

{-
-- | Find the first occurrence of the specified sequence in the input stream
-- and break the input stream into two parts, the first part consisting of the
-- stream before the sequence and the second part consisting of the sequence
-- and the rest of the stream.
--
-- > let breakOn_ pat xs = S.fold (S.breakOn pat FL.toList FL.toList) $ S.fromList xs
--
-- >>> breakOn_ "dear" "Hello dear world!"
-- > ("Hello ","dear world!")
--
{-# INLINE breakOn #-}
breakOn :: Monad m => Array a -> Fold m a b -> Fold m a c -> Fold m a (b,c)
breakOn pat f m = undefined
-}

------------------------------------------------------------------------------
-- Distributing
------------------------------------------------------------------------------
--
-- | Distribute one copy of the stream to each fold and zip the results.
--
-- @
--                 |-------Fold m a b--------|
-- ---stream m a---|                         |---m (b,c)
--                 |-------Fold m a c--------|
-- @
-- >>> Stream.fold (Fold.tee Fold.sum Fold.length) (Stream.enumerateFromTo 1.0 100.0)
-- (5050.0,100)
--
-- > tee = teeWith (,)
--
-- @since 0.7.0
{-# INLINE tee #-}
tee :: Monad m => Fold m a b -> Fold m a c -> Fold m a (b,c)
tee :: Fold m a b -> Fold m a c -> Fold m a (b, c)
tee = (b -> c -> (b, c)) -> Fold m a b -> Fold m a c -> Fold m a (b, c)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
teeWith (,)

-- XXX use "List" instead of "[]"?, use Array for output to scale it to a large
-- number of consumers? For polymorphic case a vector could be helpful. For
-- Storables we can use arrays. Will need separate APIs for those.
--
-- | Distribute one copy of the stream to each fold and collect the results in
-- a container.
--
-- @
--
--                 |-------Fold m a b--------|
-- ---stream m a---|                         |---m [b]
--                 |-------Fold m a b--------|
--                 |                         |
--                            ...
-- @
--
-- >>> Stream.fold (Fold.distribute [Fold.sum, Fold.length]) (Stream.enumerateFromTo 1 5)
-- [15,5]
--
-- > distribute = Prelude.foldr (Fold.teeWith (:)) (Fold.fromPure [])
--
-- This is the consumer side dual of the producer side 'sequence' operation.
--
-- Stops when all the folds stop.
--
-- @since 0.7.0
{-# INLINE distribute #-}
distribute :: Monad m => [Fold m a b] -> Fold m a [b]
distribute :: [Fold m a b] -> Fold m a [b]
distribute = (Fold m a b -> Fold m a [b] -> Fold m a [b])
-> Fold m a [b] -> [Fold m a b] -> Fold m a [b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr ((b -> [b] -> [b]) -> Fold m a b -> Fold m a [b] -> 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
teeWith (:)) ([b] -> Fold m a [b]
forall (m :: * -> *) b a. Applicative m => b -> Fold m a b
fromPure [])

------------------------------------------------------------------------------
-- Partitioning
------------------------------------------------------------------------------

-- | Partition the input over two folds using an 'Either' partitioning
-- predicate.
--
-- @
--
--                                     |-------Fold b x--------|
-- -----stream m a --> (Either b c)----|                       |----(x,y)
--                                     |-------Fold c y--------|
-- @
--
-- Send input to either fold randomly:
--
-- @
-- > import System.Random (randomIO)
-- > randomly a = randomIO >>= \\x -> return $ if x then Left a else Right a
-- > Stream.fold (Fold.partitionByM randomly Fold.length Fold.length) (Stream.enumerateFromTo 1 100)
-- (59,41)
-- @
--
-- Send input to the two folds in a proportion of 2:1:
--
-- @
-- import Data.IORef (newIORef, readIORef, writeIORef)
-- proportionately m n = do
--  ref <- newIORef $ cycle $ concat [replicate m Left, replicate n Right]
--  return $ \\a -> do
--      r <- readIORef ref
--      writeIORef ref $ tail r
--      return $ head r a
--
-- main = do
--  f <- proportionately 2 1
--  r <- S.fold (FL.partitionByM f FL.length FL.length) (S.enumerateFromTo (1 :: Int) 100)
--  print r
-- @
-- @
-- (67,33)
-- @
--
-- This is the consumer side dual of the producer side 'mergeBy' operation.
--
-- When one fold is done, any input meant for it is ignored until the other
-- fold is also done.
--
-- Stops when both the folds stop.
--
-- /See also: 'partitionByFstM' and 'partitionByMinM'./
--
-- /Pre-release/
{-# INLINE partitionByM #-}
partitionByM :: Monad m
    => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionByM :: (a -> m (Either b c))
-> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionByM a -> m (Either b c)
f (Fold s -> b -> m (Step s x)
stepL m (Step s x)
beginL s -> m x
doneL) (Fold s -> c -> m (Step s y)
stepR m (Step s y)
beginR s -> m y
doneR) =
    (GenericRunner s s x y
 -> a -> m (Step (GenericRunner s s x y) (x, y)))
-> m (Step (GenericRunner s s x y) (x, y))
-> (GenericRunner s s x y -> m (x, y))
-> Fold m a (x, y)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold GenericRunner s s x y
-> a -> m (Step (GenericRunner s s x y) (x, y))
step m (Step (GenericRunner s s x y) (x, y))
begin GenericRunner s s x y -> m (x, y)
done

    where

    begin :: m (Step (GenericRunner s s x y) (x, y))
begin = do
        Step s x
resL <- m (Step s x)
beginL
        Step s y
resR <- m (Step s y)
beginR
        Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (GenericRunner s s x y) (x, y)
 -> m (Step (GenericRunner s s x y) (x, y)))
-> Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall a b. (a -> b) -> a -> b
$ case Step s x
resL of
                  Partial s
sL ->
                      GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall s b. s -> Step s b
Partial
                          (GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y))
-> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall a b. (a -> b) -> a -> b
$ case Step s y
resR of
                                Partial s
sR -> s -> s -> GenericRunner s s x y
forall sL sR bL bR. sL -> sR -> GenericRunner sL sR bL bR
RunBoth s
sL s
sR
                                Done y
bR -> s -> y -> GenericRunner s s x y
forall sL sR bL bR. sL -> bR -> GenericRunner sL sR bL bR
RunLeft s
sL y
bR
                  Done x
bL ->
                      case Step s y
resR of
                          Partial s
sR -> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall s b. s -> Step s b
Partial (GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y))
-> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall a b. (a -> b) -> a -> b
$ x -> s -> GenericRunner s s x y
forall sL sR bL bR. bL -> sR -> GenericRunner sL sR bL bR
RunRight x
bL s
sR
                          Done y
bR -> (x, y) -> Step (GenericRunner s s x y) (x, y)
forall s b. b -> Step s b
Done (x
bL, y
bR)

    step :: GenericRunner s s x y
-> a -> m (Step (GenericRunner s s x y) (x, y))
step (RunBoth s
sL s
sR) a
a = do
        Either b c
r <- a -> m (Either b c)
f a
a
        case Either b c
r of
            Left b
b -> do
                Step s x
res <- s -> b -> m (Step s x)
stepL s
sL b
b
                Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall (m :: * -> *) a. Monad m => a -> m a
return
                  (Step (GenericRunner s s x y) (x, y)
 -> m (Step (GenericRunner s s x y) (x, y)))
-> Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall a b. (a -> b) -> a -> b
$ GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall s b. s -> Step s b
Partial
                  (GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y))
-> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall a b. (a -> b) -> a -> b
$ case Step s x
res of
                        Partial s
sres -> s -> s -> GenericRunner s s x y
forall sL sR bL bR. sL -> sR -> GenericRunner sL sR bL bR
RunBoth s
sres s
sR
                        Done x
bres -> x -> s -> GenericRunner s s x y
forall sL sR bL bR. bL -> sR -> GenericRunner sL sR bL bR
RunRight x
bres s
sR
            Right c
c -> do
                Step s y
res <- s -> c -> m (Step s y)
stepR s
sR c
c
                Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall (m :: * -> *) a. Monad m => a -> m a
return
                  (Step (GenericRunner s s x y) (x, y)
 -> m (Step (GenericRunner s s x y) (x, y)))
-> Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall a b. (a -> b) -> a -> b
$ GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall s b. s -> Step s b
Partial
                  (GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y))
-> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall a b. (a -> b) -> a -> b
$ case Step s y
res of
                        Partial s
sres -> s -> s -> GenericRunner s s x y
forall sL sR bL bR. sL -> sR -> GenericRunner sL sR bL bR
RunBoth s
sL s
sres
                        Done y
bres -> s -> y -> GenericRunner s s x y
forall sL sR bL bR. sL -> bR -> GenericRunner sL sR bL bR
RunLeft s
sL y
bres
    step (RunLeft s
sL y
bR) a
a = do
        Either b c
r <- a -> m (Either b c)
f a
a
        case Either b c
r of
            Left b
b -> do
                Step s x
res <- s -> b -> m (Step s x)
stepL s
sL b
b
                Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall (m :: * -> *) a. Monad m => a -> m a
return
                  (Step (GenericRunner s s x y) (x, y)
 -> m (Step (GenericRunner s s x y) (x, y)))
-> Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall a b. (a -> b) -> a -> b
$ case Step s x
res of
                        Partial s
sres -> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall s b. s -> Step s b
Partial (GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y))
-> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall a b. (a -> b) -> a -> b
$ s -> y -> GenericRunner s s x y
forall sL sR bL bR. sL -> bR -> GenericRunner sL sR bL bR
RunLeft s
sres y
bR
                        Done x
bres -> (x, y) -> Step (GenericRunner s s x y) (x, y)
forall s b. b -> Step s b
Done (x
bres, y
bR)
            Right c
_ -> Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GenericRunner s s x y) (x, y)
 -> m (Step (GenericRunner s s x y) (x, y)))
-> Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall a b. (a -> b) -> a -> b
$ GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall s b. s -> Step s b
Partial (GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y))
-> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall a b. (a -> b) -> a -> b
$ s -> y -> GenericRunner s s x y
forall sL sR bL bR. sL -> bR -> GenericRunner sL sR bL bR
RunLeft s
sL y
bR
    step (RunRight x
bL s
sR) a
a = do
        Either b c
r <- a -> m (Either b c)
f a
a
        case Either b c
r of
            Left b
_ -> Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GenericRunner s s x y) (x, y)
 -> m (Step (GenericRunner s s x y) (x, y)))
-> Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall a b. (a -> b) -> a -> b
$ GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall s b. s -> Step s b
Partial (GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y))
-> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall a b. (a -> b) -> a -> b
$ x -> s -> GenericRunner s s x y
forall sL sR bL bR. bL -> sR -> GenericRunner sL sR bL bR
RunRight x
bL s
sR
            Right c
c -> do
                Step s y
res <- s -> c -> m (Step s y)
stepR s
sR c
c
                Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall (m :: * -> *) a. Monad m => a -> m a
return
                  (Step (GenericRunner s s x y) (x, y)
 -> m (Step (GenericRunner s s x y) (x, y)))
-> Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall a b. (a -> b) -> a -> b
$ case Step s y
res of
                        Partial s
sres -> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall s b. s -> Step s b
Partial (GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y))
-> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall a b. (a -> b) -> a -> b
$ x -> s -> GenericRunner s s x y
forall sL sR bL bR. bL -> sR -> GenericRunner sL sR bL bR
RunRight x
bL s
sres
                        Done y
bres -> (x, y) -> Step (GenericRunner s s x y) (x, y)
forall s b. b -> Step s b
Done (x
bL, y
bres)

    done :: GenericRunner s s x y -> m (x, y)
done (RunBoth s
sL s
sR) = (,) (x -> y -> (x, y)) -> m x -> m (y -> (x, y))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m x
doneL s
sL m (y -> (x, y)) -> m y -> m (x, y)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m y
doneR s
sR
    done (RunLeft s
sL y
bR) = (,y
bR) (x -> (x, y)) -> m x -> m (x, y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m x
doneL s
sL
    done (RunRight x
bL s
sR) = (x
bL,) (y -> (x, y)) -> m y -> m (x, y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m y
doneR s
sR

-- | Similar to 'partitionByM' but terminates when the first fold terminates.
--
-- /Unimplemented/
--
{-# INLINE partitionByFstM #-}
partitionByFstM :: -- Monad m =>
       (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionByFstM :: (a -> m (Either b c))
-> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionByFstM = (a -> m (Either b c))
-> Fold m b x -> Fold m c y -> Fold m a (x, y)
forall a. HasCallStack => a
undefined

-- | Similar to 'partitionByM' but terminates when any fold terminates.
--
-- /Unimplemented/
--
{-# INLINE partitionByMinM #-}
partitionByMinM :: -- Monad m =>
       (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionByMinM :: (a -> m (Either b c))
-> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionByMinM = (a -> m (Either b c))
-> Fold m b x -> Fold m c y -> Fold m a (x, y)
forall a. HasCallStack => a
undefined

-- Note: we could use (a -> Bool) instead of (a -> Either b c), but the latter
-- makes the signature clearer as to which case belongs to which fold.
-- XXX need to check the performance in both cases.
-- | Same as 'partitionByM' but with a pure partition function.
--
-- Count even and odd numbers in a stream:
--
-- >>> :{
--  let f = Fold.partitionBy (\n -> if even n then Left n else Right n)
--                      (fmap (("Even " ++) . show) Fold.length)
--                      (fmap (("Odd "  ++) . show) Fold.length)
--   in Stream.fold f (Stream.enumerateFromTo 1 100)
-- :}
-- ("Even 50","Odd 50")
--
-- /Pre-release/
{-# INLINE partitionBy #-}
partitionBy :: Monad m
    => (a -> Either b c) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionBy :: (a -> Either b c) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionBy a -> Either b c
f = (a -> m (Either b c))
-> Fold m b x -> Fold m c y -> Fold m a (x, y)
forall (m :: * -> *) a b c x y.
Monad m =>
(a -> m (Either b c))
-> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionByM (Either b c -> m (Either b c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either b c -> m (Either b c))
-> (a -> Either b c) -> a -> m (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either b c
f)

-- | Compose two folds such that the combined fold accepts a stream of 'Either'
-- and routes the 'Left' values to the first fold and 'Right' values to the
-- second fold.
--
-- > partition = partitionBy id
--
-- @since 0.7.0
{-# INLINE partition #-}
partition :: Monad m
    => Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)
partition :: Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)
partition = (Either b c -> Either b c)
-> Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)
forall (m :: * -> *) a b c x y.
Monad m =>
(a -> Either b c) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionBy Either b c -> Either b c
forall a. a -> a
id

{-
-- | Send one item to each fold in a round-robin fashion. This is the consumer
-- side dual of producer side 'mergeN' operation.
--
-- partitionN :: Monad m => [Fold m a b] -> Fold m a [b]
-- partitionN fs = Fold step begin done
-}

-- TODO Demultiplex an input element into a number of typed variants. We want
-- to statically restrict the target values within a set of predefined types,
-- an enumeration of a GADT. We also want to make sure that the Map contains
-- only those types and the full set of those types.
--
-- TODO Instead of the input Map it should probably be a lookup-table using an
-- array and not in GC memory. The same applies to the output Map as well.
-- However, that would only be helpful if we have a very large data structure,
-- need to measure and see how it scales.
--
-- This is the consumer side dual of the producer side 'mux' operation (XXX to
-- be implemented).

-- | Split the input stream based on a key field and fold each split using a
-- specific fold collecting the results in a map from the keys to the results.
-- Useful for cases like protocol handlers to handle different type of packets
-- using different handlers.
--
-- @
--
--                             |-------Fold m a b
-- -----stream m a-----Map-----|
--                             |-------Fold m a b
--                             |
--                                       ...
-- @
--
-- Any input that does not map to a fold in the input Map is silently ignored.
--
-- > demuxWith f kv = fmap fst $ demuxDefaultWith f kv drain
--
-- /Pre-release/
--
{-# INLINE demuxWith #-}
demuxWith :: (Monad m, Ord k)
    => (a -> (k, a')) -> Map k (Fold m a' b) -> Fold m a (Map k b)
demuxWith :: (a -> (k, a')) -> Map k (Fold m a' b) -> Fold m a (Map k b)
demuxWith a -> (k, a')
f Map k (Fold m a' b)
kv = ((Map k b, ()) -> Map k b)
-> Fold m a (Map k b, ()) -> Fold m a (Map k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map k b, ()) -> Map k b
forall a b. (a, b) -> a
fst (Fold m a (Map k b, ()) -> Fold m a (Map k b))
-> Fold m a (Map k b, ()) -> Fold m a (Map k b)
forall a b. (a -> b) -> a -> b
$ (a -> (k, a'))
-> Map k (Fold m a' b)
-> Fold m (k, a') ()
-> Fold m a (Map k b, ())
forall (m :: * -> *) k a a' b c.
(Monad m, Ord k) =>
(a -> (k, a'))
-> Map k (Fold m a' b) -> Fold m (k, a') c -> Fold m a (Map k b, c)
demuxDefaultWith a -> (k, a')
f Map k (Fold m a' b)
kv Fold m (k, a') ()
forall (m :: * -> *) a. Monad m => Fold m a ()
drain

-- | Fold a stream of key value pairs using a map of specific folds for each
-- key into a map from keys to the results of fold outputs of the corresponding
-- values.
--
-- >>> import qualified Data.Map
-- >>> :{
--  let table = Data.Map.fromList [("SUM", Fold.sum), ("PRODUCT", Fold.product)]
--      input = Stream.fromList [("SUM",1),("PRODUCT",2),("SUM",3),("PRODUCT",4)]
--   in Stream.fold (Fold.demux table) input
-- :}
-- fromList [("PRODUCT",8),("SUM",4)]
--
-- > demux = demuxWith id
--
-- /Pre-release/
{-# INLINE demux #-}
demux :: (Monad m, Ord k)
    => Map k (Fold m a b) -> Fold m (k, a) (Map k b)
demux :: Map k (Fold m a b) -> Fold m (k, a) (Map k b)
demux = ((k, a) -> (k, a)) -> Map k (Fold m a b) -> Fold m (k, a) (Map k b)
forall (m :: * -> *) k a a' b.
(Monad m, Ord k) =>
(a -> (k, a')) -> Map k (Fold m a' b) -> Fold m a (Map k b)
demuxWith (k, a) -> (k, a)
forall a. a -> a
id

data DemuxState s b doneMap runMap =
      DemuxMapAndDefault !s !doneMap !runMap
    | DemuxOnlyMap b !doneMap !runMap
    | DemuxOnlyDefault s !doneMap

-- | Like 'demuxWith' but uses a default catchall fold to handle inputs which
-- do not have a specific fold in the map to handle them.
--
-- If any fold in the map stops, inputs meant for that fold are sent to the
-- catchall fold. If the catchall fold stops then inputs that do not match any
-- fold are ignored.
--
-- Stops when all the folds, including the catchall fold, stop.
--
-- /Pre-release/
--
{-# INLINE demuxDefaultWith #-}
demuxDefaultWith :: (Monad m, Ord k)
    => (a -> (k, a'))
    -> Map k (Fold m a' b)
    -> Fold m (k, a') c
    -> Fold m a (Map k b, c)
demuxDefaultWith :: (a -> (k, a'))
-> Map k (Fold m a' b) -> Fold m (k, a') c -> Fold m a (Map k b, c)
demuxDefaultWith a -> (k, a')
f Map k (Fold m a' b)
kv (Fold s -> (k, a') -> m (Step s c)
dstep m (Step s c)
dinitial s -> m c
dextract) =
    (DemuxState s c (Map k b) (Map k (Fold m a' b))
 -> a
 -> m (Step
         (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)))
-> m (Step
        (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
-> (DemuxState s c (Map k b) (Map k (Fold m a' b))
    -> m (Map k b, c))
-> Fold m a (Map k b, c)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold DemuxState s c (Map k b) (Map k (Fold m a' b))
-> a
-> m (Step
        (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
forall b.
DemuxState s c (Map k b) (Map k (Fold m a' b))
-> a
-> m (Step
        (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
step m (Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
initial DemuxState s c (Map k b) (Map k (Fold m a' b)) -> m (Map k b, c)
forall k a a.
Ord k =>
DemuxState s c (Map k a) (Map k (Fold m a a)) -> m (Map k a, c)
extract

    where

    initial :: m (Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
initial = do
        let runInit :: Fold m a b -> m (Either' b (Fold m a b))
runInit (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
done1) = do
                Step s b
r <- m (Step s b)
initial1
                Either' b (Fold m a b) -> m (Either' b (Fold m a b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Either' b (Fold m a b) -> m (Either' b (Fold m a b)))
-> Either' b (Fold m a b) -> m (Either' b (Fold m a b))
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
                          Partial s
_ -> Fold m a b -> Either' b (Fold m a b)
forall a b. b -> Either' a b
Right' ((s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
r) s -> m b
done1)
                          Done b
b -> b -> Either' b (Fold m a b)
forall a b. a -> Either' a b
Left' b
b

        -- initialize folds in the kv map and separate the ones that are done
        -- from running ones
        Map k (Either' b (Fold m a' b))
kv1 <- (Fold m a' b -> m (Either' b (Fold m a' b)))
-> Map k (Fold m a' b) -> m (Map k (Either' b (Fold m a' b)))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Prelude.mapM Fold m a' b -> m (Either' b (Fold m a' b))
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> m (Either' b (Fold m a b))
runInit Map k (Fold m a' b)
kv
        let runMap :: Map k (Fold m a' b)
runMap = (Either' b (Fold m a' b) -> Fold m a' b)
-> Map k (Either' b (Fold m a' b)) -> Map k (Fold m a' b)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Either' b (Fold m a' b) -> Fold m a' b
forall a b. Either' a b -> b
fromRight' (Map k (Either' b (Fold m a' b)) -> Map k (Fold m a' b))
-> Map k (Either' b (Fold m a' b)) -> Map k (Fold m a' b)
forall a b. (a -> b) -> a -> b
$ (Either' b (Fold m a' b) -> Bool)
-> Map k (Either' b (Fold m a' b))
-> Map k (Either' b (Fold m a' b))
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Either' b (Fold m a' b) -> Bool
forall a b. Either' a b -> Bool
isRight' Map k (Either' b (Fold m a' b))
kv1
            doneMap :: Map k b
doneMap = (Either' b (Fold m a' b) -> b)
-> Map k (Either' b (Fold m a' b)) -> Map k b
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Either' b (Fold m a' b) -> b
forall a b. Either' a b -> a
fromLeft' (Map k (Either' b (Fold m a' b)) -> Map k b)
-> Map k (Either' b (Fold m a' b)) -> Map k b
forall a b. (a -> b) -> a -> b
$ (Either' b (Fold m a' b) -> Bool)
-> Map k (Either' b (Fold m a' b))
-> Map k (Either' b (Fold m a' b))
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Either' b (Fold m a' b) -> Bool
forall a b. Either' a b -> Bool
isLeft' Map k (Either' b (Fold m a' b))
kv1

        -- Run the default fold, and decide the next state based on its result
        Step s c
dres <- m (Step s c)
dinitial
        Step (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
-> m (Step
        (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
 -> m (Step
         (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
-> m (Step
        (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
forall a b. (a -> b) -> a -> b
$ case Step s c
dres of
                  Partial s
s ->
                      DemuxState s c (Map k b) (Map k (Fold m a' b))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall s b. s -> Step s b
Partial
                          (DemuxState s c (Map k b) (Map k (Fold m a' b))
 -> Step
      (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
-> DemuxState s c (Map k b) (Map k (Fold m a' b))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall a b. (a -> b) -> a -> b
$ if Map k (Fold m a' b) -> Int
forall k a. Map k a -> Int
Map.size Map k (Fold m a' b)
runMap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                            then s
-> Map k b
-> Map k (Fold m a' b)
-> DemuxState s c (Map k b) (Map k (Fold m a' b))
forall s b doneMap runMap.
s -> doneMap -> runMap -> DemuxState s b doneMap runMap
DemuxMapAndDefault s
s Map k b
doneMap Map k (Fold m a' b)
runMap
                            else s -> Map k b -> DemuxState s c (Map k b) (Map k (Fold m a' b))
forall s b doneMap runMap.
s -> doneMap -> DemuxState s b doneMap runMap
DemuxOnlyDefault s
s Map k b
doneMap
                  Done c
b ->
                      if Map k (Fold m a' b) -> Int
forall k a. Map k a -> Int
Map.size Map k (Fold m a' b)
runMap Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                      then DemuxState s c (Map k b) (Map k (Fold m a' b))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall s b. s -> Step s b
Partial (DemuxState s c (Map k b) (Map k (Fold m a' b))
 -> Step
      (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
-> DemuxState s c (Map k b) (Map k (Fold m a' b))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall a b. (a -> b) -> a -> b
$ c
-> Map k b
-> Map k (Fold m a' b)
-> DemuxState s c (Map k b) (Map k (Fold m a' b))
forall s b doneMap runMap.
b -> doneMap -> runMap -> DemuxState s b doneMap runMap
DemuxOnlyMap c
b Map k b
doneMap Map k (Fold m a' b)
runMap
                      else (Map k b, c)
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall s b. b -> Step s b
Done (Map k b
doneMap, c
b)

    {-# INLINE runFold #-}
    runFold :: (Map p b -> Map p (Fold m a b) -> s)
-> (Map p b -> Step s b)
-> Map p b
-> Map p (Fold m a b)
-> Fold m a b
-> p
-> a
-> m (Step s b)
runFold Map p b -> Map p (Fold m a b) -> s
fPartial Map p b -> Step s b
fDone Map p b
doneMap Map p (Fold m a b)
runMap (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
done1) p
k a
a1 = do
        Step s b
resi <- m (Step s b)
initial1
        case Step s b
resi of
            Partial s
st -> do
                Step s b
res <- s -> a -> m (Step s b)
step1 s
st a
a1
                Step s b -> m (Step s b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                    Partial s
s ->
                        let fld :: Fold m a b
fld = (s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step1 (Step s b -> m (Step s b)
forall (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) s -> m b
done1
                            runMap1 :: Map p (Fold m a b)
runMap1 = p -> Fold m a b -> Map p (Fold m a b) -> Map p (Fold m a b)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert p
k Fold m a b
fld Map p (Fold m a b)
runMap
                         in s -> Step s b
forall s b. s -> Step s b
Partial (s -> Step s b) -> s -> Step s b
forall a b. (a -> b) -> a -> b
$ Map p b -> Map p (Fold m a b) -> s
fPartial Map p b
doneMap Map p (Fold m a b)
runMap1
                    Done b
b -> do
                        let runMap1 :: Map p (Fold m a b)
runMap1 = p -> Map p (Fold m a b) -> Map p (Fold m a b)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete p
k Map p (Fold m a b)
runMap
                            doneMap1 :: Map p b
doneMap1 = p -> b -> Map p b -> Map p b
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert p
k b
b Map p b
doneMap
                        if Map p (Fold m a b) -> Int
forall k a. Map k a -> Int
Map.size Map p (Fold m a b)
runMap1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                        then Map p b -> Step s b
fDone Map p b
doneMap1
                        else s -> Step s b
forall s b. s -> Step s b
Partial (s -> Step s b) -> s -> Step s b
forall a b. (a -> b) -> a -> b
$ Map p b -> Map p (Fold m a b) -> s
fPartial Map p b
doneMap1 Map p (Fold m a b)
runMap1
            Done b
_ -> [Char] -> m (Step s b)
forall a. HasCallStack => [Char] -> a
error [Char]
"Bug: demuxDefaultWith: Done fold"

    step :: DemuxState s c (Map k b) (Map k (Fold m a' b))
-> a
-> m (Step
        (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
step (DemuxMapAndDefault s
dacc Map k b
doneMap Map k (Fold m a' b)
runMap) a
a = do
        let (k
k, a'
a1) = a -> (k, a')
f a
a
        case k -> Map k (Fold m a' b) -> Maybe (Fold m a' b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k (Fold m a' b)
runMap of
            Maybe (Fold m a' b)
Nothing -> do
                Step s c
res <- s -> (k, a') -> m (Step s c)
dstep s
dacc (k
k, a'
a1)
                Step (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
-> m (Step
        (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
 -> m (Step
         (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
-> m (Step
        (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
forall a b. (a -> b) -> a -> b
$ DemuxState s c (Map k b) (Map k (Fold m a' b))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall s b. s -> Step s b
Partial
                    (DemuxState s c (Map k b) (Map k (Fold m a' b))
 -> Step
      (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
-> DemuxState s c (Map k b) (Map k (Fold m a' b))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall a b. (a -> b) -> a -> b
$ case Step s c
res of
                          Partial s
s -> s
-> Map k b
-> Map k (Fold m a' b)
-> DemuxState s c (Map k b) (Map k (Fold m a' b))
forall s b doneMap runMap.
s -> doneMap -> runMap -> DemuxState s b doneMap runMap
DemuxMapAndDefault s
s Map k b
doneMap Map k (Fold m a' b)
runMap
                          Done c
b -> c
-> Map k b
-> Map k (Fold m a' b)
-> DemuxState s c (Map k b) (Map k (Fold m a' b))
forall s b doneMap runMap.
b -> doneMap -> runMap -> DemuxState s b doneMap runMap
DemuxOnlyMap c
b Map k b
doneMap Map k (Fold m a' b)
runMap
            Just Fold m a' b
fld ->
                (Map k b
 -> Map k (Fold m a' b)
 -> DemuxState s c (Map k b) (Map k (Fold m a' b)))
-> (Map k b
    -> Step
         (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
-> Map k b
-> Map k (Fold m a' b)
-> Fold m a' b
-> k
-> a'
-> m (Step
        (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
forall (m :: * -> *) p b a s b.
(Monad m, Ord p) =>
(Map p b -> Map p (Fold m a b) -> s)
-> (Map p b -> Step s b)
-> Map p b
-> Map p (Fold m a b)
-> Fold m a b
-> p
-> a
-> m (Step s b)
runFold
                    (s
-> Map k b
-> Map k (Fold m a' b)
-> DemuxState s c (Map k b) (Map k (Fold m a' b))
forall s b doneMap runMap.
s -> doneMap -> runMap -> DemuxState s b doneMap runMap
DemuxMapAndDefault s
dacc)
                    (DemuxState s c (Map k b) (Map k (Fold m a' b))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall s b. s -> Step s b
Partial (DemuxState s c (Map k b) (Map k (Fold m a' b))
 -> Step
      (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
-> (Map k b -> DemuxState s c (Map k b) (Map k (Fold m a' b)))
-> Map k b
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Map k b -> DemuxState s c (Map k b) (Map k (Fold m a' b))
forall s b doneMap runMap.
s -> doneMap -> DemuxState s b doneMap runMap
DemuxOnlyDefault s
dacc)
                    Map k b
doneMap Map k (Fold m a' b)
runMap Fold m a' b
fld k
k a'
a1

    step (DemuxOnlyMap c
dval Map k b
doneMap Map k (Fold m a' b)
runMap) a
a = do
        let (k
k, a'
a1) = a -> (k, a')
f a
a
        case k -> Map k (Fold m a' b) -> Maybe (Fold m a' b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k (Fold m a' b)
runMap of
            Maybe (Fold m a' b)
Nothing -> Step (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
-> m (Step
        (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
 -> m (Step
         (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
-> m (Step
        (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
forall a b. (a -> b) -> a -> b
$ DemuxState s c (Map k b) (Map k (Fold m a' b))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall s b. s -> Step s b
Partial (DemuxState s c (Map k b) (Map k (Fold m a' b))
 -> Step
      (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
-> DemuxState s c (Map k b) (Map k (Fold m a' b))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall a b. (a -> b) -> a -> b
$ c
-> Map k b
-> Map k (Fold m a' b)
-> DemuxState s c (Map k b) (Map k (Fold m a' b))
forall s b doneMap runMap.
b -> doneMap -> runMap -> DemuxState s b doneMap runMap
DemuxOnlyMap c
dval Map k b
doneMap Map k (Fold m a' b)
runMap
            Just Fold m a' b
fld ->
                (Map k b
 -> Map k (Fold m a' b)
 -> DemuxState s c (Map k b) (Map k (Fold m a' b)))
-> (Map k b
    -> Step
         (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
-> Map k b
-> Map k (Fold m a' b)
-> Fold m a' b
-> k
-> a'
-> m (Step
        (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
forall (m :: * -> *) p b a s b.
(Monad m, Ord p) =>
(Map p b -> Map p (Fold m a b) -> s)
-> (Map p b -> Step s b)
-> Map p b
-> Map p (Fold m a b)
-> Fold m a b
-> p
-> a
-> m (Step s b)
runFold
                    (c
-> Map k b
-> Map k (Fold m a' b)
-> DemuxState s c (Map k b) (Map k (Fold m a' b))
forall s b doneMap runMap.
b -> doneMap -> runMap -> DemuxState s b doneMap runMap
DemuxOnlyMap c
dval)
                    ((Map k b, c)
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall s b. b -> Step s b
Done ((Map k b, c)
 -> Step
      (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
-> (Map k b -> (Map k b, c))
-> Map k b
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, c
dval))
                    Map k b
doneMap Map k (Fold m a' b)
runMap Fold m a' b
fld k
k a'
a1
    step (DemuxOnlyDefault s
dacc Map k b
doneMap) a
a = do
        let (k
k, a'
a1) = a -> (k, a')
f a
a
        Step s c
res <- s -> (k, a') -> m (Step s c)
dstep s
dacc (k
k, a'
a1)
        Step (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
-> m (Step
        (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
 -> m (Step
         (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
-> m (Step
        (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
forall a b. (a -> b) -> a -> b
$ case Step s c
res of
                  Partial s
s -> DemuxState s c (Map k b) (Map k (Fold m a' b))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall s b. s -> Step s b
Partial (DemuxState s c (Map k b) (Map k (Fold m a' b))
 -> Step
      (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c))
-> DemuxState s c (Map k b) (Map k (Fold m a' b))
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall a b. (a -> b) -> a -> b
$ s -> Map k b -> DemuxState s c (Map k b) (Map k (Fold m a' b))
forall s b doneMap runMap.
s -> doneMap -> DemuxState s b doneMap runMap
DemuxOnlyDefault s
s Map k b
doneMap
                  Done c
b -> (Map k b, c)
-> Step
     (DemuxState s c (Map k b) (Map k (Fold m a' b))) (Map k b, c)
forall s b. b -> Step s b
Done (Map k b
doneMap, c
b)

    runExtract :: Fold m a b -> m b
runExtract (Fold s -> a -> m (Step s b)
_ m (Step s b)
initial1 s -> m b
done1) = do
        Step s b
res <- m (Step s b)
initial1
        case Step s b
res of
            Partial s
s -> s -> m b
done1 s
s
            Done b
b -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

    extract :: DemuxState s c (Map k a) (Map k (Fold m a a)) -> m (Map k a, c)
extract (DemuxMapAndDefault s
dacc Map k a
doneMap Map k (Fold m a a)
runMap) = do
        c
b <- s -> m c
dextract s
dacc
        Map k a
runMap1 <- (Fold m a a -> m a) -> Map k (Fold m a a) -> m (Map k a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Prelude.mapM Fold m a a -> m a
forall (m :: * -> *) a b. Monad m => Fold m a b -> m b
runExtract Map k (Fold m a a)
runMap
        (Map k a, c) -> m (Map k a, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k a
doneMap Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map k a
runMap1, c
b)
    extract (DemuxOnlyMap c
dval Map k a
doneMap Map k (Fold m a a)
runMap) = do
        Map k a
runMap1 <- (Fold m a a -> m a) -> Map k (Fold m a a) -> m (Map k a)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Prelude.mapM Fold m a a -> m a
forall (m :: * -> *) a b. Monad m => Fold m a b -> m b
runExtract Map k (Fold m a a)
runMap
        (Map k a, c) -> m (Map k a, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k a
doneMap Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map k a
runMap1, c
dval)
    extract (DemuxOnlyDefault s
dacc Map k a
doneMap) = do
        c
b <- s -> m c
dextract s
dacc
        (Map k a, c) -> m (Map k a, c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k a
doneMap, c
b)

-- |
-- > demuxDefault = demuxDefaultWith id
--
-- /Pre-release/
{-# INLINE demuxDefault #-}
demuxDefault :: (Monad m, Ord k)
    => Map k (Fold m a b) -> Fold m (k, a) b -> Fold m (k, a) (Map k b, b)
demuxDefault :: Map k (Fold m a b) -> Fold m (k, a) b -> Fold m (k, a) (Map k b, b)
demuxDefault = ((k, a) -> (k, a))
-> Map k (Fold m a b)
-> Fold m (k, a) b
-> Fold m (k, a) (Map k b, b)
forall (m :: * -> *) k a a' b c.
(Monad m, Ord k) =>
(a -> (k, a'))
-> Map k (Fold m a' b) -> Fold m (k, a') c -> Fold m a (Map k b, c)
demuxDefaultWith (k, a) -> (k, a)
forall a. a -> a
id

-- TODO If the data is large we may need a map/hashmap in pinned memory instead
-- of a regular Map. That may require a serializable constraint though. We can
-- have another API for that.
--
-- | Split the input stream based on a key field and fold each split using the
-- given fold. Useful for map/reduce, bucketizing the input in different bins
-- or for generating histograms.
--
-- >>> :{
--  let input = Stream.fromList [("ONE",1),("ONE",1.1),("TWO",2), ("TWO",2.2)]
--   in Stream.fold (Fold.classifyWith fst (Fold.map snd Fold.toList)) input
-- :}
-- fromList [("ONE",[1.0,1.1]),("TWO",[2.0,2.2])]
--
-- If the classifier fold stops for a particular key any further inputs in that
-- bucket are ignored.
--
-- /Stops: never/
--
-- /Pre-release/
--
{-# INLINE classifyWith #-}
classifyWith :: (Monad m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (Map k b)
classifyWith :: (a -> k) -> Fold m a b -> Fold m a (Map k b)
classifyWith a -> k
f (Fold s -> a -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1) =
    (Map k (Either' s b) -> m (Map k b))
-> Fold m a (Map k (Either' s b)) -> Fold m a (Map k b)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Fold m a b -> Fold m a c
rmapM Map k (Either' s b) -> m (Map k b)
extract (Fold m a (Map k (Either' s b)) -> Fold m a (Map k b))
-> Fold m a (Map k (Either' s b)) -> Fold m a (Map k b)
forall a b. (a -> b) -> a -> b
$ (Map k (Either' s b) -> a -> m (Map k (Either' s b)))
-> m (Map k (Either' s b)) -> Fold m a (Map k (Either' s b))
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
foldlM' Map k (Either' s b) -> a -> m (Map k (Either' s b))
step m (Map k (Either' s b))
forall k a. m (Map k a)
initial

    where

    initial :: m (Map k a)
initial = Map k a -> m (Map k a)
forall (m :: * -> *) a. Monad m => a -> m a
return Map k a
forall k a. Map k a
Map.empty

    step :: Map k (Either' s b) -> a -> m (Map k (Either' s b))
step Map k (Either' s b)
kv a
a =
        case k -> Map k (Either' s b) -> Maybe (Either' s b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k (Either' s b)
kv of
            Maybe (Either' s b)
Nothing -> do
                Step s b
x <- m (Step s b)
initial1
                case Step s b
x of
                      Partial s
s -> do
                        Step s b
r <- s -> a -> m (Step s b)
step1 s
s a
a
                        Map k (Either' s b) -> m (Map k (Either' s b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                            (Map k (Either' s b) -> m (Map k (Either' s b)))
-> Map k (Either' s b) -> m (Map k (Either' s b))
forall a b. (a -> b) -> a -> b
$ (Either' s b -> Map k (Either' s b) -> Map k (Either' s b))
-> Map k (Either' s b) -> Either' s b -> Map k (Either' s b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> Either' s b -> Map k (Either' s b) -> Map k (Either' s b)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k) Map k (Either' s b)
kv
                            (Either' s b -> Map k (Either' s b))
-> Either' s b -> Map k (Either' s b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
                                  Partial s
s1 -> s -> Either' s b
forall a b. a -> Either' a b
Left' s
s1
                                  Done b
b -> b -> Either' s b
forall a b. b -> Either' a b
Right' b
b
                      Done b
b -> Map k (Either' s b) -> m (Map k (Either' s b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k (Either' s b) -> m (Map k (Either' s b)))
-> Map k (Either' s b) -> m (Map k (Either' s b))
forall a b. (a -> b) -> a -> b
$ k -> Either' s b -> Map k (Either' s b) -> Map k (Either' s b)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k (b -> Either' s b
forall a b. b -> Either' a b
Right' b
b) Map k (Either' s b)
kv
            Just Either' s b
x -> do
                case Either' s b
x of
                    Left' s
s -> do
                        Step s b
r <- s -> a -> m (Step s b)
step1 s
s a
a
                        Map k (Either' s b) -> m (Map k (Either' s b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                            (Map k (Either' s b) -> m (Map k (Either' s b)))
-> Map k (Either' s b) -> m (Map k (Either' s b))
forall a b. (a -> b) -> a -> b
$ (Either' s b -> Map k (Either' s b) -> Map k (Either' s b))
-> Map k (Either' s b) -> Either' s b -> Map k (Either' s b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> Either' s b -> Map k (Either' s b) -> Map k (Either' s b)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k) Map k (Either' s b)
kv
                            (Either' s b -> Map k (Either' s b))
-> Either' s b -> Map k (Either' s b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
                                  Partial s
s1 -> s -> Either' s b
forall a b. a -> Either' a b
Left' s
s1
                                  Done b
b -> b -> Either' s b
forall a b. b -> Either' a b
Right' b
b
                    Right' b
_ -> Map k (Either' s b) -> m (Map k (Either' s b))
forall (m :: * -> *) a. Monad m => a -> m a
return Map k (Either' s b)
kv

        where

        k :: k
k = a -> k
f a
a

    extract :: Map k (Either' s b) -> m (Map k b)
extract =
        (Either' s b -> m b) -> Map k (Either' s b) -> m (Map k b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Prelude.mapM
            (\case
                 Left' s
s -> s -> m b
extract1 s
s
                 Right' b
b -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b)

-- | Given an input stream of key value pairs and a fold for values, fold all
-- the values belonging to each key.  Useful for map/reduce, bucketizing the
-- input in different bins or for generating histograms.
--
-- >>> :{
--  let input = Stream.fromList [("ONE",1),("ONE",1.1),("TWO",2), ("TWO",2.2)]
--   in Stream.fold (Fold.classify Fold.toList) input
-- :}
-- fromList [("ONE",[1.0,1.1]),("TWO",[2.0,2.2])]
--
-- Same as:
--
-- > classify fld = Fold.classifyWith fst (map snd fld)
--
-- /Pre-release/
{-# INLINE classify #-}
classify :: (Monad m, Ord k) => Fold m a b -> Fold m (k, a) (Map k b)
classify :: Fold m a b -> Fold m (k, a) (Map k b)
classify Fold m a b
fld = ((k, a) -> k) -> Fold m (k, a) b -> Fold m (k, a) (Map k b)
forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k) -> Fold m a b -> Fold m a (Map k b)
classifyWith (k, a) -> k
forall a b. (a, b) -> a
fst (((k, a) -> a) -> Fold m a b -> Fold m (k, a) b
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
map (k, a) -> a
forall a b. (a, b) -> b
snd Fold m a b
fld)

------------------------------------------------------------------------------
-- Unzipping
------------------------------------------------------------------------------

-- | Like 'unzipWith' but with a monadic splitter function.
--
-- @unzipWithM k f1 f2 = lmapM k (unzip f1 f2)@
--
-- /Pre-release/
{-# INLINE unzipWithM #-}
unzipWithM :: Monad m
    => (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
unzipWithM :: (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
unzipWithM a -> m (b, c)
f (Fold s -> b -> m (Step s x)
stepL m (Step s x)
beginL s -> m x
doneL) (Fold s -> c -> m (Step s y)
stepR m (Step s y)
beginR s -> m y
doneR) =
    (GenericRunner s s x y
 -> a -> m (Step (GenericRunner s s x y) (x, y)))
-> m (Step (GenericRunner s s x y) (x, y))
-> (GenericRunner s s x y -> m (x, y))
-> Fold m a (x, y)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> Fold m a b
Fold GenericRunner s s x y
-> a -> m (Step (GenericRunner s s x y) (x, y))
step m (Step (GenericRunner s s x y) (x, y))
begin GenericRunner s s x y -> m (x, y)
done

    where

    begin :: m (Step (GenericRunner s s x y) (x, y))
begin = do
        Step s x
resL <- m (Step s x)
beginL
        Step s y
resR <- m (Step s y)
beginR
        Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (GenericRunner s s x y) (x, y)
 -> m (Step (GenericRunner s s x y) (x, y)))
-> Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall a b. (a -> b) -> a -> b
$ case Step s x
resL of
                  Partial s
sL ->
                      GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall s b. s -> Step s b
Partial
                          (GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y))
-> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall a b. (a -> b) -> a -> b
$ case Step s y
resR of
                                Partial s
sR -> s -> s -> GenericRunner s s x y
forall sL sR bL bR. sL -> sR -> GenericRunner sL sR bL bR
RunBoth s
sL s
sR
                                Done y
bR -> s -> y -> GenericRunner s s x y
forall sL sR bL bR. sL -> bR -> GenericRunner sL sR bL bR
RunLeft s
sL y
bR
                  Done x
bL ->
                      case Step s y
resR of
                          Partial s
sR -> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall s b. s -> Step s b
Partial (GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y))
-> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall a b. (a -> b) -> a -> b
$ x -> s -> GenericRunner s s x y
forall sL sR bL bR. bL -> sR -> GenericRunner sL sR bL bR
RunRight x
bL s
sR
                          Done y
bR -> (x, y) -> Step (GenericRunner s s x y) (x, y)
forall s b. b -> Step s b
Done (x
bL, y
bR)

    step :: GenericRunner s s x y
-> a -> m (Step (GenericRunner s s x y) (x, y))
step (RunBoth s
sL s
sR) a
a = do
        (b
b, c
c) <- a -> m (b, c)
f a
a
        Step s x
resL <- s -> b -> m (Step s x)
stepL s
sL b
b
        Step s y
resR <- s -> c -> m (Step s y)
stepR s
sR c
c
        case Step s x
resL of
            Partial s
sresL ->
                Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step (GenericRunner s s x y) (x, y)
 -> m (Step (GenericRunner s s x y) (x, y)))
-> Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall a b. (a -> b) -> a -> b
$ GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall s b. s -> Step s b
Partial
                    (GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y))
-> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall a b. (a -> b) -> a -> b
$ case Step s y
resR of
                          Partial s
sresR -> s -> s -> GenericRunner s s x y
forall sL sR bL bR. sL -> sR -> GenericRunner sL sR bL bR
RunBoth s
sresL s
sresR
                          Done y
bresR -> s -> y -> GenericRunner s s x y
forall sL sR bL bR. sL -> bR -> GenericRunner sL sR bL bR
RunLeft s
sresL y
bresR
            Done x
bresL ->
                Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step (GenericRunner s s x y) (x, y)
 -> m (Step (GenericRunner s s x y) (x, y)))
-> Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall a b. (a -> b) -> a -> b
$ case Step s y
resR of
                          Partial s
sresR -> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall s b. s -> Step s b
Partial (GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y))
-> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall a b. (a -> b) -> a -> b
$ x -> s -> GenericRunner s s x y
forall sL sR bL bR. bL -> sR -> GenericRunner sL sR bL bR
RunRight x
bresL s
sresR
                          Done y
bresR -> (x, y) -> Step (GenericRunner s s x y) (x, y)
forall s b. b -> Step s b
Done (x
bresL, y
bresR)
    step (RunLeft s
sL y
bR) a
a = do
        (b
b, c
_) <- a -> m (b, c)
f a
a
        Step s x
resL <- s -> b -> m (Step s x)
stepL s
sL b
b
        Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (GenericRunner s s x y) (x, y)
 -> m (Step (GenericRunner s s x y) (x, y)))
-> Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall a b. (a -> b) -> a -> b
$ case Step s x
resL of
                  Partial s
sresL -> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall s b. s -> Step s b
Partial (GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y))
-> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall a b. (a -> b) -> a -> b
$ s -> y -> GenericRunner s s x y
forall sL sR bL bR. sL -> bR -> GenericRunner sL sR bL bR
RunLeft s
sresL y
bR
                  Done x
bresL -> (x, y) -> Step (GenericRunner s s x y) (x, y)
forall s b. b -> Step s b
Done (x
bresL, y
bR)
    step (RunRight x
bL s
sR) a
a = do
        (b
_, c
c) <- a -> m (b, c)
f a
a
        Step s y
resR <- s -> c -> m (Step s y)
stepR s
sR c
c
        Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (GenericRunner s s x y) (x, y)
 -> m (Step (GenericRunner s s x y) (x, y)))
-> Step (GenericRunner s s x y) (x, y)
-> m (Step (GenericRunner s s x y) (x, y))
forall a b. (a -> b) -> a -> b
$ case Step s y
resR of
                  Partial s
sresR -> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall s b. s -> Step s b
Partial (GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y))
-> GenericRunner s s x y -> Step (GenericRunner s s x y) (x, y)
forall a b. (a -> b) -> a -> b
$ x -> s -> GenericRunner s s x y
forall sL sR bL bR. bL -> sR -> GenericRunner sL sR bL bR
RunRight x
bL s
sresR
                  Done y
bresR -> (x, y) -> Step (GenericRunner s s x y) (x, y)
forall s b. b -> Step s b
Done (x
bL, y
bresR)

    done :: GenericRunner s s x y -> m (x, y)
done (RunBoth s
sL s
sR) = (,) (x -> y -> (x, y)) -> m x -> m (y -> (x, y))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m x
doneL s
sL m (y -> (x, y)) -> m y -> m (x, y)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m y
doneR s
sR
    done (RunLeft s
sL y
bR) = (,y
bR) (x -> (x, y)) -> m x -> m (x, y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m x
doneL s
sL
    done (RunRight x
bL s
sR) = (x
bL,) (y -> (x, y)) -> m y -> m (x, y)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m y
doneR s
sR

-- | Similar to 'unzipWithM' but terminates when the first fold terminates.
--
-- /Unimplemented/
--
{-# INLINE unzipWithFstM #-}
unzipWithFstM :: -- Monad m =>
     (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
unzipWithFstM :: (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
unzipWithFstM = (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
forall a. HasCallStack => a
undefined

-- | Similar to 'unzipWithM' but terminates when any fold terminates.
--
-- /Unimplemented/
--
{-# INLINE unzipWithMinM #-}
unzipWithMinM :: -- Monad m =>
     (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
unzipWithMinM :: (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
unzipWithMinM = (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
forall a. HasCallStack => a
undefined

-- | Split elements in the input stream into two parts using a pure splitter
-- function, direct each part to a different fold and zip the results.
--
-- @unzipWith f fld1 fld2 = Fold.lmap f (Fold.unzip fld1 fld2)@
--
-- This fold terminates when both the input folds terminate.
--
-- /Pre-release/
{-# INLINE unzipWith #-}
unzipWith :: Monad m
    => (a -> (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
unzipWith :: (a -> (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
unzipWith a -> (b, c)
f = (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
forall (m :: * -> *) a b c x y.
Monad m =>
(a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
unzipWithM ((b, c) -> m (b, c)
forall (m :: * -> *) a. Monad m => a -> m a
return ((b, c) -> m (b, c)) -> (a -> (b, c)) -> a -> m (b, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> (b, c)
f)

-- | Send the elements of tuples in a stream of tuples through two different
-- folds.
--
-- @
--
--                           |-------Fold m a x--------|
-- ---------stream of (a,b)--|                         |----m (x,y)
--                           |-------Fold m b y--------|
--
-- @
--
-- > unzip = Fold.unzipWith id
--
-- This is the consumer side dual of the producer side 'zip' operation.
--
-- @since 0.7.0
{-# INLINE unzip #-}
unzip :: Monad m => Fold m a x -> Fold m b y -> Fold m (a,b) (x,y)
unzip :: Fold m a x -> Fold m b y -> Fold m (a, b) (x, y)
unzip = ((a, b) -> (a, b))
-> Fold m a x -> Fold m b y -> Fold m (a, b) (x, y)
forall (m :: * -> *) a b c x y.
Monad m =>
(a -> (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
unzipWith (a, b) -> (a, b)
forall a. a -> a
id

------------------------------------------------------------------------------
-- Combining streams and folds - Zipping
------------------------------------------------------------------------------

-- | Zip a stream with the input of a fold using the supplied function.
--
-- /Unimplemented/
--
{-# INLINE zipWithM #-}
zipWithM :: -- Monad m =>
    (a -> b -> m c) -> t m a -> Fold m c x -> Fold m b x
zipWithM :: (a -> b -> m c) -> t m a -> Fold m c x -> Fold m b x
zipWithM = (a -> b -> m c) -> t m a -> Fold m c x -> Fold m b x
forall a. HasCallStack => a
undefined

-- | Zip a stream with the input of a fold.
--
-- /Unimplemented/
--
{-# INLINE zip #-}
zip :: Monad m => t m a -> Fold m (a, b) x -> Fold m b x
zip :: t m a -> Fold m (a, b) x -> Fold m b x
zip = (a -> b -> m (a, b)) -> t m a -> Fold m (a, b) x -> Fold m b x
forall a b (m :: * -> *) c (t :: (* -> *) -> * -> *) x.
(a -> b -> m c) -> t m a -> Fold m c x -> Fold m b x
zipWithM (((a, b) -> m (a, b)) -> a -> b -> m (a, b)
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return)

-- | Pair each element of a fold input with its index, starting from index 0.
--
-- /Unimplemented/
{-# INLINE indexed #-}
indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Fold m a b
indexed :: Fold m (Int, a) b -> Fold m a b
indexed = SerialT m Int -> Fold m (Int, a) b -> Fold m a b
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a b x.
Monad m =>
t m a -> Fold m (a, b) x -> Fold m b x
zip (Int -> SerialT m Int
forall a (t :: (* -> *) -> * -> *) (m :: * -> *).
(Enumerable a, IsStream t, Monad m) =>
a -> t m a
Stream.enumerateFrom Int
0 :: SerialT m Int)

-- | Change the predicate function of a Fold from @a -> b@ to accept an
-- additional state input @(s, a) -> b@. Convenient to filter with an
-- addiitonal index or time input.
--
-- @
-- filterWithIndex = with indexed filter
-- filterWithAbsTime = with timestamped filter
-- filterWithRelTime = with timeIndexed filter
-- @
--
-- /Pre-release/
{-# INLINE with #-}
with ::
       (Fold m (s, a) b -> Fold m a b)
    -> (((s, a) -> c) -> Fold m (s, a) b -> Fold m (s, a) b)
    -> (((s, a) -> c) -> Fold m a b -> Fold m a b)
with :: (Fold m (s, a) b -> Fold m a b)
-> (((s, a) -> c) -> Fold m (s, a) b -> Fold m (s, a) b)
-> ((s, a) -> c)
-> Fold m a b
-> Fold m a b
with Fold m (s, a) b -> Fold m a b
f ((s, a) -> c) -> Fold m (s, a) b -> Fold m (s, a) b
comb (s, a) -> c
g = Fold m (s, a) b -> Fold m a b
f (Fold m (s, a) b -> Fold m a b)
-> (Fold m a b -> Fold m (s, a) b) -> Fold m a b -> Fold m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((s, a) -> c) -> Fold m (s, a) b -> Fold m (s, a) b
comb (s, a) -> c
g (Fold m (s, a) b -> Fold m (s, a) b)
-> (Fold m a b -> Fold m (s, a) b) -> Fold m a b -> Fold m (s, a) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((s, a) -> a) -> Fold m a b -> Fold m (s, a) b
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
map (s, a) -> a
forall a b. (a, b) -> b
snd

-- | @sampleFromthen offset stride@ samples the element at @offset@ index and
-- then every element at strides of @stride@.
--
-- /Unimplemented/
{-# INLINE sampleFromthen #-}
sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Fold m a b
sampleFromthen :: Int -> Int -> Fold m a b -> Fold m a b
sampleFromthen Int
offset Int
size =
    (Fold m (Int, a) b -> Fold m a b)
-> (((Int, a) -> Bool) -> Fold m (Int, a) b -> Fold m (Int, a) b)
-> ((Int, a) -> Bool)
-> Fold m a b
-> Fold m a b
forall (m :: * -> *) s a b c.
(Fold m (s, a) b -> Fold m a b)
-> (((s, a) -> c) -> Fold m (s, a) b -> Fold m (s, a) b)
-> ((s, a) -> c)
-> Fold m a b
-> Fold m a b
with Fold m (Int, a) b -> Fold m a b
forall (m :: * -> *) a b.
Monad m =>
Fold m (Int, a) b -> Fold m a b
indexed ((Int, a) -> Bool) -> Fold m (Int, a) b -> Fold m (Int, a) b
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Fold m a r -> Fold m a r
filter (\(Int
i, a
_) -> (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
offset) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
size Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)

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

-- | @concatSequence f t@ applies folds from stream @t@ sequentially and
-- collects the results using the fold @f@.
--
-- /Unimplemented/
--
{-# INLINE concatSequence #-}
concatSequence ::
    -- IsStream t =>
    Fold m b c -> t (Fold m a b) -> Fold m a c
concatSequence :: Fold m b c -> t (Fold m a b) -> Fold m a c
concatSequence Fold m b c
_f t (Fold m a b)
_p = Fold m a c
forall a. HasCallStack => a
undefined

-- | Group the input stream into groups of elements between @low@ and @high@.
-- Collection starts in chunks of @low@ and then keeps doubling until we reach
-- @high@. Each chunk is folded using the provided fold function.
--
-- This could be useful, for example, when we are folding a stream of unknown
-- size to a stream of arrays and we want to minimize the number of
-- allocations.
--
-- NOTE: this would be an application of "many" using a terminating fold.
--
-- /Unimplemented/
--
{-# INLINE chunksBetween #-}
chunksBetween :: -- Monad m =>
       Int -> Int -> Fold m a b -> Fold m b c -> Fold m a c
chunksBetween :: Int -> Int -> Fold m a b -> Fold m b c -> Fold m a c
chunksBetween Int
_low Int
_high Fold m a b
_f1 Fold m b c
_f2 = Fold m a c
forall a. HasCallStack => a
undefined

-- | A fold that buffers its input to a pure stream.
--
-- /Warning!/ working on large streams accumulated as buffers in memory could
-- be very inefficient, consider using "Streamly.Data.Array" instead.
--
-- > toStream = foldr K.cons K.nil
--
-- /Pre-release/
{-# INLINE toStream #-}
toStream :: Monad m => Fold m a (SerialT Identity a)
toStream :: Fold m a (SerialT Identity a)
toStream = (a -> SerialT Identity a -> SerialT Identity a)
-> SerialT Identity a -> Fold m a (SerialT Identity a)
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> Fold m a b
foldr a -> SerialT Identity a -> SerialT Identity a
forall (t :: (* -> *) -> * -> *) a (m :: * -> *).
IsStream t =>
a -> t m a -> t m a
K.cons SerialT Identity a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
IsStream t =>
t m a
K.nil

-- This is more efficient than 'toStream'. toStream is exactly the same as
-- reversing the stream after toStreamRev.
--
-- | Buffers the input stream to a pure stream in the reverse order of the
-- input.
--
-- > toStreamRev = foldl' (flip K.cons) K.nil
--
-- /Warning!/ working on large streams accumulated as buffers in memory could
-- be very inefficient, consider using "Streamly.Data.Array" instead.
--
-- /Pre-release/

--  xn : ... : x2 : x1 : []
{-# INLINABLE toStreamRev #-}
toStreamRev :: Monad m => Fold m a (SerialT Identity a)
toStreamRev :: Fold m a (SerialT Identity a)
toStreamRev = (SerialT Identity a -> a -> SerialT Identity a)
-> SerialT Identity a -> Fold m a (SerialT Identity a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' ((a -> SerialT Identity a -> SerialT Identity a)
-> SerialT Identity a -> a -> SerialT Identity a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> SerialT Identity a -> SerialT Identity a
forall (t :: (* -> *) -> * -> *) a (m :: * -> *).
IsStream t =>
a -> t m a -> t m a
K.cons) SerialT Identity a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
IsStream t =>
t m a
K.nil