{-# LANGUAGE BangPatterns              #-}
{-# LANGUAGE CPP                       #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE RankNTypes                #-}
{-# LANGUAGE RecordWildCards           #-}
{-# LANGUAGE ScopedTypeVariables       #-}

-- |
-- Module      : Streamly.Internal.Data.Fold
-- Copyright   : (c) 2019 Composewell Technologies
--               (c) 2013 Gabriel Gonzalez
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC

-- Also see the "Streamly.Internal.Data.Sink" module that provides specialized left folds
-- that discard the outputs.
--
-- IMPORTANT: keep the signatures consistent with the folds in Streamly.Prelude

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

    , hoist
    , generally

    -- , tail
    -- , init

    -- * Fold Creation Utilities
    , mkPure
    , mkPureId
    , mkFold
    , mkFoldId

    -- ** Full Folds
    , drain
    , drainBy
    , drainBy2
    , last
    , length
    , sum
    , product
    , maximumBy
    , maximum
    , minimumBy
    , minimum
    -- , the
    , mean
    , variance
    , stdDev
    , rollingHash
    , rollingHashWithSalt
    , rollingHashFirstN
    -- , rollingHashLastN

    -- ** Full Folds (Monoidal)
    , mconcat
    , foldMap
    , foldMapM

    -- ** Full Folds (To Containers)

    , toList
    , toListRevF  -- experimental

    -- ** Partial Folds
    , drainN
    , drainWhile
    -- , lastN
    -- , (!!)
    -- , genericIndex
    , index
    , head
    -- , findM
    , find
    , lookup
    , findIndex
    , elemIndex
    , null
    , elem
    , notElem
    -- XXX these are slower than right folds even when full input is used
    , all
    , any
    , and
    , or

    -- * Transformations

    -- ** Covariant Operations
    , sequence
    , mapM

    -- ** Mapping
    , transform
    , lmap
    --, lsequence
    , lmapM
    -- ** Filtering
    , lfilter
    , lfilterM
    -- , ldeleteBy
    -- , luniq
    , lcatMaybes

    {-
    -- ** Mapping Filters
    , lmapMaybe
    , lmapMaybeM

    -- ** Scanning Filters
    , lfindIndices
    , lelemIndices

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

    , linsertBy
    , lintersperseM

    -- ** Reordering
    , lreverse
    -}

    -- * Parsing
    -- ** Trimming
    , ltake
    -- , lrunFor -- time
    , ltakeWhile
    {-
    , ltakeWhileM
    , ldrop
    , ldropWhile
    , ldropWhileM
    -}

    , lsessionsOf
    , lchunksOf

    -- ** Breaking

    -- Binary
    , splitAt -- spanN
    -- , splitIn -- sessionN

    -- By elements
    , span  -- spanWhile
    , break -- breakBefore
    -- , breakAfter
    -- , breakOn
    -- , breakAround
    , spanBy
    , spanByRolling

    -- By sequences
    -- , breakOnSeq
    -- , breakOnStream -- on a stream

    -- * Distributing

    , tee
    , distribute
    , distribute_

    -- * Partitioning

    -- , partitionByM
    -- , partitionBy
    , partition

    -- * Demultiplexing

    , demux
    -- , demuxWith
    , demux_
    , demuxDefault_
    -- , demuxWith_
    , demuxWithDefault_

    -- * Classifying

    , classify
    -- , classifyWith

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

    -- * Nested Folds
    -- , concatMap
    , foldChunks
    , duplicate

    -- * Running Folds
    , initialize
    , runStep

    -- * Folding to SVar
    , toParallelSVar
    , toParallelSVarLimited
    )
where

import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Functor.Identity (Identity(..))
import Data.Int (Int64)
import Data.Map.Strict (Map)

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

import qualified Data.Map.Strict as Map
import qualified Prelude

import Streamly.Internal.Data.Pipe.Types (Pipe (..), PipeState(..))
import Streamly.Internal.Data.Fold.Types
import Streamly.Internal.Data.Strict
import Streamly.Internal.Data.SVar

import qualified Streamly.Internal.Data.Pipe.Types as Pipe

------------------------------------------------------------------------------
-- Smart constructors
------------------------------------------------------------------------------

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

-- | Make a fold using a pure step function and a pure initial state. The
-- final state extracted is identical to the intermediate state.
--
-- /Internal/
--
{-# INLINE mkPureId #-}
mkPureId :: Monad m => (b -> a -> b) -> b -> Fold m a b
mkPureId :: forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
mkPureId b -> a -> b
step b
initial = forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> s) -> s -> (s -> b) -> Fold m a b
mkPure b -> a -> b
step b
initial forall a. a -> a
id

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

-- | Make a fold with an effectful step function and initial state.  The final
-- state extracted is identical to the intermediate state.
--
-- /Internal/
--
{-# INLINE mkFoldId #-}
mkFoldId :: Monad m => (b -> a -> m b) -> m b -> Fold m a b
mkFoldId :: forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> Fold m a b
mkFoldId b -> a -> m b
step m b
initial = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold b -> a -> m b
step m b
initial forall (m :: * -> *) a. Monad m => a -> m a
return

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

-- | Change the underlying monad of a fold
--
-- /Internal/
hoist :: (forall x. m x -> n x) -> Fold m a b -> Fold n a b
hoist :: forall (m :: * -> *) (n :: * -> *) a b.
(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 s
step m s
initial s -> m b
extract) =
    forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\s
x a
a -> forall x. m x -> n x
f forall a b. (a -> b) -> a -> b
$ s -> a -> m s
step s
x a
a) (forall x. m x -> n x
f m s
initial) (forall x. m x -> n x
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m b
extract)

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

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

-- | Flatten the monadic output of a fold to pure output.
--
-- @since 0.7.0
{-# INLINE sequence #-}
sequence :: Monad m => Fold m a (m b) -> Fold m a b
sequence :: forall (m :: * -> *) a b. Monad m => Fold m a (m b) -> Fold m a b
sequence (Fold s -> a -> m s
step m s
initial s -> m (m b)
extract) = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold s -> a -> m s
step m s
initial s -> m b
extract'
  where
    extract' :: s -> m b
extract' s
x = do
        m b
act <- s -> m (m b)
extract s
x
        m b
act forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Map a monadic function on the output of a fold.
--
-- @since 0.7.0
{-# INLINE mapM #-}
mapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c
mapM :: forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Fold m a b -> Fold m a c
mapM b -> m c
f = forall (m :: * -> *) a b. Monad m => Fold m a (m b) -> Fold m a b
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> m c
f

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

-- rename to lpipe?
--
-- | Apply a transformation on a 'Fold' using a 'Pipe'.
--
-- @since 0.7.0
{-# INLINE transform #-}
transform :: Monad m => Pipe m a b -> Fold m b c -> Fold m a c
transform :: forall (m :: * -> *) a b c.
Monad m =>
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 s
fstep m s
finitial s -> m c
fextract) =
    forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Tuple' s1 s -> a -> m (Tuple' s1 s)
step m (Tuple' s1 s)
initial forall {a}. Tuple' a s -> m c
extract

    where

    initial :: m (Tuple' s1 s)
initial = forall a b. a -> b -> Tuple' a b
Tuple' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Monad m => a -> m a
return s1
pinitial forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m s
finitial
    step :: Tuple' s1 s -> a -> m (Tuple' s1 s)
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 (Tuple' s1 s)
go s
fs Step (PipeState s1 s2) b
r

        where
        -- XXX use SPEC?
        go :: s -> Step (PipeState s1 s2) b -> m (Tuple' s1 s)
go s
acc (Pipe.Yield b
b (Consume s1
ps')) = do
            s
acc' <- s -> b -> m s
fstep s
acc b
b
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Tuple' a b
Tuple' s1
ps' s
acc')

        go s
acc (Pipe.Yield b
b (Produce s2
ps')) = do
            s
acc' <- s -> b -> m s
fstep s
acc b
b
            Step (PipeState s1 s2) b
r <- s2 -> m (Step (PipeState s1 s2) b)
pstep2 s2
ps'
            s -> Step (PipeState s1 s2) b -> m (Tuple' s1 s)
go s
acc' Step (PipeState s1 s2) b
r

        go s
acc (Pipe.Continue (Consume s1
ps')) = forall (m :: * -> *) a. Monad m => a -> m a
return (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 (Tuple' s1 s)
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

------------------------------------------------------------------------------
-- Utilities
------------------------------------------------------------------------------

-- | @_Fold1 step@ returns a new 'Fold' using just a step function that has the
-- same type for the accumulator and the element. The result type is the
-- accumulator type wrapped in 'Maybe'. The initial accumulator is retrieved
-- from the 'Foldable', the result is 'None' for empty containers.
{-# INLINABLE _Fold1 #-}
_Fold1 :: Monad m => (a -> a -> a) -> Fold m a (Maybe a)
_Fold1 :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
_Fold1 a -> a -> a
step = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *}. Monad m => Maybe' a -> a -> m (Maybe' a)
step_ (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe' a
Nothing') (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe' a -> Maybe a
toMaybe)
  where
    step_ :: Maybe' a -> a -> m (Maybe' a)
step_ Maybe' a
mx a
a = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe' a
Just' forall a b. (a -> b) -> a -> b
$
        case Maybe' a
mx of
            Maybe' a
Nothing' -> a
a
            Just' a
x -> a -> a -> a
step a
x a
a

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

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

-- | A fold that drains all its input, running the effects and discarding the
-- results.
--
-- @since 0.7.0
{-# INLINABLE drain #-}
drain :: Monad m => Fold m a ()
drain :: forall (m :: * -> *) a. Monad m => Fold m a ()
drain = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {p} {p}. Monad m => p -> p -> m ()
step m ()
begin forall {a}. a -> m a
done
    where
    begin :: m ()
begin = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    step :: p -> p -> m ()
step p
_ p
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    done :: a -> m a
done = forall (m :: * -> *) a. Monad m => a -> m a
return

-- |
-- > drainBy f = lmapM f drain
--
-- Drain all input after passing it through a monadic function. This is the
-- dual of mapM_ on stream producers.
--
-- @since 0.7.0
{-# INLINABLE drainBy #-}
drainBy ::  Monad m => (a -> m b) -> Fold m a ()
drainBy :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> Fold m a ()
drainBy a -> m b
f = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (forall a b. a -> b -> a
const (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f)) (forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (m :: * -> *) a. Monad m => a -> m a
return

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

-- | Extract the last element of the input stream, if any.
--
-- @since 0.7.0
{-# INLINABLE last #-}
last :: Monad m => Fold m a (Maybe a)
last :: forall (m :: * -> *) a. Monad m => Fold m a (Maybe a)
last = forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
_Fold1 (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. a -> b -> a
const)

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

-- | Like 'length', except with a more general 'Num' return value
--
-- @since 0.7.0
{-# INLINABLE genericLength #-}
genericLength :: (Monad m, Num b) => Fold m a b
genericLength :: forall (m :: * -> *) b a. (Monad m, Num b) => Fold m a b
genericLength = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\b
n a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ b
n forall a. Num a => a -> a -> a
+ b
1) (forall (m :: * -> *) a. Monad m => a -> m a
return b
0) forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Determine the length of the input stream.
--
-- @since 0.7.0
{-# INLINABLE length #-}
length :: Monad m => Fold m a Int
length :: forall (m :: * -> *) a. Monad m => Fold m a Int
length = 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.
--
-- @since 0.7.0
{-# INLINABLE sum #-}
sum :: (Monad m, Num a) => Fold m a a
sum :: forall (m :: * -> *) a. (Monad m, Num a) => Fold m a a
sum = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\a
x a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a
x forall a. Num a => a -> a -> a
+ a
a) (forall (m :: * -> *) a. Monad m => a -> m a
return a
0) forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Determine the product of all elements of a stream of numbers. Returns
-- multiplicative identity (@1@) when the stream is empty.
--
-- @since 0.7.0
{-# INLINABLE product #-}
product :: (Monad m, Num a) => Fold m a a
product :: forall (m :: * -> *) a. (Monad m, Num a) => Fold m a a
product = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\a
x a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a
x forall a. Num a => a -> a -> a
* a
a) (forall (m :: * -> *) a. Monad m => a -> m a
return a
1) forall (m :: * -> *) a. Monad m => a -> m a
return

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

-- | Determine the maximum element in a stream using the supplied comparison
-- function.
--
-- @since 0.7.0
{-# INLINABLE maximumBy #-}
maximumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)
maximumBy :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> Ordering) -> Fold m a (Maybe a)
maximumBy a -> a -> Ordering
cmp = forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
_Fold1 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 = 'maximumBy' compare
-- @
--
-- Determine the maximum element in a stream.
--
-- @since 0.7.0
{-# INLINABLE maximum #-}
maximum :: (Monad m, Ord a) => Fold m a (Maybe a)
maximum :: forall (m :: * -> *) a. (Monad m, Ord a) => Fold m a (Maybe a)
maximum = forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
_Fold1 forall a. Ord a => a -> a -> a
max

-- | Computes the minimum element with respect to the given comparison function
--
-- @since 0.7.0
{-# INLINABLE minimumBy #-}
minimumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)
minimumBy :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> Ordering) -> Fold m a (Maybe a)
minimumBy a -> a -> Ordering
cmp = forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
_Fold1 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.
--
-- @since 0.7.0
{-# INLINABLE minimum #-}
minimum :: (Monad m, Ord a) => Fold m a (Maybe a)
minimum :: forall (m :: * -> *) a. (Monad m, Ord a) => Fold m a (Maybe a)
minimum = forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
_Fold1 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 :: forall (m :: * -> *) a. (Monad m, Fractional a) => Fold m a a
mean = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {b}.
(Monad m, Fractional b) =>
Tuple' b b -> b -> m (Tuple' b b)
step (forall (m :: * -> *) a. Monad m => a -> m a
return Tuple' a a
begin) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b}. Tuple' a b -> a
done)
  where
    begin :: Tuple' a a
begin = forall a b. a -> b -> Tuple' a b
Tuple' a
0 a
0
    step :: Tuple' b b -> b -> m (Tuple' b b)
step (Tuple' b
x b
n) b
y = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        let n' :: b
n' = b
n forall a. Num a => a -> a -> a
+ b
1
        in forall a b. a -> b -> Tuple' a b
Tuple' (b
x forall a. Num a => a -> a -> a
+ (b
y forall a. Num a => a -> a -> a
- b
x) forall a. Fractional a => a -> a -> a
/ b
n') b
n'
    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 :: forall (m :: * -> *) a. (Monad m, Fractional a) => Fold m a a
variance = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {c}.
(Monad m, Fractional c) =>
Tuple3' c c c -> c -> m (Tuple3' c c c)
step (forall (m :: * -> *) a. Monad m => a -> m a
return Tuple3' a a a
begin) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b}. Fractional a => Tuple3' a b a -> a
done)
  where
    begin :: Tuple3' a a a
begin = forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' a
0 a
0 a
0

    step :: Tuple3' c c c -> c -> m (Tuple3' c c c)
step (Tuple3' c
n c
mean_ c
m2) c
x = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' c
n' c
mean' c
m2'
      where
        n' :: c
n'     = c
n forall a. Num a => a -> a -> a
+ c
1
        mean' :: c
mean'  = (c
n forall a. Num a => a -> a -> a
* c
mean_ forall a. Num a => a -> a -> a
+ c
x) forall a. Fractional a => a -> a -> a
/ (c
n forall a. Num a => a -> a -> a
+ c
1)
        delta :: c
delta  = c
x forall a. Num a => a -> a -> a
- c
mean_
        m2' :: c
m2'    = c
m2 forall a. Num a => a -> a -> a
+ c
delta forall a. Num a => a -> a -> a
* c
delta forall a. Num a => a -> a -> a
* c
n forall a. Fractional a => a -> a -> a
/ (c
n forall a. Num a => a -> a -> a
+ c
1)

    done :: Tuple3' a b a -> a
done (Tuple3' a
n b
_ a
m2) = a
m2 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 :: forall (m :: * -> *) a. (Monad m, Floating a) => Fold m a a
stdDev = forall a. Floating a => a -> a
sqrt 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.7.0
{-# INLINABLE rollingHashWithSalt #-}
rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64
rollingHashWithSalt :: forall (m :: * -> *) a.
(Monad m, Enum a) =>
Int64 -> Fold m a Int64
rollingHashWithSalt Int64
salt = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {a}.
(Monad m, Enum a) =>
Int64 -> a -> m Int64
step m Int64
initial forall {a}. a -> m a
extract
    where
    k :: Int64
k = Int64
2891336453 :: Int64
    initial :: m Int64
initial = forall (m :: * -> *) a. Monad m => a -> m a
return Int64
salt
    step :: Int64 -> a -> m Int64
step Int64
cksum a
a = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int64
cksum forall a. Num a => a -> a -> a
* Int64
k forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Enum a => a -> Int
fromEnum a
a)
    extract :: a -> m a
extract = forall (m :: * -> *) a. Monad m => a -> m a
return

-- | 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 = rollingHashWithSalt defaultSalt
--
-- @since 0.7.0
{-# INLINABLE rollingHash #-}
rollingHash :: (Monad m, Enum a) => Fold m a Int64
rollingHash :: forall (m :: * -> *) a. (Monad m, Enum a) => Fold m a Int64
rollingHash = 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 = ltake n rollingHash
{-# INLINABLE rollingHashFirstN #-}
rollingHashFirstN :: (Monad m, Enum a) => Int -> Fold m a Int64
rollingHashFirstN :: forall (m :: * -> *) a. (Monad m, Enum a) => Int -> Fold m a Int64
rollingHashFirstN Int
n = forall (m :: * -> *) a b.
Monad m =>
Int -> Fold m a b -> Fold m a b
ltake Int
n forall (m :: * -> *) a. (Monad m, Enum a) => Fold m a Int64
rollingHash

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

-- | Fold an input stream consisting of monoidal elements using 'mappend'
-- and 'mempty'.
--
-- > S.fold FL.mconcat (S.map Sum $ S.enumerateFromTo 1 10)
--
-- @since 0.7.0
{-# INLINABLE mconcat #-}
mconcat :: (Monad m, Monoid a) => Fold m a a
mconcat :: forall (m :: * -> *) a. (Monad m, Monoid a) => Fold m a a
mconcat = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\a
x a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> a -> a
mappend a
x a
a) (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty) forall (m :: * -> *) a. Monad m => a -> m a
return

-- |
-- > foldMap f = map f mconcat
--
-- Make a fold from a pure function that folds the output of the function
-- using 'mappend' and 'mempty'.
--
-- > S.fold (FL.foldMap Sum) $ S.enumerateFromTo 1 10
--
-- @since 0.7.0
{-# INLINABLE foldMap #-}
foldMap :: (Monad m, Monoid b) => (a -> b) -> Fold m a b
foldMap :: forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> b) -> Fold m a b
foldMap a -> b
f = forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap a -> b
f forall (m :: * -> *) a. (Monad m, Monoid a) => Fold m a a
mconcat

-- |
-- > foldMapM f = mapM f mconcat
--
-- Make a fold from a monadic function that folds the output of the function
-- using 'mappend' and 'mempty'.
--
-- > S.fold (FL.foldMapM (return . Sum)) $ S.enumerateFromTo 1 10
--
-- @since 0.7.0
{-# INLINABLE foldMapM #-}
foldMapM ::  (Monad m, Monoid b) => (a -> m b) -> Fold m a b
foldMapM :: forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> Fold m a b
foldMapM a -> m b
act = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold b -> a -> m b
step m b
begin forall {a}. a -> m a
done
    where
    done :: a -> m a
done = forall (m :: * -> *) a. Monad m => a -> m a
return
    begin :: m b
begin = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
    step :: b -> a -> m b
step b
m a
a = do
        b
m' <- a -> m b
act a
a
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => a -> a -> a
mappend b
m b
m'

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

-- | Folds the input stream to a list.
--
-- /Warning!/ working on large lists accumulated as buffers in memory could be
-- very inefficient, consider using "Streamly.Memory.Array" instead.
--
-- @since 0.7.0

-- id . (x1 :) . (x2 :) . (x3 :) . ... . (xn :) $ []
{-# INLINABLE toList #-}
toList :: Monad m => Fold m a [a]
toList :: forall (m :: * -> *) a. Monad m => Fold m a [a]
toList = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\[a] -> [a]
f a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [a] -> [a]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x forall a. a -> [a] -> [a]
:))
              (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id)
              (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a -> b) -> a -> b
$ []))

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

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

-- | A fold that drains elements of its input as long as the predicate succeeds,
-- running the effects and discarding the results.
{-# INLINABLE drainWhile #-}
drainWhile :: Monad m => (a -> Bool) -> Fold m a ()
drainWhile :: forall (m :: * -> *) a. Monad m => (a -> Bool) -> Fold m a ()
drainWhile a -> Bool
p = forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Fold m a b
ltakeWhile a -> Bool
p forall (m :: * -> *) a. Monad m => Fold m a ()
drain

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

-- | Like 'index', except with a more general 'Integral' argument
--
-- @since 0.7.0
{-# INLINABLE genericIndex #-}
genericIndex :: (Integral i, Monad m) => i -> Fold m a (Maybe a)
genericIndex :: forall i (m :: * -> *) a.
(Integral i, Monad m) =>
i -> Fold m a (Maybe a)
genericIndex i
i = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {b}.
Monad m =>
Either' i b -> b -> m (Either' i b)
step (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either' a b
Left' i
0) forall {m :: * -> *} {a} {a}. Monad m => Either' a a -> m (Maybe a)
done
  where
    step :: Either' i b -> b -> m (Either' i b)
step Either' i b
x b
a = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        case Either' i b
x of
            Left'  i
j -> if i
i forall a. Eq a => a -> a -> Bool
== i
j
                        then forall a b. b -> Either' a b
Right' b
a
                        else forall a b. a -> Either' a b
Left' (i
j forall a. Num a => a -> a -> a
+ i
1)
            Either' i b
_        -> Either' i b
x
    done :: Either' a a -> m (Maybe a)
done Either' a a
x = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        case Either' a a
x of
            Left'  a
_ -> forall a. Maybe a
Nothing
            Right' a
a -> forall a. a -> Maybe a
Just a
a

-- | Lookup the element at the given index.
--
-- @since 0.7.0
{-# INLINABLE index #-}
index :: Monad m => Int -> Fold m a (Maybe a)
index :: forall (m :: * -> *) a. Monad m => Int -> Fold m a (Maybe a)
index = 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 :: forall (m :: * -> *) a. Monad m => Fold m a (Maybe a)
head = forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
_Fold1 forall a b. a -> b -> a
const

-- | 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 :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Fold m a (Maybe a)
find a -> Bool
predicate = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *}. Monad m => Maybe' a -> a -> m (Maybe' a)
step (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe' a
Nothing') (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe' a -> Maybe a
toMaybe)
  where
    step :: Maybe' a -> a -> m (Maybe' a)
step Maybe' a
x a
a = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        case Maybe' a
x of
            Maybe' a
Nothing' -> if a -> Bool
predicate a
a
                        then forall a. a -> Maybe' a
Just' a
a
                        else forall a. Maybe' a
Nothing'
            Maybe' a
_        -> Maybe' a
x

-- | 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@.
--
-- @since 0.7.0
{-# INLINABLE lookup #-}
lookup :: (Eq a, Monad m) => a -> Fold m (a,b) (Maybe b)
lookup :: forall a (m :: * -> *) b.
(Eq a, Monad m) =>
a -> Fold m (a, b) (Maybe b)
lookup a
a0 = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {a}.
Monad m =>
Maybe' a -> (a, a) -> m (Maybe' a)
step (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe' a
Nothing') (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe' a -> Maybe a
toMaybe)
  where
    step :: Maybe' a -> (a, a) -> m (Maybe' a)
step Maybe' a
x (a
a,a
b) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        case Maybe' a
x of
            Maybe' a
Nothing' -> if a
a forall a. Eq a => a -> a -> Bool
== a
a0
                        then forall a. a -> Maybe' a
Just' a
b
                        else forall a. Maybe' a
Nothing'
            Maybe' a
_ -> Maybe' a
x

-- | Convert strict 'Either'' to lazy 'Maybe'
{-# INLINABLE hush #-}
hush :: Either' a b -> Maybe b
hush :: forall a b. Either' a b -> Maybe b
hush (Left'  a
_) = forall a. Maybe a
Nothing
hush (Right' b
b) = forall a. a -> Maybe a
Just b
b

-- | 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 :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Fold m a (Maybe Int)
findIndex a -> Bool
predicate = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {a}.
(Monad m, Num a) =>
Either' a a -> a -> m (Either' a a)
step (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either' a b
Left' Int
0) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Either' a b -> Maybe b
hush)
  where
    step :: Either' a a -> a -> m (Either' a a)
step Either' a a
x a
a = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
        case Either' a a
x of
            Left' a
i ->
                if a -> Bool
predicate a
a
                then forall a b. b -> Either' a b
Right' a
i
                else forall a b. a -> Either' a b
Left' (a
i forall a. Num a => a -> a -> a
+ a
1)
            Either' a a
_       -> Either' a a
x

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

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

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

-- |
-- > any p = lmap p or
--
-- | Returns 'True' if any of the elements of a stream satisfies a predicate.
--
-- @since 0.7.0
{-# INLINABLE any #-}
any :: Monad m => (a -> Bool) -> Fold m a Bool
any :: forall (m :: * -> *) a. Monad m => (a -> Bool) -> Fold m a Bool
any a -> Bool
predicate = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\Bool
x a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool
x Bool -> Bool -> Bool
|| a -> Bool
predicate a
a) (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) forall (m :: * -> *) a. Monad m => a -> m a
return

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

-- |
-- > all p = lmap p and
--
-- | Returns 'True' if all elements of a stream satisfy a predicate.
--
-- @since 0.7.0
{-# INLINABLE all #-}
all :: Monad m => (a -> Bool) -> Fold m a Bool
all :: forall (m :: * -> *) a. Monad m => (a -> Bool) -> Fold m a Bool
all a -> Bool
predicate = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\Bool
x a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool
x Bool -> Bool -> Bool
&& a -> Bool
predicate a
a) (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) forall (m :: * -> *) a. Monad m => a -> m a
return

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

-- | Returns 'True' if all elements are 'True', 'False' otherwise
--
-- @since 0.7.0
{-# INLINABLE and #-}
and :: Monad m => Fold m Bool Bool
and :: forall (m :: * -> *). Monad m => Fold m Bool Bool
and = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\Bool
x Bool
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool
x Bool -> Bool -> Bool
&& Bool
a) (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) forall (m :: * -> *) a. Monad m => a -> m a
return

-- | Returns 'True' if any element is 'True', 'False' otherwise
--
-- @since 0.7.0
{-# INLINABLE or #-}
or :: Monad m => Fold m Bool Bool
or :: forall (m :: * -> *). Monad m => Fold m Bool Bool
or = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\Bool
x Bool
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool
x Bool -> Bool -> Bool
|| Bool
a) (forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) forall (m :: * -> *) a. Monad m => a -> m a
return

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

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

------------------------------------------------------------------------------
-- Binary APIs
------------------------------------------------------------------------------
--
-- XXX These would just be applicative compositions of terminating folds.

-- | @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 = S.fold (FL.splitAt n FL.toList FL.toList) $ S.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],[])
--
-- /Internal/

-- This can be considered as a two-fold version of 'ltake' where we take both
-- the segments instead of discarding the leftover.
--
{-# INLINE splitAt #-}
splitAt
    :: Monad m
    => Int
    -> Fold m a b
    -> Fold m a c
    -> Fold m a (b, c)
splitAt :: forall (m :: * -> *) a b c.
Monad m =>
Int -> Fold m a b -> Fold m a c -> Fold m a (b, c)
splitAt Int
n (Fold s -> a -> m s
stepL m s
initialL s -> m b
extractL) (Fold s -> a -> m s
stepR m s
initialR s -> m c
extractR) =
    forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {a}.
(Ord a, Num a) =>
Tuple3' a s s -> a -> m (Tuple3' a s s)
step m (Tuple3' Int s s)
initial forall {a}. Tuple3' a s s -> m (b, c)
extract
    where
      initial :: m (Tuple3' Int s s)
initial  = forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Monad m => a -> m a
return Int
n forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m s
initialL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m s
initialR

      step :: Tuple3' a s s -> a -> m (Tuple3' a s s)
step (Tuple3' a
i s
xL s
xR) a
input =
        if a
i forall a. Ord a => a -> a -> Bool
> a
0
        then s -> a -> m s
stepL s
xL a
input forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (a
i forall a. Num a => a -> a -> a
- a
1) s
a s
xR))
        else s -> a -> m s
