{-# 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 :: (s -> a -> s) -> s -> (s -> b) -> Fold m a b
mkPure s -> a -> s
step s
initial s -> b
extract =
    (s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\s
s a
a -> s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> m s) -> s -> m s
forall a b. (a -> b) -> a -> b
$ s -> a -> s
step s
s a
a) (s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return s
initial) (b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> (s -> b) -> s -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> b
extract)

-- | 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 :: (b -> a -> b) -> b -> Fold m a b
mkPureId b -> a -> b
step b
initial = (b -> a -> b) -> b -> (b -> b) -> Fold m a b
forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> s) -> s -> (s -> b) -> Fold m a b
mkPure b -> a -> b
step b
initial b -> b
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 :: (s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
mkFold = (s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
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 :: (b -> a -> m b) -> m b -> Fold m a b
mkFoldId b -> a -> m b
step m b
initial = (b -> a -> m b) -> m b -> (b -> m b) -> Fold m a b
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 b -> m b
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 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) =
    (s -> a -> n s) -> n s -> (s -> n b) -> Fold n a b
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\s
x a
a -> m s -> n s
forall x. m x -> n x
f (m s -> n s) -> m s -> n s
forall a b. (a -> b) -> a -> b
$ s -> a -> m s
step s
x a
a) (m s -> n s
forall x. m x -> n x
f m s
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 = hoist (return . runIdentity)
--
-- /Internal/
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
{-# 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 (Fold s -> a -> m s
step m s
initial s -> m (m b)
extract) = (s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
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 m b -> (b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 :: (b -> m c) -> Fold m a b -> Fold m a c
mapM b -> m c
f = Fold m a (m c) -> Fold m a c
forall (m :: * -> *) a b. Monad m => Fold m a (m b) -> Fold m a b
sequence (Fold m a (m c) -> Fold m a c)
-> (Fold m a b -> Fold m a (m c)) -> Fold m a b -> Fold m a c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> m c) -> Fold m a b -> Fold m a (m 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 :: 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) =
    (Tuple' s1 s -> a -> m (Tuple' s1 s))
-> m (Tuple' s1 s) -> (Tuple' s1 s -> m c) -> Fold m a c
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 Tuple' s1 s -> m c
forall a. Tuple' a s -> m c
extract

    where

    initial :: m (Tuple' s1 s)
initial = s1 -> s -> Tuple' s1 s
forall a b. a -> b -> Tuple' a b
Tuple' (s1 -> s -> Tuple' s1 s) -> m s1 -> m (s -> Tuple' s1 s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s1 -> m s1
forall (m :: * -> *) a. Monad m => a -> m a
return s1
pinitial m (s -> Tuple' s1 s) -> m s -> m (Tuple' s1 s)
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
            Tuple' s1 s -> m (Tuple' s1 s)
forall (m :: * -> *) a. Monad m => a -> m a
return (s1 -> s -> Tuple' s1 s
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')) = Tuple' s1 s -> m (Tuple' s1 s)
forall (m :: * -> *) a. Monad m => a -> m a
return (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 (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 :: (a -> a -> a) -> Fold m a (Maybe a)
_Fold1 a -> a -> a
step = (Maybe' a -> a -> m (Maybe' a))
-> m (Maybe' a) -> (Maybe' a -> m (Maybe a)) -> Fold m a (Maybe a)
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Maybe' a -> a -> m (Maybe' a)
forall (m :: * -> *). Monad m => Maybe' a -> a -> m (Maybe' a)
step_ (Maybe' a -> m (Maybe' a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe' a
forall a. Maybe' a
Nothing') (Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a))
-> (Maybe' a -> Maybe a) -> Maybe' a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe' a -> Maybe a
forall a. Maybe' a -> Maybe a
toMaybe)
  where
    step_ :: Maybe' a -> a -> m (Maybe' a)
step_ Maybe' a
mx a
a = Maybe' a -> m (Maybe' a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe' a -> m (Maybe' a)) -> Maybe' a -> m (Maybe' a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe' a
forall a. a -> Maybe' a
Just' (a -> Maybe' a) -> a -> Maybe' a
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 :: Fold m a ()
drain = (() -> a -> m ()) -> m () -> (() -> m ()) -> Fold m a ()
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold () -> a -> m ()
forall (m :: * -> *) p p. Monad m => p -> p -> m ()
step m ()
begin () -> m ()
forall a. a -> m a
done
    where
    begin :: m ()