stepR s
xR a
input forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
b -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' a
i s
xL s
b))

      extract :: Tuple3' a s s -> m (b, c)
extract (Tuple3' a
_ s
a s
b) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m c
extractR s
b

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

-- | Break the input stream into two groups, the first group takes the input as
-- long as the predicate applied to the first element of the stream and next
-- input element holds 'True', the second group takes the rest of the input.
--
-- /Internal/
--
spanBy
    :: Monad m
    => (a -> a -> Bool)
    -> Fold m a b
    -> Fold m a c
    -> Fold m a (b, c)
spanBy :: forall (m :: * -> *) a b c.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Fold m a c -> Fold m a (b, c)
spanBy a -> a -> Bool
cmp (Fold s -> a -> m s
stepL m s
initialL s -> m b
extractL) (Fold s -> a -> m s
stepR m s
initialR s -> m c
extractR) =
    forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Tuple3' s s (Tuple' (Maybe a) Bool)
-> a -> m (Tuple3' s s (Tuple' (Maybe a) Bool))
step forall {a}. m (Tuple3' s s (Tuple' (Maybe a) Bool))
initial forall {c}. Tuple3' s s c -> m (b, c)
extract

    where
      initial :: m (Tuple3' s s (Tuple' (Maybe a) Bool))
initial = forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
initialL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m s
initialR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Tuple' a b
Tuple' forall a. Maybe a
Nothing Bool
True)

      step :: Tuple3' s s (Tuple' (Maybe a) Bool)
-> a -> m (Tuple3' s s (Tuple' (Maybe a) Bool))
step (Tuple3' s
a s
b (Tuple' (Just a
frst) Bool
isFirstG)) a
input =
        if a -> a -> Bool
cmp a
frst a
input Bool -> Bool -> Bool
&& Bool
isFirstG
        then s -> a -> m s
stepL s
a a
input
              forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a' s
b (forall a b. a -> b -> Tuple' a b
Tuple' (forall a. a -> Maybe a
Just a
frst) Bool
isFirstG)))
        else s -> a -> m s
stepR s
b a
input
              forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a s
a' (forall a b. a -> b -> Tuple' a b
Tuple' forall a. Maybe a
Nothing Bool
False)))

      step (Tuple3' s
a s
b (Tuple' Maybe a
Nothing Bool
isFirstG)) a
input =
        if Bool
isFirstG
        then s -> a -> m s
stepL s
a a
input
              forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a' s
b (forall a b. a -> b -> Tuple' a b
Tuple' (forall a. a -> Maybe a
Just a
input) Bool
isFirstG)))
        else s -> a -> m s
stepR s
b a
input
              forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a s
a' (forall a b. a -> b -> Tuple' a b
Tuple' forall a. Maybe a
Nothing Bool
False)))

      extract :: Tuple3' s s c -> m (b, c)