begin = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    step :: p -> p -> m ()
step p
_ p
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    done :: a -> m a
done = a -> m a
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 :: (a -> m b) -> Fold m a ()
drainBy a -> m b
f = (() -> a -> m ()) -> m () -> (() -> m ()) -> Fold m a ()
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold ((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)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return

{-# 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.
--
-- @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)
_Fold1 ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
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 :: Fold m a b
genericLength = (b -> a -> m b) -> m b -> (b -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\b
n 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
n b -> b -> b
forall a. Num a => a -> a -> a
+ b
1) (b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
0) b -> m b
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 :: 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.
--
-- @since 0.7.0
{-# INLINABLE sum #-}
sum :: (Monad m, Num a) => Fold m a a
sum :: Fold m a a
sum = (a -> a -> m a) -> m a -> (a -> m a) -> Fold m a a
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\a
x a
a -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
a) (a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
0) a -> m a
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 :: Fold m a a
product = (a -> a -> m a) -> m a -> (a -> m a) -> Fold m a a
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\a
x a
a -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
a) (a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
1) a -> m a
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 :: (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)
_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 :: 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)
_Fold1 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
{-# INLINABLE 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)
_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 :: 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)
_Fold1 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 -> m (Tuple' a a))
-> m (Tuple' a a) -> (Tuple' a a -> m a) -> Fold m a a
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Tuple' a a -> a -> m (Tuple' a a)
forall (m :: * -> *) b.
(Monad m, Fractional b) =>
Tuple' b b -> b -> m (Tuple' b b)
step (Tuple' a a -> m (Tuple' a a)
forall (m :: * -> *) a. Monad m => a -> m a
return Tuple' a a
begin) (a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (Tuple' a a -> a) -> Tuple' a a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuple' a a -> a
forall a b. Tuple' a b -> a
done)
  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 -> m (Tuple' b b)
step (Tuple' b
x b
n) b
y = Tuple' b b -> m (Tuple' b b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple' b b -> m (Tuple' b b)) -> Tuple' b b -> m (Tuple' b b)
forall a b. (a -> b) -> a -> b
$
        let n' :: b
n' = 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
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 :: Fold m a a
variance = (Tuple3' a a a -> a -> m (Tuple3' a a a))
-> m (Tuple3' a a a) -> (Tuple3' a a a -> m a) -> Fold m a a
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Tuple3' a a a -> a -> m (Tuple3' a a a)
forall (m :: * -> *) b.
(Monad m, Fractional b) =>
Tuple3' b b b -> b -> m (Tuple3' b b b)
step (Tuple3' a a a -> m (Tuple3' a a a)
forall (m :: * -> *) a. Monad m => a -> m a
return Tuple3' a a a
begin) (a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> (Tuple3' a a a -> a) -> Tuple3' a a a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuple3' a a a -> a
forall a b. Fractional a => Tuple3' a b a -> a
done)
  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 -> m (Tuple3' b b b)
step (Tuple3' b
n b
mean_ b
m2) b
x = Tuple3' b b b -> m (Tuple3' b b b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Tuple3' b b b -> m (Tuple3' b b b))
-> Tuple3' b b b -> m (Tuple3' b b b)
forall a b. (a -> b) -> a -> b
$ 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 = Fold m a a -> Fold m a a
forall a. Floating a => a -> a
sqrt 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.7.0
{-# INLINABLE rollingHashWithSalt #-}
rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64
rollingHashWithSalt :: Int64 -> Fold m a Int64
rollingHashWithSalt Int64
salt = (Int64 -> a -> m Int64)
-> m Int64 -> (Int64 -> m Int64) -> Fold m a Int64
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Int64 -> a -> m Int64
forall (m :: * -> *) a. (Monad m, Enum a) => Int64 -> a -> m Int64
step m Int64
initial Int64 -> m Int64
forall a. a -> m a
extract
    where
    k :: Int64
k = Int64
2891336453 :: Int64
    initial :: m Int64
initial = Int64 -> m Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
salt
    step :: Int64 -> a -> m Int64
step Int64
cksum a
a = Int64 -> m Int64
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> m Int64) -> Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ 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)
    extract :: a -> m a
extract = a -> m a
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 :: 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 = ltake n rollingHash
{-# 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
ltake Int
n Fold m a Int64
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 :: Fold m a a
mconcat = (a -> a -> m a) -> m a -> (a -> m a) -> Fold m a a
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\a
x a
a -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
x a
a) (a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
forall a. Monoid a => a
mempty) a -> m a
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 :: (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 = 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 :: (a -> m b) -> Fold m a b
foldMapM a -> m b
act = (b -> a -> m b) -> m b -> (b -> m b) -> Fold m a b
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 b -> m b
forall a. a -> m a
done
    where
    done :: a -> m a
done = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    begin :: m b
begin = b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
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
        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
------------------------------------------------------------------------------

-- | 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 :: Fold m a [a]
toList = (([a] -> [a]) -> a -> m ([a] -> [a]))
-> m ([a] -> [a]) -> (([a] -> [a]) -> m [a]) -> Fold m a [a]
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\[a] -> [a]
f a
x -> ([a] -> [a]) -> m ([a] -> [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (([a] -> [a]) -> m ([a] -> [a])) -> ([a] -> [a]) -> m ([a] -> [a])
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
f ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
:))
              (([a] -> [a]) -> m ([a] -> [a])
forall (m :: * -> *) a. Monad m => a -> m a
return [a] -> [a]
forall a. a -> a
id)
              ([a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> (([a] -> [a]) -> [a]) -> ([a] -> [a]) -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([a] -> [a]) -> [a] -> [a]
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 :: 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
ltake Int
n Fold m a ()
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 :: (a -> Bool) -> Fold m a ()
drainWhile a -> Bool
p = (a -> Bool) -> Fold m a () -> Fold m a ()
forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Fold m a b
ltakeWhile a -> Bool
p Fold m a ()
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 :: i -> Fold m a (Maybe a)
genericIndex i
i = (Either' i a -> a -> m (Either' i a))
-> m (Either' i a)
-> (Either' i a -> m (Maybe a))
-> Fold m a (Maybe a)
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Either' i a -> a -> m (Either' i a)
forall (m :: * -> *) b.
Monad m =>
Either' i b -> b -> m (Either' i b)
step (Either' i a -> m (Either' i a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either' i a -> m (Either' i a)) -> Either' i a -> m (Either' i a)
forall a b. (a -> b) -> a -> b
$ i -> Either' i a
forall a b. a -> Either' a b
Left' i
0) Either' i a -> m (Maybe a)
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 = Either' i b -> m (Either' i b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either' i b -> m (Either' i b)) -> Either' i b -> m (Either' i b)
forall a b. (a -> b) -> a -> b
$
        case Either' i b