extract (Tuple3' s
a s
b c
_) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m c
extractR s
b

-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the
-- input as long as the predicate @p@ is 'True'.  @f2@ consumes the rest of the
-- input.
--
-- > let span_ p xs = S.fold (S.span p FL.toList FL.toList) $ S.fromList xs
--
-- >>> span_ (< 1) [1,2,3]
-- > ([],[1,2,3])
--
-- >>> span_ (< 2) [1,2,3]
-- > ([1],[2,3])
--
-- >>> span_ (< 4) [1,2,3]
-- > ([1,2,3],[])
--
-- /Internal/

-- This can be considered as a two-fold version of 'ltakeWhile' where we take
-- both the segments instead of discarding the leftover.
{-# INLINE span #-}
span
    :: Monad m
    => (a -> Bool)
    -> Fold m a b
    -> Fold m a c
    -> Fold m a (b, c)
span :: forall (m :: * -> *) a b c.
Monad m =>
(a -> Bool) -> Fold m a b -> Fold m a c -> Fold m a (b, c)
span a -> Bool
p (Fold s -> a -> m s
stepL m s
initialL s -> m b
extractL) (Fold s -> a -> m s
stepR m s
initialR s -> m c
extractR) =
    forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Tuple3' s s Bool -> a -> m (Tuple3' s s Bool)