x of
            Left'  i
j -> if i
i i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
j
                        then b -> Either' i b
forall a b. b -> Either' a b
Right' b
a
                        else i -> Either' i b
forall a b. a -> Either' a b
Left' (i
j i -> i -> i
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 = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$
        case Either' a a
x of
            Left'  a
_ -> Maybe a
forall a. Maybe a
Nothing
            Right' a
a -> a -> Maybe 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 :: 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 = (a -> a -> a) -> Fold m a (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
_Fold1 a -> a -> a
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 :: (a -> Bool) -> Fold m a (Maybe a)
find a -> Bool
predicate = (Maybe' a -> a -> m (Maybe' a))
-> m (Maybe' a) -> (Maybe' a -> m (Maybe a)) -> Fold m a (Maybe a)
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Maybe' a -> a -> m (Maybe' a)
forall (m :: * -> *). Monad m => Maybe' a -> a -> m (Maybe' a)
step (Maybe' a -> m (Maybe' a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe' a
forall a. Maybe' a
Nothing') (Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a))
-> (Maybe' a -> Maybe a) -> Maybe' a -> m (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe' a -> Maybe a
forall a. Maybe' a -> Maybe a
toMaybe)
  where
    step :: Maybe' a -> a -> m (Maybe' a)
step Maybe' a
x a
a = Maybe' a -> m (Maybe' a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe' a -> m (Maybe' a)) -> Maybe' a -> m (Maybe' a)
forall a b. (a -> b) -> a -> b
$
        case Maybe' a
x of
            Maybe' a
Nothing' -> if a -> Bool
predicate a
a
                        then a -> Maybe' a
forall a. a -> Maybe' a
Just' a
a
                        else Maybe' a
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 :: a -> Fold m (a, b) (Maybe b)
lookup a
a0 = (Maybe' b -> (a, b) -> m (Maybe' b))
-> m (Maybe' b)
-> (Maybe' b -> m (Maybe b))
-> Fold m (a, b) (Maybe b)
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Maybe' b -> (a, b) -> m (Maybe' b)
forall (m :: * -> *) a.
Monad m =>
Maybe' a -> (a, a) -> m (Maybe' a)
step (Maybe' b -> m (Maybe' b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe' b
forall a. Maybe' a
Nothing') (Maybe b -> m (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> m (Maybe b))
-> (Maybe' b -> Maybe b) -> Maybe' b -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe' b -> Maybe b
forall a. Maybe' a -> Maybe a
toMaybe)
  where
    step :: Maybe' a -> (a, a) -> m (Maybe' a)
step Maybe' a
x (a
a,a
b) = Maybe' a -> m (Maybe' a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe' a -> m (Maybe' a)) -> Maybe' a -> m (Maybe' a)
forall a b. (a -> b) -> a -> b
$
        case Maybe' a
x of
            Maybe' a
Nothing' -> if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a0
                        then a -> Maybe' a
forall a. a -> Maybe' a
Just' a
b
                        else Maybe' a
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 :: Either' a b -> Maybe b
hush (Left'  a
_) = Maybe b
forall a. Maybe a
Nothing
hush (Right' b
b) = b -> Maybe 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 :: (a -> Bool) -> Fold m a (Maybe Int)
findIndex a -> Bool
predicate = (Either' Int Int -> a -> m (Either' Int Int))
-> m (Either' Int Int)
-> (Either' Int Int -> m (Maybe Int))
-> Fold m a (Maybe Int)
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Either' Int Int -> a -> m (Either' Int Int)
forall (m :: * -> *) a.
(Monad m, Num a) =>
Either' a a -> a -> m (Either' a a)
step (Either' Int Int -> m (Either' Int Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either' Int Int -> m (Either' Int Int))
-> Either' Int Int -> m (Either' Int Int)
forall a b. (a -> b) -> a -> b
$ Int -> Either' Int Int
forall a b. a -> Either' a b
Left' Int
0) (Maybe Int -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Int -> m (Maybe Int))
-> (Either' Int Int -> Maybe Int)
-> Either' Int Int
-> m (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either' Int Int -> Maybe Int
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 = Either' a a -> m (Either' a a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either' a a -> m (Either' a a)) -> Either' a a -> m (Either' a a)
forall a b. (a -> b) -> a -> b
$
        case Either' a a
x of
            Left' a
i ->
                if a -> Bool
predicate a
a
                then a -> Either' a a
forall a b. b -> Either' a b
Right' a
i
                else a -> Either' a a
forall a b. a -> Either' a b
Left' (a
i a -> a -> a
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 :: 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.
--
-- @since 0.7.0
{-# INLINABLE null #-}
null :: Monad m => Fold m a Bool
null :: Fold m a Bool
null = (Bool -> a -> m Bool)
-> m Bool -> (Bool -> m Bool) -> Fold m a Bool
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\Bool
_ a
_ -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) Bool -> m Bool
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 :: (a -> Bool) -> Fold m a Bool
any a -> Bool
predicate = (Bool -> a -> m Bool)
-> m Bool -> (Bool -> m Bool) -> Fold m a Bool
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\Bool
x a
a -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool
x Bool -> Bool -> Bool
|| a -> Bool
predicate a
a) (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) Bool -> m Bool
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 :: 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
==)