step m (Tuple3' s s Bool)
initial forall {c}. Tuple3' s s c -> m (b, c)
extract

    where

    initial :: m (Tuple3' s s Bool)
initial = forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
initialL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m s
initialR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

    step :: Tuple3' s s Bool -> a -> m (Tuple3' s s Bool)
step (Tuple3' s
a s
b Bool
isFirstG) a
input =
        if Bool
isFirstG Bool -> Bool -> Bool
&& a -> Bool
p a
input
        then s -> a -> m s
stepL s
a a
input forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a' s
b Bool
True))
        else s -> a -> m s
stepR s
b a
input forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a s
a' Bool
False))

    extract :: Tuple3' s s c -> m (b, c)
extract (Tuple3' s
a s
b c
_) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m c
extractR s
b

-- |
-- > break p = span (not . p)
--
-- Break as soon as the predicate becomes 'True'. @break p f1 f2@ composes
-- folds @f1@ and @f2@ such that @f1@ stops consuming input as soon as the
-- predicate @p@ becomes 'True'. The rest of the input is consumed @f2@.
--
-- This is the binary version of 'splitBy'.
--
-- > let break_ p xs = S.fold (S.break p FL.toList FL.toList) $ S.fromList xs
--
-- >>> break_ (< 1) [3,2,1]
-- > ([3,2,1],[])
--
-- >>> break_ (< 2) [3,2,1]
-- > ([3,2],[1])
--
-- >>> break_ (< 4) [3,2,1]
-- > ([],[3,2,1])
--
-- /Internal/
{-# INLINE break #-}
break
    :: Monad m
    => (a -> Bool)
    -> Fold m a b
    -> Fold m a c
    -> Fold m a (b, c)
break :: forall (m :: * -> *) a b c.
Monad m =>
(a -> Bool) -> Fold m a b -> Fold m a c -> Fold m a (b, c)
break a -> Bool
p = forall (m :: * -> *) a b c.
Monad m =>
(a -> Bool) -> Fold m a b -> Fold m a c -> Fold m a (b, c)
span (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.
-- predicate is applied to the previous and the next input elements.
--
-- /Internal/
{-# INLINE spanByRolling #-}
spanByRolling
    :: Monad m
    => (a -> a -> Bool)
    -> Fold m a b
    -> Fold m a c
    -> Fold m a (b, c)
spanByRolling :: forall (m :: * -> *) a b c.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Fold m a c -> Fold m a (b, c)
spanByRolling a -> a -> Bool
cmp (Fold s -> a -> m s
stepL m s
initialL s -> m b
extractL) (Fold s -> a -> m s
stepR m s
initialR s -> m c
extractR) =
    forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Tuple3' s s (Maybe a) -> a -> m (Tuple3' s s (Maybe a))
step forall {a}. m (Tuple3' s s (Maybe a))
initial forall {c}. Tuple3' s s c -> m (b, c)
extract

  where
    initial :: m (Tuple3' s s (Maybe a))
initial = forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
initialL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m s
initialR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

    step :: Tuple3' s s (Maybe a) -> a -> m (Tuple3' s s (Maybe a))
step (Tuple3' s
a s
b (Just a
frst)) a
input =
      if a -> a -> Bool
cmp a
input a
frst
      then s -> a -> m s
stepL s
a a
input forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a' s
b (forall a. a -> Maybe a
Just a
input)))
      else s -> a -> m s
stepR s
b a
input forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
b' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a s
b' (forall a. a -> Maybe a
Just a
input)))

    step (Tuple3' s
a s
b Maybe a
Nothing) a
input =
      s -> a -> m s
stepL s
a a
input forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a' s
b (forall a. a -> Maybe a
Just a
input)))

    extract :: Tuple3' s s c -> m (b, c)