-- |
-- > 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 :: (a -> Bool) -> Fold m a Bool
all a -> Bool
predicate = (Bool -> a -> m Bool)
-> m Bool -> (Bool -> m Bool) -> Fold m a Bool
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\Bool
x a
a -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool
x Bool -> Bool -> Bool
&& a -> Bool
predicate a
a) (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) Bool -> m Bool
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 :: 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
--
-- @since 0.7.0
{-# INLINABLE and #-}
and :: Monad m => Fold m Bool Bool
and :: Fold m Bool Bool
and = (Bool -> Bool -> m Bool)
-> m Bool -> (Bool -> m Bool) -> Fold m Bool Bool
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\Bool
x Bool
a -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool
x Bool -> Bool -> Bool
&& Bool
a) (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) Bool -> m Bool
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 :: Fold m Bool Bool
or = (Bool -> Bool -> m Bool)
-> m Bool -> (Bool -> m Bool) -> Fold m Bool Bool
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold (\Bool
x Bool
a -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool
x Bool -> Bool -> Bool
|| Bool
a) (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False) Bool -> m Bool
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 :: 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) =
    (Tuple3' Int s s -> a -> m (Tuple3' Int s s))
-> m (Tuple3' Int s s)
-> (Tuple3' Int s s -> m (b, c))
-> Fold m a (b, c)
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Tuple3' Int s s -> a -> m (Tuple3' Int s s)
forall a. (Ord a, Num a) => Tuple3' a s s -> a -> m (Tuple3' a s s)
step m (Tuple3' Int s s)
initial Tuple3' Int s s -> m (b, c)
forall a. Tuple3' a s s -> m (b, c)
extract
    where
      initial :: m (Tuple3' Int s s)
initial  = Int -> s -> s -> Tuple3' Int s s
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (Int -> s -> s -> Tuple3' Int s s)
-> m Int -> m (s -> s -> Tuple3' Int s s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
n m (s -> s -> Tuple3' Int s s) -> m s -> m (s -> Tuple3' Int s s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m s
initialL m (s -> Tuple3' Int s s) -> m s -> m (Tuple3' Int s s)
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 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0
        then s -> a -> m s
stepL s
xL a
input m s -> (s -> m (Tuple3' a s s)) -> m (Tuple3' a s s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a -> Tuple3' a s s -> m (Tuple3' a s s)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> s -> s -> Tuple3' a s s
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (a
i a -> a -> a
forall a. Num a => a -> a -> a
- a
1) s
a s
xR))
        else s -> a -> m s
stepR s
xR a
input m s -> (s -> m (Tuple3' a s s)) -> m (Tuple3' a s s)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
b -> Tuple3' a s s -> m (Tuple3' a s s)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> s -> s -> Tuple3' a s s
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) = (,) (b -> c -> (b, c)) -> m b -> m (c -> (b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
a m (c -> (b, c)) -> m c -> m (b, c)
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 :: (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) =
    (Tuple3' s s (Tuple' (Maybe a) Bool)
 -> a -> m (Tuple3' s s (Tuple' (Maybe a) Bool)))
-> m (Tuple3' s s (Tuple' (Maybe a) Bool))
-> (Tuple3' s s (Tuple' (Maybe a) Bool) -> m (b, c))
-> Fold m a (b, c)
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 m (Tuple3' s s (Tuple' (Maybe a) Bool))
forall a. m (Tuple3' s s (Tuple' (Maybe a) Bool))
initial Tuple3' s s (Tuple' (Maybe a) Bool) -> m (b, c)
forall c. Tuple3' s s c -> m (b, c)
extract

    where
      initial :: m (Tuple3' s s (Tuple' (Maybe a) Bool))
initial = s
-> s
-> Tuple' (Maybe a) Bool
-> Tuple3' s s (Tuple' (Maybe a) Bool)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (s
 -> s
 -> Tuple' (Maybe a) Bool
 -> Tuple3' s s (Tuple' (Maybe a) Bool))