extract (Tuple3' s
a s
b c
_) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m c
extractR s
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--------|
-- @
-- >>> S.fold (FL.tee FL.sum FL.length) (S.enumerateFromTo 1.0 100.0)
-- (5050.0,100)
--
-- @since 0.7.0
{-# INLINE tee #-}
tee :: Monad m => Fold m a b -> Fold m a c -> Fold m a (b,c)
tee :: forall (m :: * -> *) a b c.
Monad m =>
Fold m a b -> Fold m a c -> Fold m a (b, c)
tee Fold m a b
f1 Fold m a c
f2 = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold m a b
f1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fold m a c
f2

{-# INLINE foldNil #-}
foldNil :: Monad m => Fold m a [b]
foldNil :: forall (m :: * -> *) a b. Monad m => Fold m a [b]
foldNil = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {p} {p} {a}. Monad m => p -> p -> m [a]
step forall {a}. m [a]
begin forall {a}. a -> m a
done  where
  begin :: m [a]
begin = forall (m :: * -> *) a. Monad m => a -> m a
return []
  step :: p -> p -> m [a]
step p
_ p
_ = forall (m :: * -> *) a. Monad m => a -> m a
return []
  done :: a -> m a
done = forall (m :: * -> *) a. Monad m => a -> m a
return

{-# INLINE foldCons #-}
foldCons :: Monad m => Fold m a b -> Fold m a [b] -> Fold m a [b]
foldCons :: forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Fold m a [b] -> Fold m a [b]
foldCons (Fold s -> a -> m s
stepL m s
beginL s -> m b
doneL) (Fold s -> a -> m s
stepR m s
beginR s -> m [b]
doneR) =
    forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Tuple' s s -> a -> m (Tuple' s s)
step m (Tuple' s s)
begin Tuple' s s -> m [b]
done

    where

    begin :: m (Tuple' s s)
begin = forall a b. a -> b -> Tuple' a b
Tuple' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
beginL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m s
beginR
    step :: Tuple' s s -> a -> m (Tuple' s s)
step (Tuple' s
xL s
xR) a
a = forall a b. a -> b -> Tuple' a b
Tuple' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> a -> m s
stepL s
xL a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> a -> m s
stepR s
xR a
a
    done :: Tuple' s s -> m [b]
done (Tuple' s
xL s
xR) = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (s -> m b
doneL s
xL) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (s -> m [b]
doneR s
xR)

-- 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--------|
--                 |                         |
--                            ...
-- @
--
-- >>> S.fold (FL.distribute [FL.sum, FL.length]) (S.enumerateFromTo 1 5)
-- [15,5]
--
-- This is the consumer side dual of the producer side 'sequence' operation.
--
-- @since 0.7.0
{-# INLINE distribute #-}
distribute :: Monad m => [Fold m a b] -> Fold m a [b]
distribute :: forall (m :: * -> *) a b. Monad m => [Fold m a b] -> Fold m a [b]
distribute [] = forall (m :: * -> *) a b. Monad m => Fold m a [b]
foldNil
distribute (Fold m a b
x:[Fold m a b]
xs) = forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Fold m a [b] -> Fold m a [b]
foldCons Fold m a b
x (forall (m :: * -> *) a b. Monad m => [Fold m a b] -> Fold m a [b]
distribute [Fold m a b]
xs)

-- | Like 'distribute' but for folds that return (), this can be more efficient
-- than 'distribute' as it does not need to maintain state.
--
{-# INLINE distribute_ #-}
distribute_ :: Monad m => [Fold m a ()] -> Fold m a ()
distribute_ :: forall (m :: * -> *) a. Monad m => [Fold m a ()] -> Fold m a ()
distribute_ [Fold m a ()]
fs = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {t :: * -> *} {a} {b}.
(Foldable t, Monad m) =>
t (Fold m a b) -> a -> m (t (Fold m a b))
step m [Fold m a ()]
initial forall {m :: * -> *} {t :: * -> *} {a} {b}.
(Foldable t, Monad m) =>
t (Fold m a b) -> m ()
extract
    where
    initial :: m [Fold m a ()]
initial    = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Prelude.mapM (\(Fold s -> a -> m s
s m s
i s -> m ()
e) ->
        m s
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold s -> a -> m s
s (forall (m :: * -> *) a. Monad m => a -> m a
return s
r) s -> m ()
e)) [Fold m a ()]
fs
    step :: t (Fold m a b) -> a -> m (t (Fold m a b))
step t (Fold m a b)
ss a
a  = do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
Prelude.mapM_ (\(Fold s -> a -> m s
s m s
i s -> m b
_) -> m s
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
r -> s -> a -> m s
s s
r a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) t (Fold m a b)
ss
        forall (m :: * -> *) a. Monad m => a -> m a
return t (Fold m a b)
ss
    extract :: t (Fold m a b) -> m ()
extract t (Fold m a b)
ss = do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
Prelude.mapM_ (\(Fold s -> a -> m s
_ m s
i s -> m b
e) -> m s
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
r -> s -> m b
e s
r) t (Fold m a b)
ss
        forall (m :: * -> *) a. Monad m => a -> m a
return ()

------------------------------------------------------------------------------
-- 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
-- >>> S.fold (FL.partitionByM randomly FL.length FL.length) (S.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.
--
-- @since 0.7.0
{-# INLINE partitionByM #-}
partitionByM :: Monad m
    => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionByM :: 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 a -> m (Either b c)
f (Fold s -> b -> m s
stepL m s
beginL s -> m x
doneL) (Fold s -> c -> m s
stepR m s
beginR s -> m y
doneR) =

    forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Tuple' s s -> a -> m (Tuple' s s)
step m (Tuple' s s)
begin Tuple' s s -> m (x, y)
done

    where

    begin :: m (Tuple' s s)
begin = forall a b. a -> b -> Tuple' a b
Tuple' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
beginL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m s
beginR
    step :: Tuple' s s -> a -> m (Tuple' s s)
step (Tuple' s
xL s
xR) a
a = do
        Either b c
r <- a -> m (Either b c)
f a
a
        case Either b c
r of
            Left b
b -> forall a b. a -> b -> Tuple' a b
Tuple' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> b -> m s
stepL s
xL b
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return s
xR
            Right c
c -> forall a b. a -> b -> Tuple' a b
Tuple' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Monad m => a -> m a
return s
xL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> c -> m s
stepR s
xR c
c
    done :: Tuple' s s -> m (x, y)
done (Tuple' s
xL s
xR) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m x
doneL s
xL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m y
doneR s
xR

-- 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 = FL.partitionBy (\\n -> if even n then Left n else Right n)
--                       (fmap (("Even " ++) . show) FL.length)
--                       (fmap (("Odd "  ++) . show) FL.length)
--   in S.fold f (S.enumerateFromTo 1 100)
-- ("Even 50","Odd 50")
-- @
--
-- @since 0.7.0
{-# INLINE partitionBy #-}
partitionBy :: Monad m
    => (a -> Either b c) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionBy :: 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 a -> Either b c
f = 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 (forall (m :: * -> *) a. Monad m => a -> m a
return 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 :: forall (m :: * -> *) b x c y.
Monad m =>
Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)
partition = 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 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
--                             |
--                                       ...
-- @
--
-- @since 0.7.0
{-# INLINE demuxWith #-}
demuxWith :: (Monad m, Ord k)
    => (a -> (k, a')) -> Map k (Fold m a' b) -> Fold m a (Map k b)
demuxWith :: 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 a -> (k, a')
f Map k (Fold m a' b)
kv = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {f :: * -> *} {b}.
Monad f =>
Map k (Fold f a' b) -> a -> f (Map k (Fold f a' b))
step m (Map k (Fold m a' b))
initial forall {a} {b}. Map k (Fold m a b) -> m (Map k b)
extract

    where

    initial :: m (Map k (Fold m a' b))
initial = forall (m :: * -> *) a. Monad m => a -> m a
return Map k (Fold m a' b)
kv
-- alterF is available only since containers version 0.5.8.2
#if MIN_VERSION_containers(0,5,8)
    step :: Map k (Fold f a' b) -> a -> f (Map k (Fold f a' b))
step Map k (Fold f a' b)
mp a
a = case a -> (k, a')
f a
a of
      (k
k, a'
a') -> forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF forall {f :: * -> *} {b}.
Monad f =>
Maybe (Fold f a' b) -> f (Maybe (Fold f a' b))
twiddle k
k Map k (Fold f a' b)
mp
        -- XXX should we raise an exception in Nothing case?
        -- Ideally we should enforce that it is a total map over k so that look
        -- up never fails
        -- XXX we could use a monadic update function for a single lookup and
        -- update in the map.
        where
          twiddle :: Maybe (Fold f a' b) -> f (Maybe (Fold f a' b))
twiddle Maybe (Fold f a' b)
Nothing = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
          twiddle (Just (Fold s -> a' -> f s
step' f s
acc s -> f b
extract')) = do
            !s
r <- f s
acc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
x -> s -> a' -> f s
step' s
x a'
a'
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold s -> a' -> f s
step' (forall (m :: * -> *) a. Monad m => a -> m a
return s
r) s -> f b
extract'
#else
    step mp a =
        let (k, a') = f a
        in case Map.lookup k mp of
            Nothing -> return mp
            Just (Fold step' acc extract') -> do
                !r <- acc >>= \x -> step' x a'
                return $ Map.insert k (Fold step' (return r) extract') mp
#endif
    extract :: Map k (Fold m a b) -> m (Map k b)
extract = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Prelude.mapM (\(Fold s -> a -> m s
_ m s
acc s -> m b
e) -> m s
acc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m b
e)

-- | 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.
--
-- @
-- > let table = Data.Map.fromList [(\"SUM", FL.sum), (\"PRODUCT", FL.product)]
--       input = S.fromList [(\"SUM",1),(\"PRODUCT",2),(\"SUM",3),(\"PRODUCT",4)]
--   in S.fold (FL.demux table) input
-- fromList [("PRODUCT",8),("SUM",4)]
-- @
--
-- @since 0.7.0
{-# INLINE demux #-}
demux :: (Monad m, Ord k)
    => Map k (Fold m a b) -> Fold m (k, a) (Map k b)
demux :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
Map k (Fold m a b) -> Fold m (k, a) (Map k b)
demux = 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 forall a. a -> a
id

{-# INLINE demuxWithDefault_ #-}
demuxWithDefault_ :: (Monad m, Ord k)
    => (a -> (k, a')) -> Map k (Fold m a' b) -> Fold m (k, a') b -> Fold m a ()
demuxWithDefault_ :: forall (m :: * -> *) k a a' b.
(Monad m, Ord k) =>
(a -> (k, a'))
-> Map k (Fold m a' b) -> Fold m (k, a') b -> Fold m a ()
demuxWithDefault_ a -> (k, a')
f Map k (Fold m a' b)
kv (Fold s -> (k, a') -> m s
dstep m s
dinitial s -> m b
dextract) =
    forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {b}.
Tuple' (Map k (Fold m a' b)) s
-> a -> m (Tuple' (Map k (Fold m a' b)) s)
step m (Tuple' (Map k (Fold m a' b)) s)
initial forall {t :: * -> *} {a} {b}.
Foldable t =>
Tuple' (t (Fold m a b)) s -> m ()
extract

    where

    initFold :: Fold m a b -> m (Fold m a b)
initFold (Fold s -> a -> m s
s m s
i s -> m b
e) = m s
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold s -> a -> m s
s (forall (m :: * -> *) a. Monad m => a -> m a
return s
r) s -> m b
e)
    initial :: m (Tuple' (Map k (Fold m a' b)) s)
initial = do
        Map k (Fold m a' b)
mp <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Prelude.mapM forall {m :: * -> *} {a} {b}.
Monad m =>
Fold m a b -> m (Fold m a b)
initFold Map k (Fold m a' b)
kv
        s
dacc <- m s
dinitial
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Tuple' a b
Tuple' Map k (Fold m a' b)
mp s
dacc)
    step :: Tuple' (Map k (Fold m a' b)) s
-> a -> m (Tuple' (Map k (Fold m a' b)) s)
step (Tuple' Map k (Fold m a' b)
mp s
dacc) a
a
      | (k
k, a'
a') <- a -> (k, a')
f a
a
      = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k (Fold m a' b)
mp of
            Maybe (Fold m a' b)
Nothing -> do
                s
acc <- s -> (k, a') -> m s
dstep s
dacc (k
k, a'
a')
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Tuple' a b
Tuple' Map k (Fold m a' b)
mp s
acc)
            Just (Fold s -> a' -> m s
step' m s
acc s -> m b
_) -> do
                s
_ <- m s
acc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
x -> s -> a' -> m s
step' s
x a'
a'
                forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> Tuple' a b
Tuple' Map k (Fold m a' b)
mp s
dacc)
    extract :: Tuple' (t (Fold m a b)) s -> m ()
extract (Tuple' t (Fold m a b)
mp s
dacc) = do
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ s -> m b
dextract s
dacc
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
Prelude.mapM_ (\(Fold s -> a -> m s
_ m s
acc s -> m b
e) -> m s
acc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m b
e) t (Fold m a b)
mp

-- | Split the input stream based on a key field and fold each split using a
-- specific fold without collecting the results. Useful for cases like protocol
-- handlers to handle different type of packets.
--
-- @
--
--                             |-------Fold m a ()
-- -----stream m a-----Map-----|
--                             |-------Fold m a ()
--                             |
--                                       ...
-- @
--
--
-- @since 0.7.0

-- demuxWith_ can be slightly faster than demuxWith because we do not need to
-- update the Map in this case. This may be significant only if the map is
-- large.
{-# INLINE demuxWith_ #-}
demuxWith_ :: (Monad m, Ord k)
    => (a -> (k, a')) -> Map k (Fold m a' b) -> Fold m a ()
demuxWith_ :: forall (m :: * -> *) k a a' b.
(Monad m, Ord k) =>
(a -> (k, a')) -> Map k (Fold m a' b) -> Fold m a ()
demuxWith_ a -> (k, a')
f Map k (Fold m a' b)
kv = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *} {b}.
Monad m =>
Map k (Fold m a' b) -> a -> m (Map k (Fold m a' b))
step m (Map k (Fold m a' b))
initial forall {t :: * -> *} {m :: * -> *} {a} {b}.
(Foldable t, Monad m) =>
t (Fold m a b) -> m ()
extract

    where

    initial :: m (Map k (Fold m a' b))
initial = do
        forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Prelude.mapM (\(Fold s -> a' -> m s
s m s
i s -> m b
e) ->
            m s
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold s -> a' -> m s
s (forall (m :: * -> *) a. Monad m => a -> m a
return s
r) s -> m b
e)) Map k (Fold m a' b)
kv
    step :: Map k (Fold m a' b) -> a -> m (Map k (Fold m a' b))
step Map k (Fold m a' b)
mp a
a
        -- XXX should we raise an exception in Nothing case?
        -- Ideally we should enforce that it is a total map over k so that look
        -- up never fails
      | (k
k, a'
a') <- a -> (k, a')
f a
a
      = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k (Fold m a' b)
mp of
            Maybe (Fold m a' b)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Map k (Fold m a' b)
mp
            Just (Fold s -> a' -> m s
step' m s
acc s -> m b
_) -> do
                s
_ <- m s
acc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
x -> s -> a' -> m s
step' s
x a'
a'
                forall (m :: * -> *) a. Monad m => a -> m a
return Map k (Fold m a' b)
mp
    extract :: t (Fold m a b) -> m ()
extract t (Fold m a b)
mp = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
Prelude.mapM_ (\(Fold s -> a -> m s
_ m s
acc s -> m b
e) -> m s
acc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> m b
e) t (Fold m a b)
mp

-- | Given a stream of key value pairs and a map from keys to folds, fold the
-- values for each key using the corresponding folds, discarding the outputs.
--
-- @
-- > let prn = FL.drainBy print
-- > let table = Data.Map.fromList [(\"ONE", prn), (\"TWO", prn)]
--       input = S.fromList [(\"ONE",1),(\"TWO",2)]
--   in S.fold (FL.demux_ table) input
-- One 1
-- Two 2
-- @
--
-- @since 0.7.0
{-# INLINE demux_ #-}
demux_ :: (Monad m, Ord k) => Map k (Fold m a ()) -> Fold m (k, a) ()
demux_ :: forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k (Fold m a ()) -> Fold m (k, a) ()
demux_ = forall (m :: * -> *) k a a' b.
(Monad m, Ord k) =>
(a -> (k, a')) -> Map k (Fold m a' b) -> Fold m a ()
demuxWith_ forall a. a -> a
id

{-# INLINE demuxDefault_ #-}
demuxDefault_ :: (Monad m, Ord k)
    => Map k (Fold m a ()) -> Fold m (k, a) () -> Fold m (k, a) ()
demuxDefault_ :: forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k (Fold m a ()) -> Fold m (k, a) () -> Fold m (k, a) ()
demuxDefault_ = forall (m :: * -> *) k a a' b.
(Monad m, Ord k) =>
(a -> (k, a'))
-> Map k (Fold m a' b) -> Fold m (k, a') b -> Fold m a ()
demuxWithDefault_ 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 = S.fromList [(\"ONE",1),(\"ONE",1.1),(\"TWO",2), (\"TWO",2.2)]
--   in S.fold (FL.classify FL.toList) input
-- fromList [(\"ONE",[1.1,1.0]),(\"TWO",[2.2,2.0])]
-- @
--
-- @since 0.7.0
{-# INLINE classifyWith #-}
classifyWith :: (Monad m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (Map k b)
classifyWith :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k) -> Fold m a b -> Fold m a (Map k b)
classifyWith a -> k
f (Fold s -> a -> m s
step m s
initial s -> m b
extract) = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Map k s -> a -> m (Map k s)
step' forall {k} {a}. m (Map k a)
initial' Map k s -> m (Map k b)
extract'

    where

    initial' :: m (Map k a)
initial' = forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
Map.empty
    step' :: Map k s -> a -> m (Map k s)
step' Map k s
kv a
a =
        let k :: k
k = a -> k
f a
a
        in case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
k Map k s
kv of
            Maybe s
Nothing -> do
                s
x <- m s
initial
                s
r <- s -> a -> m s
step s
x a
a
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k s
r Map k s
kv
            Just s
x -> do
                s
r <- s -> a -> m s
step s
x a
a
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
k s
r Map k s
kv
    extract' :: Map k s -> m (Map k b)
extract' = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Prelude.mapM s -> m b
extract

-- | 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 = S.fromList [(\"ONE",1),(\"ONE",1.1),(\"TWO",2), (\"TWO",2.2)]
--   in S.fold (FL.classify FL.toList) input
-- fromList [(\"ONE",[1.1,1.0]),(\"TWO",[2.2,2.0])]
-- @
--
-- @since 0.7.0

-- Same as:
--
-- > classify fld = classifyWith fst (lmap snd fld)
--
{-# INLINE classify #-}
classify :: (Monad m, Ord k) => Fold m a b -> Fold m (k, a) (Map k b)
classify :: forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
Fold m a b -> Fold m (k, a) (Map k b)
classify Fold m a b
fld = forall (m :: * -> *) k a b.
(Monad m, Ord k) =>
(a -> k) -> Fold m a b -> Fold m a (Map k b)
classifyWith forall a b. (a, b) -> a
fst (forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap forall a b. (a, b) -> b
snd Fold m a b
fld)

------------------------------------------------------------------------------
-- Unzipping
------------------------------------------------------------------------------
--
-- | Like 'unzipWith' but with a monadic splitter function.
--
-- @since 0.7.0
{-# INLINE unzipWithM #-}
unzipWithM :: Monad m
    => (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
unzipWithM :: 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 a -> m (b, c)
f (Fold s -> b -> m s
stepL m s
beginL s -> m x
doneL) (Fold s -> c -> m s
stepR m s
beginR s -> m y
doneR) =
    forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Tuple' s s -> a -> m (Tuple' s s)
step m (Tuple' s s)
begin Tuple' s s -> m (x, y)
done

    where

    step :: Tuple' s s -> a -> m (Tuple' s s)
step (Tuple' s
xL s
xR) a
a = do
        (b
b,c
c) <- a -> m (b, c)
f a
a
        forall a b. a -> b -> Tuple' a b
Tuple' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> b -> m s
stepL s
xL b
b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> c -> m s
stepR s
xR c
c
    begin :: m (Tuple' s s)
begin = forall a b. a -> b -> Tuple' a b
Tuple' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
beginL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m s
beginR
    done :: Tuple' s s -> m (x, y)
done (Tuple' s
xL s
xR) = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m x
doneL s
xL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m y
doneR s
xR

-- | 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.
--
-- @since 0.7.0
{-# INLINE unzipWith #-}
unzipWith :: Monad m
    => (a -> (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
unzipWith :: 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, c)
f = 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 (forall (m :: * -> *) a. Monad m => a -> m a
return 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--------|
--
-- @
--
-- 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 :: forall (m :: * -> *) a x b y.
Monad m =>
Fold m a x -> Fold m b y -> Fold m (a, b) (x, y)
unzip = 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 forall a. a -> a
id

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

{-
-- All the stream flattening transformations can also be applied to a fold
-- input stream.

-- | This can be used to apply all the stream generation operations on folds.
lconcatMap ::(IsStream t, Monad m) => (a -> t m b)
    -> Fold m b c
    -> Fold m a c
lconcatMap s f1 f2 = undefined
-}

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

-- | Apply a terminating fold repeatedly to the input of another fold.
--
-- Compare with: Streamly.Prelude.concatMap, Streamly.Prelude.foldChunks
--
-- /Unimplemented/
--
{-# INLINABLE foldChunks #-}
foldChunks ::
    -- Monad m =>
    Fold m a b -> Fold m b c -> Fold m a c
foldChunks :: forall (m :: * -> *) a b c. Fold m a b -> Fold m b c -> Fold m a c
foldChunks = forall a. HasCallStack => a
undefined

{-
-- XXX this would be an application of foldChunks using a terminating fold.
--
-- | 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.
--
-- @
--
-- XXX we should be able to implement it with parsers/terminating folds.
--
{-# INLINE lchunksInRange #-}
lchunksInRange :: Monad m
    => Int -> Int -> Fold m a b -> Fold m b c -> Fold m a c
lchunksInRange low high (Fold step1 initial1 extract1)
                        (Fold step2 initial2 extract2) = undefined
-}

------------------------------------------------------------------------------
-- Fold to a Parallel SVar
------------------------------------------------------------------------------

{-# INLINE toParallelSVar #-}
toParallelSVar :: MonadIO m => SVar t m a -> Maybe WorkerInfo -> Fold m a ()
toParallelSVar :: forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
MonadIO m =>
SVar t m a -> Maybe WorkerInfo -> Fold m a ()
toParallelSVar SVar t m a
svar Maybe WorkerInfo
winfo = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *}. MonadIO m => () -> a -> m ()
step m ()
initial forall {m :: * -> *}. MonadIO m => () -> m ()
extract
    where

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

    step :: () -> a -> m ()
step () a
x = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        -- XXX we can have a separate fold for unlimited buffer case to avoid a
        -- branch in the step here.
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> IO ()
decrementBufferLimit SVar t m a
svar
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> ChildEvent a -> IO Int
send SVar t m a
svar (forall a. a -> ChildEvent a
ChildYield a
x)

    extract :: () -> m ()
extract () = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> Maybe WorkerInfo -> IO ()
sendStop SVar t m a
svar Maybe WorkerInfo
winfo

{-# INLINE toParallelSVarLimited #-}
toParallelSVarLimited :: MonadIO m
    => SVar t m a -> Maybe WorkerInfo -> Fold m a ()
toParallelSVarLimited :: forall (m :: * -> *) (t :: (* -> *) -> * -> *) a.
MonadIO m =>
SVar t m a -> Maybe WorkerInfo -> Fold m a ()
toParallelSVarLimited SVar t m a
svar Maybe WorkerInfo
winfo = forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold forall {m :: * -> *}. MonadIO m => Bool -> a -> m Bool
step m Bool
initial forall {m :: * -> *}. MonadIO m => Bool -> m ()
extract
    where

    initial :: m Bool
initial = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

    step :: Bool -> a -> m Bool
step Bool
True a
x = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
        Bool
yieldLimitOk <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> IO Bool
decrementYieldLimit SVar t m a
svar
        if Bool
yieldLimitOk
        then do
            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> IO ()
decrementBufferLimit SVar t m a
svar
            forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> ChildEvent a -> IO Int
send SVar t m a
svar (forall a. a -> ChildEvent a
ChildYield a
x)
            forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        else do
            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> IO ()
cleanupSVarFromWorker SVar t m a
svar
            forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> Maybe WorkerInfo -> IO ()
sendStop SVar t m a
svar Maybe WorkerInfo
winfo
            forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    step Bool
False a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    extract :: Bool -> m ()
extract Bool
True = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> Maybe WorkerInfo -> IO ()
sendStop SVar t m a
svar Maybe WorkerInfo
winfo
    extract Bool
False = forall (m :: * -> *) a. Monad m => a -> m a
return ()