-> m s
-> m (s
      -> Tuple' (Maybe a) Bool -> Tuple3' s s (Tuple' (Maybe a) Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
initialL m (s
   -> Tuple' (Maybe a) Bool -> Tuple3' s s (Tuple' (Maybe a) Bool))
-> m s
-> m (Tuple' (Maybe a) Bool -> Tuple3' s s (Tuple' (Maybe a) Bool))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m s
initialR m (Tuple' (Maybe a) Bool -> Tuple3' s s (Tuple' (Maybe a) Bool))
-> m (Tuple' (Maybe a) Bool)
-> m (Tuple3' s s (Tuple' (Maybe a) Bool))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Tuple' (Maybe a) Bool -> m (Tuple' (Maybe a) Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> Bool -> Tuple' (Maybe a) Bool
forall a b. a -> b -> Tuple' a b
Tuple' Maybe a
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
              m s
-> (s -> m (Tuple3' s s (Tuple' (Maybe a) Bool)))
-> m (Tuple3' s s (Tuple' (Maybe a) Bool))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> Tuple3' s s (Tuple' (Maybe a) Bool)
-> m (Tuple3' s s (Tuple' (Maybe a) Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return (s
-> s
-> Tuple' (Maybe a) Bool
-> Tuple3' s s (Tuple' (Maybe a) Bool)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a' s
b (Maybe a -> Bool -> Tuple' (Maybe a) Bool
forall a b. a -> b -> Tuple' a b
Tuple' (a -> Maybe a
forall a. a -> Maybe a
Just a
frst) Bool
isFirstG)))
        else s -> a -> m s
stepR s
b a
input
              m s
-> (s -> m (Tuple3' s s (Tuple' (Maybe a) Bool)))
-> m (Tuple3' s s (Tuple' (Maybe a) Bool))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> Tuple3' s s (Tuple' (Maybe a) Bool)
-> m (Tuple3' s s (Tuple' (Maybe a) Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return (s
-> s
-> Tuple' (Maybe a) Bool
-> Tuple3' s s (Tuple' (Maybe a) Bool)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a s
a' (Maybe a -> Bool -> Tuple' (Maybe a) Bool
forall a b. a -> b -> Tuple' a b
Tuple' Maybe a
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
              m s
-> (s -> m (Tuple3' s s (Tuple' (Maybe a) Bool)))
-> m (Tuple3' s s (Tuple' (Maybe a) Bool))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> Tuple3' s s (Tuple' (Maybe a) Bool)
-> m (Tuple3' s s (Tuple' (Maybe a) Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return (s
-> s
-> Tuple' (Maybe a) Bool
-> Tuple3' s s (Tuple' (Maybe a) Bool)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a' s
b (Maybe a -> Bool -> Tuple' (Maybe a) Bool
forall a b. a -> b -> Tuple' a b
Tuple' (a -> Maybe a
forall a. a -> Maybe a
Just a
input) Bool
isFirstG)))
        else s -> a -> m s
stepR s
b a
input
              m s
-> (s -> m (Tuple3' s s (Tuple' (Maybe a) Bool)))
-> m (Tuple3' s s (Tuple' (Maybe a) Bool))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> Tuple3' s s (Tuple' (Maybe a) Bool)
-> m (Tuple3' s s (Tuple' (Maybe a) Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return (s
-> s
-> Tuple' (Maybe a) Bool
-> Tuple3' s s (Tuple' (Maybe a) Bool)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a s
a' (Maybe a -> Bool -> Tuple' (Maybe a) Bool
forall a b. a -> b -> Tuple' a b
Tuple' Maybe a
forall a. Maybe a
Nothing Bool
False)))

      extract :: Tuple3' s s c -> m (b, c)
extract (Tuple3' s
a s
b c
_) = (,) (b -> c -> (b, c)) -> m b -> m (c -> (b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
a m (c -> (b, c)) -> m c -> m (b, c)
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 :: (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) =
    (Tuple3' s s Bool -> a -> m (Tuple3' s s Bool))
-> m (Tuple3' s s Bool)
-> (Tuple3' s s Bool -> m (b, c))
-> Fold m a (b, c)
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 Tuple3' s s Bool -> m (b, c)
forall c. Tuple3' s s c -> m (b, c)
extract

    where

    initial :: m (Tuple3' s s Bool)
initial = s -> s -> Bool -> Tuple3' s s Bool
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (s -> s -> Bool -> Tuple3' s s Bool)
-> m s -> m (s -> Bool -> Tuple3' s s Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
initialL m (s -> Bool -> Tuple3' s s Bool)
-> m s -> m (Bool -> Tuple3' s s Bool)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m s
initialR m (Bool -> Tuple3' s s Bool) -> m Bool -> m (Tuple3' s s Bool)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> m Bool
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 m s -> (s -> m (Tuple3' s s Bool)) -> m (Tuple3' s s Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> Tuple3' s s Bool -> m (Tuple3' s s Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> s -> Bool -> Tuple3' s s Bool
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 m s -> (s -> m (Tuple3' s s Bool)) -> m (Tuple3' s s Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> Tuple3' s s Bool -> m (Tuple3' s s Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> s -> Bool -> Tuple3' s s Bool
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
_) = (,) (b -> c -> (b, c)) -> m b -> m (c -> (b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
a m (c -> (b, c)) -> m c -> m (b, c)
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 :: (a -> Bool) -> Fold m a b -> Fold m a c -> Fold m a (b, c)
break a -> Bool
p = (a -> Bool) -> Fold m a b -> Fold m a c -> Fold m a (b, c)
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 (Bool -> Bool) -> (a -> Bool) -> a -> Bool
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 :: (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) =
    (Tuple3' s s (Maybe a) -> a -> m (Tuple3' s s (Maybe a)))
-> m (Tuple3' s s (Maybe a))
-> (Tuple3' s s (Maybe a) -> m (b, c))
-> Fold m a (b, c)
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 m (Tuple3' s s (Maybe a))
forall a. m (Tuple3' s s (Maybe a))
initial Tuple3' s s (Maybe a) -> m (b, c)
forall c. Tuple3' s s c -> m (b, c)
extract

  where
    initial :: m (Tuple3' s s (Maybe a))
initial = s -> s -> Maybe a -> Tuple3' s s (Maybe a)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' (s -> s -> Maybe a -> Tuple3' s s (Maybe a))
-> m s -> m (s -> Maybe a -> Tuple3' s s (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
initialL m (s -> Maybe a -> Tuple3' s s (Maybe a))
-> m s -> m (Maybe a -> Tuple3' s s (Maybe a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m s
initialR m (Maybe a -> Tuple3' s s (Maybe a))
-> m (Maybe a) -> m (Tuple3' s s (Maybe a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
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 m s
-> (s -> m (Tuple3' s s (Maybe a))) -> m (Tuple3' s s (Maybe a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> Tuple3' s s (Maybe a) -> m (Tuple3' s s (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> s -> Maybe a -> Tuple3' s s (Maybe a)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a' s
b (a -> Maybe a
forall a. a -> Maybe a
Just a
input)))
      else s -> a -> m s
stepR s
b a
input m s
-> (s -> m (Tuple3' s s (Maybe a))) -> m (Tuple3' s s (Maybe a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
b' -> Tuple3' s s (Maybe a) -> m (Tuple3' s s (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> s -> Maybe a -> Tuple3' s s (Maybe a)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a s
b' (a -> Maybe a
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 m s
-> (s -> m (Tuple3' s s (Maybe a))) -> m (Tuple3' s s (Maybe a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\s
a' -> Tuple3' s s (Maybe a) -> m (Tuple3' s s (Maybe a))
forall (m :: * -> *) a. Monad m => a -> m a
return (s -> s -> Maybe a -> Tuple3' s s (Maybe a)
forall a b c. a -> b -> c -> Tuple3' a b c
Tuple3' s
a' s
b (a -> Maybe a
forall a. a -> Maybe a
Just a
input)))

    extract :: Tuple3' s s c -> m (b, c)
extract (Tuple3' s
a s
b c
_) = (,) (b -> c -> (b, c)) -> m b -> m (c -> (b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
extractL s
a m (c -> (b, c)) -> m c -> m (b, c)
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 :: Fold m a b -> Fold m a c -> Fold m a (b, c)
tee Fold m a b
f1 Fold m a c
f2 = (,) (b -> c -> (b, c)) -> Fold m a b -> Fold m a (c -> (b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold m a b
f1 Fold m a (c -> (b, c)) -> Fold m a c -> Fold m a (b, c)
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 :: Fold m a [b]
foldNil = ([b] -> a -> m [b]) -> m [b] -> ([b] -> m [b]) -> Fold m a [b]
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold [b] -> a -> m [b]
forall (m :: * -> *) p p a. Monad m => p -> p -> m [a]
step m [b]
forall a. m [a]
begin [b] -> m [b]
forall a. a -> m a
done  where
  begin :: m [a]
begin = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  step :: p -> p -> m [a]
step p
_ p
_ = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
  done :: a -> m a
done = a -> m a
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 :: 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) =
    (Tuple' s s -> a -> m (Tuple' s s))
-> m (Tuple' s s) -> (Tuple' s s -> m [b]) -> Fold m a [b]
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 = s -> s -> Tuple' s s
forall a b. a -> b -> Tuple' a b
Tuple' (s -> s -> Tuple' s s) -> m s -> m (s -> Tuple' s s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
beginL m (s -> Tuple' s s) -> m s -> m (Tuple' s s)
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 = s -> s -> Tuple' s s
forall a b. a -> b -> Tuple' a b
Tuple' (s -> s -> Tuple' s s) -> m s -> m (s -> Tuple' s s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> a -> m s
stepL s
xL a
a m (s -> Tuple' s s) -> m s -> m (Tuple' s s)
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) = (:) (b -> [b] -> [b]) -> m b -> m ([b] -> [b])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (s -> m b
doneL s
xL) m ([b] -> [b]) -> m [b] -> m [b]
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 :: [Fold m a b] -> Fold m a [b]
distribute [] = Fold m a [b]
forall (m :: * -> *) a b. Monad m => Fold m a [b]
foldNil
distribute (Fold m a b
x:[Fold m a b]
xs) = Fold m a b -> Fold m a [b] -> Fold m a [b]
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Fold m a [b] -> Fold m a [b]
foldCons Fold m a b
x ([Fold m a b] -> Fold m a [b]
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_ :: [Fold m a ()] -> Fold m a ()
distribute_ [Fold m a ()]
fs = ([Fold m a ()] -> a -> m [Fold m a ()])
-> m [Fold m a ()] -> ([Fold m a ()] -> m ()) -> Fold m a ()
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold [Fold m a ()] -> a -> m [Fold m a ()]
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 [Fold m a ()] -> m ()
forall (m :: * -> *) (t :: * -> *) a b.
(Foldable t, Monad m) =>
t (Fold m a b) -> m ()
extract
    where
    initial :: m [Fold m a ()]
initial    = (Fold m a () -> m (Fold m a ()))
-> [Fold m a ()] -> m [Fold m a ()]
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 m s -> (s -> m (Fold m a ())) -> m (Fold m a ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
r -> Fold m a () -> m (Fold m a ())
forall (m :: * -> *) a. Monad m => a -> m a
return ((s -> a -> m s) -> m s -> (s -> m ()) -> Fold m a ()
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold s -> a -> m s
s (s -> m 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
        (Fold m a b -> m ()) -> t (Fold m a b) -> m ()
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 m s -> (s -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
r -> s -> a -> m s
s s
r a
a m s -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) t (Fold m a b)
ss
        t (Fold m a b) -> m (t (Fold m a b))
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
        (Fold m a b -> m b) -> t (Fold m a b) -> m ()
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 m s -> (s -> m b) -> m b
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
        () -> m ()
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 :: (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) =

    (Tuple' s s -> a -> m (Tuple' s s))
-> m (Tuple' s s) -> (Tuple' s s -> m (x, y)) -> Fold m a (x, y)
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 = s -> s -> Tuple' s s
forall a b. a -> b -> Tuple' a b
Tuple' (s -> s -> Tuple' s s) -> m s -> m (s -> Tuple' s s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
beginL m (s -> Tuple' s s) -> m s -> m (Tuple' s s)
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 -> s -> s -> Tuple' s s
forall a b. a -> b -> Tuple' a b
Tuple' (s -> s -> Tuple' s s) -> m s -> m (s -> Tuple' s s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> b -> m s
stepL s
xL b
b m (s -> Tuple' s s) -> m s -> m (Tuple' s s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return s
xR
            Right c
c -> s -> s -> Tuple' s s
forall a b. a -> b -> Tuple' a b
Tuple' (s -> s -> Tuple' s s) -> m s -> m (s -> Tuple' s s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m s
forall (m :: * -> *) a. Monad m => a -> m a
return s
xL m (s -> Tuple' s s) -> m s -> m (Tuple' s s)
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) = (,) (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
xL 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
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 :: (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
--                             |
--                                       ...
-- @
--
-- @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 :: (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 (Fold m a' b) -> a -> m (Map k (Fold m a' b)))
-> m (Map k (Fold m a' b))
-> (Map k (Fold m a' b) -> m (Map k b))
-> Fold m a (Map k b)
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Map k (Fold m a' b) -> a -> m (Map k (Fold m a' b))
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 Map k (Fold m a' b) -> m (Map k b)
forall a b. Map k (Fold m a b) -> m (Map k b)
extract

    where

    initial :: m (Map k (Fold m a' b))
initial = Map k (Fold m a' b) -> m (Map k (Fold m a' b))
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') -> (Maybe (Fold f a' b) -> f (Maybe (Fold f a' b)))
-> k -> Map k (Fold f a' b) -> f (Map k (Fold f a' b))
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
Map.alterF Maybe (Fold f a' b) -> f (Maybe (Fold f a' b))
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 = Maybe (Fold f a' b) -> f (Maybe (Fold f a' b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Fold f a' b)
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 f s -> (s -> f s) -> f s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
x -> s -> a' -> f s
step' s
x a'
a'
            Maybe (Fold f a' b) -> f (Maybe (Fold f a' b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Fold f a' b) -> f (Maybe (Fold f a' b)))
-> (Fold f a' b -> Maybe (Fold f a' b))
-> Fold f a' b
-> f (Maybe (Fold f a' b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fold f a' b -> Maybe (Fold f a' b)
forall a. a -> Maybe a
Just (Fold f a' b -> f (Maybe (Fold f a' b)))
-> Fold f a' b -> f (Maybe (Fold f a' b))
forall a b. (a -> b) -> a -> b
$ (s -> a' -> f s) -> f s -> (s -> f b) -> Fold f 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' (s -> f s
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 = (Fold m a b -> m b) -> Map k (Fold m a b) -> m (Map k b)
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 m s -> (s -> m b) -> m b
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 :: 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

{-# 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_ :: (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) =
    (Tuple' (Map k (Fold m a' b)) s
 -> a -> m (Tuple' (Map k (Fold m a' b)) s))
-> m (Tuple' (Map k (Fold m a' b)) s)
-> (Tuple' (Map k (Fold m a' b)) s -> m ())
-> Fold m a ()
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Tuple' (Map k (Fold m a' b)) s
-> a -> m (Tuple' (Map k (Fold m a' b)) s)
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 Tuple' (Map k (Fold m a' b)) s -> m ()
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 m s -> (s -> m (Fold m a b)) -> m (Fold m a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
r -> Fold m a b -> m (Fold m a b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold s -> a -> m s
s (s -> m 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 <- (Fold m a' b -> m (Fold m a' b))
-> Map k (Fold m a' b) -> m (Map k (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 (Fold m a' b)
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
        Tuple' (Map k (Fold m a' b)) s
-> m (Tuple' (Map k (Fold m a' b)) s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k (Fold m a' b) -> s -> Tuple' (Map k (Fold m a' b)) s
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 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)
mp of
            Maybe (Fold m a' b)
Nothing -> do
                s
acc <- s -> (k, a') -> m s
dstep s
dacc (k
k, a'
a')
                Tuple' (Map k (Fold m a' b)) s
-> m (Tuple' (Map k (Fold m a' b)) s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k (Fold m a' b) -> s -> Tuple' (Map k (Fold m a' b)) s
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 m s -> (s -> m s) -> m s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
x -> s -> a' -> m s
step' s
x a'
a'
                Tuple' (Map k (Fold m a' b)) s
-> m (Tuple' (Map k (Fold m a' b)) s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k (Fold m a' b) -> s -> Tuple' (Map k (Fold m a' b)) s
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
        m b -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m b -> m ()) -> m b -> m ()
forall a b. (a -> b) -> a -> b
$ s -> m b
dextract s
dacc
        (Fold m a b -> m b) -> t (Fold m a b) -> m ()
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 m s -> (s -> m b) -> m b
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_ :: (a -> (k, a')) -> Map k (Fold m a' b) -> Fold m a ()
demuxWith_ a -> (k, a')
f Map k (Fold m a' b)
kv = (Map k (Fold m a' b) -> a -> m (Map k (Fold m a' b)))
-> m (Map k (Fold m a' b))
-> (Map k (Fold m a' b) -> m ())
-> Fold m a ()
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Map k (Fold m a' b) -> a -> m (Map k (Fold m a' b))
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 Map k (Fold m a' b) -> m ()
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
        (Fold m a' b -> m (Fold m a' b))
-> Map k (Fold m a' b) -> m (Map k (Fold m a' b))
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 m s -> (s -> m (Fold m a' b)) -> m (Fold m a' b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
r -> Fold m a' b -> m (Fold m a' b)
forall (m :: * -> *) a. Monad m => a -> m a
return ((s -> a' -> m s) -> m s -> (s -> m b) -> Fold m a' b
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold s -> a' -> m s
s (s -> m 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 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)
mp of
            Maybe (Fold m a' b)
Nothing -> Map k (Fold m a' b) -> m (Map k (Fold m a' b))
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 m s -> (s -> m s) -> m s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
x -> s -> a' -> m s
step' s
x a'
a'
                Map k (Fold m a' b) -> m (Map k (Fold m a' b))
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 = (Fold m a b -> m b) -> t (Fold m a b) -> m ()
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 m s -> (s -> m b) -> m b
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_ :: Map k (Fold m a ()) -> Fold m (k, a) ()
demux_ = ((k, a) -> (k, a)) -> Map k (Fold m a ()) -> Fold m (k, a) ()
forall (m :: * -> *) k a a' b.
(Monad m, Ord k) =>
(a -> (k, a')) -> Map k (Fold m a' b) -> Fold m a ()
demuxWith_ (k, a) -> (k, a)
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_ :: Map k (Fold m a ()) -> Fold m (k, a) () -> Fold m (k, a) ()
demuxDefault_ = ((k, a) -> (k, a))
-> Map k (Fold m a ()) -> Fold m (k, a) () -> Fold m (k, a) ()
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_ (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 = 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 :: (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) = (Map k s -> a -> m (Map k s))
-> m (Map k s) -> (Map k s -> m (Map k b)) -> Fold m a (Map k b)
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' m (Map k s)
forall k a. m (Map k a)
initial' Map k s -> m (Map k b)
extract'

    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 s -> a -> m (Map k s)
step' Map k s
kv a
a =
        let k :: k
k = a -> k
f a
a
        in case k -> Map k s -> Maybe s
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
                Map k s -> m (Map k s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k s -> m (Map k s)) -> Map k s -> m (Map k s)
forall a b. (a -> b) -> a -> b
$ k -> s -> Map k s -> Map k s
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
                Map k s -> m (Map k s)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k s -> m (Map k s)) -> Map k s -> m (Map k s)
forall a b. (a -> b) -> a -> b
$ k -> s -> Map k s -> Map k s
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' = (s -> m b) -> Map k s -> m (Map k b)
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 :: 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
lmap (k, a) -> a
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 :: (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) =
    (Tuple' s s -> a -> m (Tuple' s s))
-> m (Tuple' s s) -> (Tuple' s s -> m (x, y)) -> Fold m a (x, y)
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
        s -> s -> Tuple' s s
forall a b. a -> b -> Tuple' a b
Tuple' (s -> s -> Tuple' s s) -> m s -> m (s -> Tuple' s s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> b -> m s
stepL s
xL b
b m (s -> Tuple' s s) -> m s -> m (Tuple' s s)
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 = s -> s -> Tuple' s s
forall a b. a -> b -> Tuple' a b
Tuple' (s -> s -> Tuple' s s) -> m s -> m (s -> Tuple' s s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m s
beginL m (s -> Tuple' s s) -> m s -> m (Tuple' s s)
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) = (,) (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
xL 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
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 :: (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--------|
--
-- @
--
-- 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

------------------------------------------------------------------------------
-- 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 :: Fold m a b -> Fold m b c -> Fold m a c
foldChunks = Fold m a b -> Fold m b c -> Fold m a c
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 :: SVar t m a -> Maybe WorkerInfo -> Fold m a ()
toParallelSVar SVar t m a
svar Maybe WorkerInfo
winfo = (() -> a -> m ()) -> m () -> (() -> m ()) -> Fold m a ()
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold () -> a -> m ()
forall (m :: * -> *). MonadIO m => () -> a -> m ()
step m ()
initial () -> m ()
forall (m :: * -> *). MonadIO m => () -> m ()
extract
    where

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

    step :: () -> a -> m ()
step () a
x = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
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.
        SVar t m a -> IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> IO ()
decrementBufferLimit SVar t m a
svar
        IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ SVar t m a -> ChildEvent a -> IO Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
SVar t m a -> ChildEvent a -> IO Int
send SVar t m a
svar (a -> ChildEvent a
forall a. a -> ChildEvent a
ChildYield a
x)

    extract :: () -> m ()
extract () = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        SVar t m a -> Maybe WorkerInfo -> IO ()
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 :: SVar t m a -> Maybe WorkerInfo -> Fold m a ()
toParallelSVarLimited SVar t m a
svar Maybe WorkerInfo
winfo = (Bool -> a -> m Bool) -> m Bool -> (Bool -> m ()) -> Fold m a ()
forall (m :: * -> *) a b s.
(s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b
Fold Bool -> a -> m Bool
forall (m :: * -> *). MonadIO m => Bool -> a -> m Bool
step m Bool
initial Bool -> m ()
forall (m :: * -> *). MonadIO m => Bool -> m ()
extract
    where

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

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

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