{-# LANGUAGE CPP #-}
-- |
-- Module      : Streamly.Internal.Data.Fold.Combinators
-- Copyright   : (c) 2019 Composewell Technologies
--               (c) 2013 Gabriel Gonzalez
-- License     : BSD3
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- See "Streamly.Data.Fold" for an overview and
-- "Streamly.Internal.Data.Fold.Type" for design notes.

module Streamly.Internal.Data.Fold.Combinators
    (
    -- * Mappers
    -- | Monadic functions useful with mapM/lmapM on folds or streams.
      tracing
    , trace

    -- * Folds

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

    -- *** Reducers
    , drainMapM
    , the
    , mean
    , rollingHash
    , Scanl.defaultSalt
    , rollingHashWithSalt
    , rollingHashFirstN
    -- , rollingHashLastN

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

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

    -- *** Scanners
    -- | Stateful transformation of the elements. Useful in combination with
    -- the 'scanMaybe' combinator. For scanners the result of the fold is
    -- usually a transformation of the current element rather than an
    -- aggregation of all elements till now.
 -- , nthLast -- using RingArray array
    , rollingMap
    , rollingMapM

    -- *** Filters

    -- XXX deprecate these in favor of corresponding scans

    -- | Useful in combination with the 'scanMaybe' combinator.
    , deleteBy
    , uniqBy
    , uniq
    , repeated
    , findIndices
    , elemIndices

    -- *** Singleton folds
    -- | Folds that terminate after consuming exactly one input element. All
    -- these can be implemented in terms of the 'maybe' fold.
    , one
    , null -- XXX not very useful and could be problematic, remove it?
    , satisfy
    , maybe

    -- *** Multi folds
    -- | Terminate after consuming one or more elements.
    , drainN
    -- , lastN
    -- , (!!)
    , genericIndex
    , index
    , findM
    , find
    , lookup
    , findIndex
    , elemIndex
    , elem
    , notElem
    , all
    , any
    , and
    , or

    -- ** Trimmers
    -- | Useful in combination with the 'scanMaybe' combinator.
    , takingEndByM
    , takingEndBy
    , takingEndByM_
    , takingEndBy_
    , droppingWhileM
    , droppingWhile
    , prune

    -- * Running A Fold
    , drive
    -- , breakStream

    -- * Building Incrementally
    , addStream

    -- * Combinators
    -- ** Utilities
    , with

    -- ** Sliding Window
    , slide2

    -- ** Scanning Input
    , pipe
    , indexed

    -- ** Zipping Input
    , zipStreamWithM
    , zipStream

    -- ** Filtering Input
    , mapMaybeM
    , mapMaybe
    , sampleFromthen

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

    , insertBy
    , intersperseM

    -- ** Reordering
    , reverse
    -}

    -- ** Trimming

    -- By elements
    , takeEndBySeq
    , takeEndBySeq_
    {-
    , drop
    , dropWhile
    , dropWhileM
    -}

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

    -- ** Parallel Distribution
    , tee
    , distribute
    , distributeScan
    -- , distributeFst
    -- , distributeMin

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

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

    -- ** Splitting
    , chunksBetween
    , intersperseWithQuotes

    -- ** Nesting
    , unfoldMany
    , concatSequence

    -- * Deprecated
    , drainBy
    , head
    , sequence
    , mapM
    , variance
    , stdDev
    , indexingWith
    , indexing
    , indexingRev
    )
where

#include "inline.hs"
#include "ArrayMacros.h"

import Control.Monad (void)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Bifunctor (first)
import Data.Bits (shiftL, shiftR, (.|.), (.&.))
import Data.Either (isLeft, isRight, fromLeft, fromRight)
import Data.Int (Int64)
import Data.Proxy (Proxy(..))
import Data.Word (Word32)
import Streamly.Internal.Data.Array.Type (Array(..))
import Streamly.Internal.Data.Scanl.Type (Scanl(..))
import Streamly.Internal.Data.Unbox (Unbox(..))
import Streamly.Internal.Data.MutArray.Type (MutArray(..))
import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)
import Streamly.Internal.Data.Pipe.Type (Pipe (..))
import Streamly.Internal.Data.RingArray (RingArray(..))
-- import Streamly.Internal.Data.Scan (Scan (..))
import Streamly.Internal.Data.Stream.Type (Stream)
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))

import qualified Prelude
import qualified Streamly.Internal.Data.MutArray.Type as MA
import qualified Streamly.Internal.Data.Array.Type as Array
import qualified Streamly.Internal.Data.Pipe.Type as Pipe
import qualified Streamly.Internal.Data.RingArray as RingArray
import qualified Streamly.Internal.Data.Scanl.Combinators as Scanl
import qualified Streamly.Internal.Data.Scanl.Type as Scanl
import qualified Streamly.Internal.Data.Stream.Type as StreamD

import Prelude hiding
       ( Foldable(..), filter, drop, dropWhile, take, takeWhile, zipWith
       , map, mapM_, sequence, all, any
       , notElem, head, last, tail
       , reverse, iterate, init, and, or, lookup, (!!)
       , scanl, scanl1, replicate, concatMap, mconcat, unzip
       , span, splitAt, break, mapM, zip, maybe)
import Streamly.Internal.Data.Fold.Type

#include "DocTestDataFold.hs"

------------------------------------------------------------------------------
-- Running
------------------------------------------------------------------------------

-- | Drive a fold using the supplied 'Stream', reducing the resulting
-- expression strictly at each step.
--
-- Definition:
--
-- >>> drive = flip Stream.fold
--
-- Example:
--
-- >>> Fold.drive (Stream.enumerateFromTo 1 100) Fold.sum
-- 5050
--
{-# INLINE drive #-}
drive :: Monad m => Stream m a -> Fold m a b -> m b
drive :: forall (m :: * -> *) a b.
Monad m =>
Stream m a -> Fold m a b -> m b
drive = (Fold m a b -> Stream m a -> m b)
-> Stream m a -> Fold m a b -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip Fold m a b -> Stream m a -> m b
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Stream m a -> m b
StreamD.fold

{-
-- | Like 'drive' but also returns the remaining stream. The resulting stream
-- would be 'Stream.nil' if the stream finished before the fold.
--
-- Definition:
--
-- >>> breakStream = flip Stream.foldBreak
--
-- /CPS/
--
{-# INLINE breakStreamK #-}
breakStreamK :: Monad m => StreamK m a -> Fold m a b -> m (b, StreamK m a)
breakStreamK strm fl = fmap f $ K.foldBreak fl (Stream.toStreamK strm)

    where

    f (b, str) = (b, Stream.fromStreamK str)
-}

-- | Append a stream to a fold to build the fold accumulator incrementally. We
-- can repeatedly call 'addStream' on the same fold to continue building the
-- fold and finally use 'drive' to finish the fold and extract the result. Also
-- see the 'Streamly.Data.Fold.addOne' operation which is a singleton version
-- of 'addStream'.
--
-- Definitions:
--
-- >>> addStream stream = Fold.drive stream . Fold.duplicate
--
-- Example, build a list incrementally:
--
-- >>> :{
-- pure (Fold.toList :: Fold IO Int [Int])
--     >>= Fold.addOne 1
--     >>= Fold.addStream (Stream.enumerateFromTo 2 4)
--     >>= Fold.drive Stream.nil
--     >>= print
-- :}
-- [1,2,3,4]
--
-- This can be used as an O(n) list append compared to the O(n^2) @++@ when
-- used for incrementally building a list.
--
-- Example, build a stream incrementally:
--
-- >>> :{
-- pure (Fold.toStream :: Fold IO Int (Stream Identity Int))
--     >>= Fold.addOne 1
--     >>= Fold.addStream (Stream.enumerateFromTo 2 4)
--     >>= Fold.drive Stream.nil
--     >>= print
-- :}
-- fromList [1,2,3,4]
--
-- This can be used as an O(n) stream append compared to the O(n^2) @<>@ when
-- used for incrementally building a stream.
--
-- Example, build an array incrementally:
--
-- >>> :{
-- pure (Array.create :: Fold IO Int (Array Int))
--     >>= Fold.addOne 1
--     >>= Fold.addStream (Stream.enumerateFromTo 2 4)
--     >>= Fold.drive Stream.nil
--     >>= print
-- :}
-- fromList [1,2,3,4]
--
-- Example, build an array stream incrementally:
--
-- >>> :{
-- let f :: Fold IO Int (Stream Identity (Array Int))
--     f = Fold.groupsOf 2 (Array.createOf 3) Fold.toStream
-- in pure f
--     >>= Fold.addOne 1
--     >>= Fold.addStream (Stream.enumerateFromTo 2 4)
--     >>= Fold.drive Stream.nil
--     >>= print
-- :}
-- fromList [fromList [1,2],fromList [3,4]]
--
addStream :: Monad m => Stream m a -> Fold m a b -> m (Fold m a b)
addStream :: forall (m :: * -> *) a b.
Monad m =>
Stream m a -> Fold m a b -> m (Fold m a b)
addStream Stream m a
stream = Stream m a -> Fold m a (Fold m a b) -> m (Fold m a b)
forall (m :: * -> *) a b.
Monad m =>
Stream m a -> Fold m a b -> m b
drive Stream m a
stream (Fold m a (Fold m a b) -> m (Fold m a b))
-> (Fold m a b -> Fold m a (Fold m a b))
-> Fold m a b
-> m (Fold m a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fold m a b -> Fold m a (Fold m a b)
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Fold m a (Fold m a b)
duplicate

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

-- | Flatten the monadic output of a fold to pure output.
--
{-# DEPRECATED sequence "Use \"rmapM id\" instead" #-}
{-# INLINE sequence #-}
sequence :: Monad m => Fold m a (m b) -> Fold m a b
sequence :: forall (m :: * -> *) a b. Monad m => Fold m a (m b) -> Fold m a b
sequence = (m b -> m b) -> Fold m a (m b) -> Fold m a b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> Fold m a b -> Fold m a c
rmapM m b -> m b
forall a. a -> a
id

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

-- |
-- >>> mapMaybeM f = Fold.lmapM f . Fold.catMaybes
--
{-# INLINE mapMaybeM #-}
mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Fold m b r -> Fold m a r
mapMaybeM :: forall (m :: * -> *) a b r.
Monad m =>
(a -> m (Maybe b)) -> Fold m b r -> Fold m a r
mapMaybeM a -> m (Maybe b)
f = (a -> m (Maybe b)) -> Fold m (Maybe b) r -> Fold m a r
forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> Fold m b r -> Fold m a r
lmapM a -> m (Maybe b)
f (Fold m (Maybe b) r -> Fold m a r)
-> (Fold m b r -> Fold m (Maybe b) r) -> Fold m b r -> Fold m a r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fold m b r -> Fold m (Maybe b) r
forall (m :: * -> *) a b.
Monad m =>
Fold m a b -> Fold m (Maybe a) b
catMaybes

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

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

-- | Apply a monadic function on the input and return the input.
--
-- >>> Stream.fold (Fold.lmapM (Fold.tracing print) Fold.drain) $ (Stream.enumerateFromTo (1 :: Int) 2)
-- 1
-- 2
--
-- /Pre-release/
--
{-# INLINE tracing #-}
tracing :: Monad m => (a -> m b) -> (a -> m a)
tracing :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> a -> m a
tracing a -> m b
f a
x = m b -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (a -> m b
f a
x) m () -> m a -> m a
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Apply a monadic function to each element flowing through and discard the
-- results.
--
-- >>> Stream.fold (Fold.trace print Fold.drain) $ (Stream.enumerateFromTo (1 :: Int) 2)
-- 1
-- 2
--
-- >>> trace f = Fold.lmapM (Fold.tracing f)
--
-- /Pre-release/
{-# INLINE trace #-}
trace :: Monad m => (a -> m b) -> Fold m a r -> Fold m a r
trace :: forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> Fold m a r -> Fold m a r
trace a -> m b
f = (a -> m a) -> Fold m a r -> Fold m a r
forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> Fold m b r -> Fold m a r
lmapM ((a -> m b) -> a -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> a -> m a
tracing a -> m b
f)

-- | Attach a 'Pipe' on the input of a 'Fold'.
--
-- /Pre-release/
{-# INLINE pipe #-}
pipe :: Monad m => Pipe m a b -> Fold m b c -> Fold m a c
pipe :: forall (m :: * -> *) a b c.
Monad m =>
Pipe m a b -> Fold m b c -> Fold m a c
pipe (Pipe cs -> a -> m (Step cs ps b)
consume ps -> m (Step cs ps b)
produce cs
pinitial) (Fold s -> b -> m (Step s c)
fstep m (Step s c)
finitial s -> m c
fextract s -> m c
ffinal) =
    (Tuple' cs s -> a -> m (Step (Tuple' cs s) c))
-> m (Step (Tuple' cs s) c)
-> (Tuple' cs s -> m c)
-> (Tuple' cs s -> m c)
-> Fold m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold Tuple' cs s -> a -> m (Step (Tuple' cs s) c)
step m (Step (Tuple' cs s) c)
initial Tuple' cs s -> m c
forall {a}. Tuple' a s -> m c
extract Tuple' cs s -> m c
forall {a}. Tuple' a s -> m c
final

    where

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

    step :: Tuple' cs s -> a -> m (Step (Tuple' cs s) c)
step (Tuple' cs
cs s
fs) a
x = do
        Step cs ps b
r <- cs -> a -> m (Step cs ps b)
consume cs
cs a
x
        s -> Step cs ps b -> m (Step (Tuple' cs s) c)
go s
fs Step cs ps b
r

        where

        -- XXX use SPEC?
        go :: s -> Step cs ps b -> m (Step (Tuple' cs s) c)
go s
acc (Pipe.YieldC cs
cs1 b
b) = do
            Step s c
acc1 <- s -> b -> m (Step s c)
fstep s
acc b
b
            Step (Tuple' cs s) c -> m (Step (Tuple' cs s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                (Step (Tuple' cs s) c -> m (Step (Tuple' cs s) c))
-> Step (Tuple' cs s) c -> m (Step (Tuple' cs s) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
acc1 of
                      Partial s
s -> Tuple' cs s -> Step (Tuple' cs s) c
forall s b. s -> Step s b
Partial (Tuple' cs s -> Step (Tuple' cs s) c)
-> Tuple' cs s -> Step (Tuple' cs s) c
forall a b. (a -> b) -> a -> b
$ cs -> s -> Tuple' cs s
forall a b. a -> b -> Tuple' a b
Tuple' cs
cs1 s
s
                      Done c
b1 -> c -> Step (Tuple' cs s) c
forall s b. b -> Step s b
Done c
b1
        -- XXX this case is recursive may cause fusion issues.
        -- To remove recursion we will need a produce mode in folds which makes
        -- it similar to pipes except that it does not yield intermediate
        -- values..
        go s
acc (Pipe.YieldP ps
ps1 b
b) = do
            Step s c
acc1 <- s -> b -> m (Step s c)
fstep s
acc b
b
            Step cs ps b
r <- ps -> m (Step cs ps b)
produce ps
ps1
            case Step s c
acc1 of
                Partial s
s -> s -> Step cs ps b -> m (Step (Tuple' cs s) c)
go s
s Step cs ps b
r
                Done c
b1 -> Step (Tuple' cs s) c -> m (Step (Tuple' cs s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' cs s) c -> m (Step (Tuple' cs s) c))
-> Step (Tuple' cs s) c -> m (Step (Tuple' cs s) c)
forall a b. (a -> b) -> a -> b
$ c -> Step (Tuple' cs s) c
forall s b. b -> Step s b
Done c
b1
        go s
acc (Pipe.SkipC cs
cs1) =
            Step (Tuple' cs s) c -> m (Step (Tuple' cs s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' cs s) c -> m (Step (Tuple' cs s) c))
-> Step (Tuple' cs s) c -> m (Step (Tuple' cs s) c)
forall a b. (a -> b) -> a -> b
$ Tuple' cs s -> Step (Tuple' cs s) c
forall s b. s -> Step s b
Partial (Tuple' cs s -> Step (Tuple' cs s) c)
-> Tuple' cs s -> Step (Tuple' cs s) c
forall a b. (a -> b) -> a -> b
$ cs -> s -> Tuple' cs s
forall a b. a -> b -> Tuple' a b
Tuple' cs
cs1 s
acc
        -- XXX this case is recursive may cause fusion issues.
        go s
acc (Pipe.SkipP ps
ps1) = do
            Step cs ps b
r <- ps -> m (Step cs ps b)
produce ps
ps1
            s -> Step cs ps b -> m (Step (Tuple' cs s) c)
go s
acc Step cs ps b
r
        -- XXX a Stop in consumer means we dropped the input.
        go s
acc Step cs ps b
Pipe.Stop = c -> Step (Tuple' cs s) c
forall s b. b -> Step s b
Done (c -> Step (Tuple' cs s) c) -> m c -> m (Step (Tuple' cs s) c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m c
ffinal s
acc

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

    final :: Tuple' a s -> m c
final (Tuple' a
_ s
fs) = s -> m c
ffinal s
fs

------------------------------------------------------------------------------
-- Filters
------------------------------------------------------------------------------

-- | Returns the latest element omitting the first occurrence that satisfies
-- the given equality predicate.
--
-- Example:
--
-- >>> input = Stream.fromList [1,3,3,5]
--
-- >> Stream.toList $ Stream.scanMaybe (Fold.deleteBy (==) 3) input
-- [1,3,5]
--
{-# INLINE_NORMAL deleteBy #-}
deleteBy :: Monad m => (a -> a -> Bool) -> a -> Fold m a (Maybe a)
deleteBy :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> a -> Fold m a (Maybe a)
deleteBy a -> a -> Bool
eq = Scanl m a (Maybe a) -> Fold m a (Maybe a)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl (Scanl m a (Maybe a) -> Fold m a (Maybe a))
-> (a -> Scanl m a (Maybe a)) -> a -> Fold m a (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool) -> a -> Scanl m a (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> a -> Scanl m a (Maybe a)
Scanl.deleteBy a -> a -> Bool
eq

-- | Provide a sliding window of length 2 elements.
--
-- See "Streamly.Internal.Data.Fold.Window".
--
{-# INLINE slide2 #-}
slide2 :: Monad m => Fold m (a, Maybe a) b -> Fold m a b
slide2 :: forall (m :: * -> *) a b.
Monad m =>
Fold m (a, Maybe a) b -> Fold m a b
slide2 (Fold s -> (a, Maybe a) -> m (Step s b)
step1 m (Step s b)
initial1 s -> m b
extract1 s -> m b
final1) = (Tuple' (Maybe a) s -> a -> m (Step (Tuple' (Maybe a) s) b))
-> m (Step (Tuple' (Maybe a) s) b)
-> (Tuple' (Maybe a) s -> m b)
-> (Tuple' (Maybe a) s -> m b)
-> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold Tuple' (Maybe a) s -> a -> m (Step (Tuple' (Maybe a) s) b)
step m (Step (Tuple' (Maybe a) s) b)
forall {a}. m (Step (Tuple' (Maybe a) s) b)
initial Tuple' (Maybe a) s -> m b
forall {a}. Tuple' a s -> m b
extract Tuple' (Maybe a) s -> m b
forall {a}. Tuple' a s -> m b
final

    where

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

    step :: Tuple' (Maybe a) s -> a -> m (Step (Tuple' (Maybe a) s) b)
step (Tuple' Maybe a
prev s
s) a
cur =
        (s -> Tuple' (Maybe a) s)
-> Step s b -> Step (Tuple' (Maybe a) s) b
forall a b c. (a -> b) -> Step a c -> Step b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Maybe a -> s -> Tuple' (Maybe a) s
forall a b. a -> b -> Tuple' a b
Tuple' (a -> Maybe a
forall a. a -> Maybe a
Just a
cur)) (Step s b -> Step (Tuple' (Maybe a) s) b)
-> m (Step s b) -> m (Step (Tuple' (Maybe a) s) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> (a, Maybe a) -> m (Step s b)
step1 s
s (a
cur, Maybe a
prev)

    extract :: Tuple' a s -> m b
extract (Tuple' a
_ s
s) = s -> m b
extract1 s
s

    final :: Tuple' a s -> m b
final (Tuple' a
_ s
s) = s -> m b
final1 s
s

-- | Return the latest unique element using the supplied comparison function.
-- Returns 'Nothing' if the current element is same as the last element
-- otherwise returns 'Just'.
--
-- Example, strip duplicate path separators:
--
-- >>> input = Stream.fromList "//a//b"
-- >>> f x y = x == '/' && y == '/'
--
-- >> Stream.toList $ Stream.scanMaybe (Fold.uniqBy f) input
-- "/a/b"
--
-- Space: @O(1)@
--
-- /Pre-release/
--
{-# INLINE uniqBy #-}
uniqBy :: Monad m => (a -> a -> Bool) -> Fold m a (Maybe a)
uniqBy :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> Fold m a (Maybe a)
uniqBy = Scanl m a (Maybe a) -> Fold m a (Maybe a)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl (Scanl m a (Maybe a) -> Fold m a (Maybe a))
-> ((a -> a -> Bool) -> Scanl m a (Maybe a))
-> (a -> a -> Bool)
-> Fold m a (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool) -> Scanl m a (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> Scanl m a (Maybe a)
Scanl.uniqBy

-- | See 'uniqBy'.
--
-- Definition:
--
-- >>> uniq = Fold.uniqBy (==)
--
{-# INLINE uniq #-}
uniq :: (Monad m, Eq a) => Fold m a (Maybe a)
uniq :: forall (m :: * -> *) a. (Monad m, Eq a) => Fold m a (Maybe a)
uniq = Scanl m a (Maybe a) -> Fold m a (Maybe a)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl Scanl m a (Maybe a)
forall (m :: * -> *) a. (Monad m, Eq a) => Scanl m a (Maybe a)
Scanl.uniq

-- | Strip all leading and trailing occurrences of an element passing a
-- predicate and make all other consecutive occurrences uniq.
--
-- >> prune p = Stream.dropWhileAround p $ Stream.uniqBy (x y -> p x && p y)
--
-- @
-- > Stream.prune isSpace (Stream.fromList "  hello      world!   ")
-- "hello world!"
--
-- @
--
-- Space: @O(1)@
--
-- /Unimplemented/
{-# INLINE prune #-}
prune ::
    -- (Monad m, Eq a) =>
    (a -> Bool) -> Fold m a (Maybe a)
prune :: forall a (m :: * -> *). (a -> Bool) -> Fold m a (Maybe a)
prune = [Char] -> (a -> Bool) -> Fold m a (Maybe a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Not implemented yet!"

-- | Emit only repeated elements, once.
--
-- /Unimplemented/
repeated :: -- (Monad m, Eq a) =>
    Fold m a (Maybe a)
repeated :: forall (m :: * -> *) a. Fold m a (Maybe a)
repeated = [Char] -> Fold m a (Maybe a)
forall a. HasCallStack => [Char] -> a
error [Char]
"Not implemented yet!"

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

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

-- |
-- Definitions:
--
-- >>> drainMapM f = Fold.lmapM f Fold.drain
-- >>> drainMapM f = Fold.foldMapM (void . f)
--
-- Drain all input after passing it through a monadic function. This is the
-- dual of mapM_ on stream producers.
--
{-# INLINE drainMapM #-}
drainMapM ::  Monad m => (a -> m b) -> Fold m a ()
drainMapM :: forall (m :: * -> *) a b. Monad m => (a -> m b) -> Fold m a ()
drainMapM a -> m b
f = (a -> m b) -> Fold m b () -> Fold m a ()
forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> Fold m b r -> Fold m a r
lmapM a -> m b
f Fold m b ()
forall (m :: * -> *) a. Monad m => Fold m a ()
drain

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

-- | Terminates with 'Nothing' as soon as it finds an element different than
-- the previous one, returns 'the' element if the entire input consists of the
-- same element.
--
{-# INLINE the #-}
the :: (Monad m, Eq a) => Fold m a (Maybe a)
the :: forall (m :: * -> *) a. (Monad m, Eq a) => Fold m a (Maybe a)
the = Scanl m a (Maybe a) -> Fold m a (Maybe a)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl Scanl m a (Maybe a)
forall (m :: * -> *) a. (Monad m, Eq a) => Scanl m a (Maybe a)
Scanl.the

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

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

-- | Determine the product of all elements of a stream of numbers. Returns
-- multiplicative identity (@1@) when the stream is empty. The fold terminates
-- when it encounters (@0@) in its input.
--
-- Same as the following but terminates on multiplication by @0@:
--
-- >>> product = fmap Data.Monoid.getProduct $ Fold.foldMap Data.Monoid.Product
--
{-# INLINE product #-}
product :: (Monad m, Num a, Eq a) => Fold m a a
product :: forall (m :: * -> *) a. (Monad m, Num a, Eq a) => Fold m a a
product = Scanl m a a -> Fold m a a
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl Scanl m a a
forall (m :: * -> *) a. (Monad m, Num a, Eq a) => Scanl m a a
Scanl.product

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

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

    where

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

-- | Determine the maximum element in a stream.
--
-- Definitions:
--
-- >>> maximum = Fold.maximumBy compare
-- >>> maximum = Fold.foldl1' max
--
-- Same as the following but without a default maximum. The 'Max' Monoid uses
-- the 'minBound' as the default maximum:
--
-- >>> maximum = fmap Data.Semigroup.getMax $ Fold.foldMap Data.Semigroup.Max
--
{-# INLINE maximum #-}
maximum :: (Monad m, Ord a) => Fold m a (Maybe a)
maximum :: forall (m :: * -> *) a. (Monad m, Ord a) => Fold m a (Maybe a)
maximum = (a -> a -> a) -> Fold m a (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
foldl1' a -> a -> a
forall a. Ord a => a -> a -> a
max

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

    where

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

-- | Determine the minimum element in a stream using the supplied comparison
-- function.
--
-- Definitions:
--
-- >>> minimum = Fold.minimumBy compare
-- >>> minimum = Fold.foldl1' min
--
-- Same as the following but without a default minimum. The 'Min' Monoid uses the
-- 'maxBound' as the default maximum:
--
-- >>> maximum = fmap Data.Semigroup.getMin $ Fold.foldMap Data.Semigroup.Min
--
{-# INLINE minimum #-}
minimum :: (Monad m, Ord a) => Fold m a (Maybe a)
minimum :: forall (m :: * -> *) a. (Monad m, Ord a) => Fold m a (Maybe a)
minimum = (a -> a -> a) -> Fold m a (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> a -> a) -> Fold m a (Maybe a)
foldl1' a -> a -> a
forall a. Ord a => a -> a -> a
min

{-# INLINE rangeBy #-}
rangeBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe (a, a))
rangeBy :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> Ordering) -> Fold m a (Maybe (a, a))
rangeBy a -> a -> Ordering
cmp = Scanl m a (Maybe (a, a)) -> Fold m a (Maybe (a, a))
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl ((a -> a -> Ordering) -> Scanl m a (Maybe (a, a))
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Ordering) -> Scanl m a (Maybe (a, a))
Scanl.rangeBy a -> a -> Ordering
cmp)

-- | Find minimum and maximum elements i.e. (min, max).
--
{-# INLINE range #-}
range :: (Monad m, Ord a) => Fold m a (Maybe (a, a))
range :: forall (m :: * -> *) a. (Monad m, Ord a) => Fold m a (Maybe (a, a))
range = Scanl m a (Maybe (a, a)) -> Fold m a (Maybe (a, a))
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl Scanl m a (Maybe (a, a))
forall (m :: * -> *) a.
(Monad m, Ord a) =>
Scanl m a (Maybe (a, a))
Scanl.range

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

-- | Compute a numerically stable arithmetic mean of all elements in the input
-- stream.
--
{-# INLINE mean #-}
mean :: (Monad m, Fractional a) => Fold m a a
mean :: forall (m :: * -> *) a. (Monad m, Fractional a) => Fold m a a
mean = Scanl m a a -> Fold m a a
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl Scanl m a a
forall (m :: * -> *) a. (Monad m, Fractional a) => Scanl m a a
Scanl.mean

-- | Compute a numerically stable (population) variance over all elements in
-- the input stream.
--
{-# DEPRECATED variance "Use the streamly-statistics package instead" #-}
{-# INLINE variance #-}
variance :: (Monad m, Fractional a) => Fold m a a
variance :: forall (m :: * -> *) a. (Monad m, Fractional a) => Fold m a a
variance = (Tuple3' a a a -> a) -> Fold m a (Tuple3' a a a) -> Fold m a a
forall a b. (a -> b) -> Fold m a a -> Fold m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tuple3' a a a -> a
forall {a} {b}. Fractional a => Tuple3' a b a -> a
done (Fold m a (Tuple3' a a a) -> Fold m a a)
-> Fold m a (Tuple3' a a a) -> Fold m a a
forall a b. (a -> b) -> a -> b
$ (Tuple3' a a a -> a -> Tuple3' a a a)
-> Tuple3' a a a -> Fold m a (Tuple3' a a a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' Tuple3' a a a -> a -> Tuple3' a a a
forall {c}. Fractional c => Tuple3' c c c -> c -> Tuple3' c c c
step Tuple3' a a a
begin

    where

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

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

        where

        n' :: c
n' = c
n c -> c -> c
forall a. Num a => a -> a -> a
+ c
1
        mean' :: c
mean' = (c
n c -> c -> c
forall a. Num a => a -> a -> a
* c
mean_ c -> c -> c
forall a. Num a => a -> a -> a
+ c
x) c -> c -> c
forall a. Fractional a => a -> a -> a
/ (c
n c -> c -> c
forall a. Num a => a -> a -> a
+ c
1)
        delta :: c
delta = c
x c -> c -> c
forall a. Num a => a -> a -> a
- c
mean_
        m2' :: c
m2' = c
m2 c -> c -> c
forall a. Num a => a -> a -> a
+ c
delta c -> c -> c
forall a. Num a => a -> a -> a
* c
delta c -> c -> c
forall a. Num a => a -> a -> a
* c
n c -> c -> c
forall a. Fractional a => a -> a -> a
/ (c
n c -> c -> c
forall a. Num a => a -> a -> a
+ c
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.
--
{-# DEPRECATED stdDev "Use the streamly-statistics package instead" #-}
{-# INLINE stdDev #-}
stdDev :: (Monad m, Floating a) => Fold m a a
stdDev :: forall (m :: * -> *) a. (Monad m, Floating a) => Fold m a a
stdDev = a -> a
forall a. Floating a => a -> a
sqrt (a -> a) -> Fold m a a -> Fold m a a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold m a a
forall (m :: * -> *) a. (Monad m, Fractional a) => Fold m a a
variance

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

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

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

-- XXX Compare this with the implementation in Fold.Window, preferrably use the
-- latter if performance is good.

-- | Apply a function on every two successive elements of a stream. The first
-- argument of the map function is the previous element and the second argument
-- is the current element. When processing the very first element in the
-- stream, the previous element is 'Nothing'.
--
-- /Pre-release/
--
{-# INLINE rollingMapM #-}
rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Fold m a b
rollingMapM :: forall (m :: * -> *) a b.
Monad m =>
(Maybe a -> a -> m b) -> Fold m a b
rollingMapM = Scanl m a b -> Fold m a b
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl (Scanl m a b -> Fold m a b)
-> ((Maybe a -> a -> m b) -> Scanl m a b)
-> (Maybe a -> a -> m b)
-> Fold m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> a -> m b) -> Scanl m a b
forall (m :: * -> *) a b.
Monad m =>
(Maybe a -> a -> m b) -> Scanl m a b
Scanl.rollingMapM

-- |
-- >>> rollingMap f = Fold.rollingMapM (\x y -> return $ f x y)
--
{-# INLINE rollingMap #-}
rollingMap :: Monad m => (Maybe a -> a -> b) -> Fold m a b
rollingMap :: forall (m :: * -> *) a b.
Monad m =>
(Maybe a -> a -> b) -> Fold m a b
rollingMap = Scanl m a b -> Fold m a b
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl (Scanl m a b -> Fold m a b)
-> ((Maybe a -> a -> b) -> Scanl m a b)
-> (Maybe a -> a -> b)
-> Fold m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> a -> b) -> Scanl m a b
forall (m :: * -> *) a b.
Monad m =>
(Maybe a -> a -> b) -> Scanl m a b
Scanl.rollingMap

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

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

-- | Monoid concat. Fold an input stream consisting of monoidal elements using
-- 'mappend' and 'mempty'.
--
-- Definition:
--
-- >>> mconcat = Fold.sconcat mempty
--
-- >>> monoids = fmap Data.Monoid.Sum $ Stream.enumerateFromTo 1 10
-- >>> Stream.fold Fold.mconcat monoids
-- Sum {getSum = 55}
--
{-# INLINE mconcat #-}
mconcat ::
    ( Monad m
    , Monoid a) => Fold m a a
mconcat :: forall (m :: * -> *) a. (Monad m, Monoid a) => Fold m a a
mconcat = Scanl m a a -> Fold m a a
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl Scanl m a a
forall (m :: * -> *) a. (Monad m, Monoid a) => Scanl m a a
Scanl.mconcat

-- |
-- Definition:
--
-- >>> foldMap f = Fold.lmap f Fold.mconcat
--
-- Make a fold from a pure function that folds the output of the function
-- using 'mappend' and 'mempty'.
--
-- >>> sum = Fold.foldMap Data.Monoid.Sum
-- >>> Stream.fold sum $ Stream.enumerateFromTo 1 10
-- Sum {getSum = 55}
--
{-# INLINE foldMap #-}
foldMap :: (Monad m, Monoid b) => (a -> b) -> Fold m a b
foldMap :: forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> b) -> Fold m a b
foldMap = Scanl m a b -> Fold m a b
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl (Scanl m a b -> Fold m a b)
-> ((a -> b) -> Scanl m a b) -> (a -> b) -> Fold m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Scanl m a b
forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> b) -> Scanl m a b
Scanl.foldMap

-- |
-- Definition:
--
-- >>> foldMapM f = Fold.lmapM f Fold.mconcat
--
-- Make a fold from a monadic function that folds the output of the function
-- using 'mappend' and 'mempty'.
--
-- >>> sum = Fold.foldMapM (return . Data.Monoid.Sum)
-- >>> Stream.fold sum $ Stream.enumerateFromTo 1 10
-- Sum {getSum = 55}
--
{-# INLINE foldMapM #-}
foldMapM ::  (Monad m, Monoid b) => (a -> m b) -> Fold m a b
foldMapM :: forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> Fold m a b
foldMapM = Scanl m a b -> Fold m a b
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl (Scanl m a b -> Fold m a b)
-> ((a -> m b) -> Scanl m a b) -> (a -> m b) -> Fold m a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> m b) -> Scanl m a b
forall (m :: * -> *) b a.
(Monad m, Monoid b) =>
(a -> m b) -> Scanl m a b
Scanl.foldMapM

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

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

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

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

    where

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

-- | Return the element at the given index.
--
-- Definition:
--
-- >>> index = Fold.genericIndex
--
{-# INLINE index #-}
index :: Monad m => Int -> Fold m a (Maybe a)
index :: forall (m :: * -> *) a. Monad m => 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

-- | Consume a single input and transform it using the supplied 'Maybe'
-- returning function.
--
-- /Pre-release/
--
{-# INLINE maybe #-}
maybe :: Monad m => (a -> Maybe b) -> Fold m a (Maybe b)
maybe :: forall (m :: * -> *) a b.
Monad m =>
(a -> Maybe b) -> Fold m a (Maybe b)
maybe a -> Maybe b
f = (Maybe b -> a -> Step (Maybe b) (Maybe b))
-> Step (Maybe b) (Maybe b)
-> (Maybe b -> Maybe b)
-> Fold m a (Maybe b)
forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
foldt' ((a -> Step (Maybe b) (Maybe b))
-> Maybe b -> a -> Step (Maybe b) (Maybe b)
forall a b. a -> b -> a
const (Maybe b -> Step (Maybe b) (Maybe b)
forall s b. b -> Step s b
Done (Maybe b -> Step (Maybe b) (Maybe b))
-> (a -> Maybe b) -> a -> Step (Maybe b) (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f)) (Maybe b -> Step (Maybe b) (Maybe b)
forall s b. s -> Step s b
Partial Maybe b
forall a. Maybe a
Nothing) Maybe b -> Maybe b
forall a. a -> a
id

-- | Consume a single element and return it if it passes the predicate else
-- return 'Nothing'.
--
-- Definition:
--
-- >>> satisfy f = Fold.maybe (\a -> if f a then Just a else Nothing)
--
-- /Pre-release/
{-# INLINE satisfy #-}
satisfy :: Monad m => (a -> Bool) -> Fold m a (Maybe a)
satisfy :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Fold m a (Maybe a)
satisfy a -> Bool
f = (a -> Maybe a) -> Fold m a (Maybe a)
forall (m :: * -> *) a b.
Monad m =>
(a -> Maybe b) -> Fold m a (Maybe b)
maybe (\a
a -> if a -> Bool
f a
a then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
forall a. Maybe a
Nothing)
{-
satisfy f = Fold step (return $ Partial ()) (const (return Nothing))

    where

    step () a = return $ Done $ if f a then Just a else Nothing
-}

-- Naming notes:
--
-- "head" and "next" are two alternative names for the same API. head sounds
-- apt in the context of lists but next sounds more apt in the context of
-- streams where we think in terms of generating and consuming the next element
-- rather than taking the head of some static/persistent structure.
--
-- We also want to keep the nomenclature consistent across folds and parsers,
-- "head" becomes even more unintuitive for parsers because there are two
-- possible variants viz. peek and next.
--
-- Also, the "head" fold creates confusion in situations like
-- https://github.com/composewell/streamly/issues/1404 where intuitive
-- expectation from head is to consume the entire stream and just give us the
-- head. There we want to convey the notion that we consume one element from
-- the stream and stop. The name "one" already being used in parsers for this
-- purpose sounds more apt from this perspective.
--
-- The source of confusion is perhaps due to the fact that some folds consume
-- the entire stream and others terminate early. It may have been clearer if we
-- had separate abstractions for the two use cases.

-- XXX We can possibly use "head" for the purposes of reducing the entire
-- stream to the head element i.e. take the head and drain the rest.

-- | Take one element from the stream and stop.
--
-- Definition:
--
-- >>> one = Fold.maybe Just
--
-- This is similar to the stream 'Stream.uncons' operation.
--
{-# INLINE one #-}
one :: Monad m => Fold m a (Maybe a)
one :: forall (m :: * -> *) a. Monad m => Fold m a (Maybe a)
one = (a -> Maybe a) -> Fold m a (Maybe a)
forall (m :: * -> *) a b.
Monad m =>
(a -> Maybe b) -> Fold m a (Maybe b)
maybe a -> Maybe a
forall a. a -> Maybe a
Just

-- | Extract the first element of the stream, if any.
--
-- >>> head = Fold.one
--
{-# DEPRECATED head "Please use \"one\" instead" #-}
{-# INLINE head #-}
head :: Monad m => Fold m a (Maybe a)
head :: forall (m :: * -> *) a. Monad m => Fold m a (Maybe a)
head = Fold m a (Maybe a)
forall (m :: * -> *) a. Monad m => Fold m a (Maybe a)
one

-- | Returns the first element that satisfies the given predicate.
--
-- /Pre-release/
{-# INLINE findM #-}
findM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)
findM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Fold m a (Maybe a)
findM a -> m Bool
predicate =
    (() -> a -> m (Step () (Maybe a)))
-> m (Step () (Maybe a))
-> (() -> m (Maybe a))
-> (() -> m (Maybe a))
-> Fold m a (Maybe a)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold () -> a -> m (Step () (Maybe a))
step (Step () (Maybe a) -> m (Step () (Maybe a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step () (Maybe a) -> m (Step () (Maybe a)))
-> Step () (Maybe a) -> m (Step () (Maybe a))
forall a b. (a -> b) -> a -> b
$ () -> Step () (Maybe a)
forall s b. s -> Step s b
Partial ()) () -> m (Maybe a)
forall {b} {a}. b -> m (Maybe a)
extract () -> m (Maybe a)
forall {b} {a}. b -> m (Maybe a)
extract

    where

    step :: () -> a -> m (Step () (Maybe a))
step () a
a =
        let f :: Bool -> Step () (Maybe a)
f Bool
r =
                if Bool
r
                then Maybe a -> Step () (Maybe a)
forall s b. b -> Step s b
Done (a -> Maybe a
forall a. a -> Maybe a
Just a
a)
                else () -> Step () (Maybe a)
forall s b. s -> Step s b
Partial ()
         in Bool -> Step () (Maybe a)
f (Bool -> Step () (Maybe a)) -> m Bool -> m (Step () (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m Bool
predicate a
a

    extract :: b -> m (Maybe a)
extract = m (Maybe a) -> b -> m (Maybe a)
forall a b. a -> b -> a
const (m (Maybe a) -> b -> m (Maybe a))
-> m (Maybe a) -> b -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing

-- | Returns the first element that satisfies the given predicate.
--
{-# INLINE find #-}
find :: Monad m => (a -> Bool) -> Fold m a (Maybe a)
find :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Fold m a (Maybe a)
find a -> Bool
p = (a -> m Bool) -> Fold m a (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Fold m a (Maybe a)
findM (Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (a -> Bool) -> a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

-- | 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@.
--
-- Definition:
--
-- >>> lookup x = fmap snd <$> Fold.find ((== x) . fst)
--
{-# INLINE lookup #-}
lookup :: (Eq a, Monad m) => a -> Fold m (a,b) (Maybe b)
lookup :: forall a (m :: * -> *) b.
(Eq a, Monad m) =>
a -> Fold m (a, b) (Maybe b)
lookup a
a0 = (() -> (a, b) -> Step () (Maybe b))
-> Step () (Maybe b) -> (() -> Maybe b) -> Fold m (a, b) (Maybe b)
forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
foldt' () -> (a, b) -> Step () (Maybe b)
forall {a}. () -> (a, a) -> Step () (Maybe a)
step (() -> Step () (Maybe b)
forall s b. s -> Step s b
Partial ()) (Maybe b -> () -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing)

    where

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

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

    where

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

-- | Returns the index of the latest element if the element satisfies the given
-- predicate.
--
{-# INLINE findIndices #-}
findIndices :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)
findIndices :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Fold m a (Maybe Int)
findIndices = Scanl m a (Maybe Int) -> Fold m a (Maybe Int)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl (Scanl m a (Maybe Int) -> Fold m a (Maybe Int))
-> ((a -> Bool) -> Scanl m a (Maybe Int))
-> (a -> Bool)
-> Fold m a (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> Scanl m a (Maybe Int)
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Scanl m a (Maybe Int)
Scanl.findIndices

-- | Returns the index of the latest element if the element matches the given
-- value.
--
-- Definition:
--
-- >>> elemIndices a = Fold.findIndices (== a)
--
{-# INLINE elemIndices #-}
elemIndices :: (Monad m, Eq a) => a -> Fold m a (Maybe Int)
elemIndices :: forall (m :: * -> *) a.
(Monad m, Eq a) =>
a -> Fold m a (Maybe Int)
elemIndices = Scanl m a (Maybe Int) -> Fold m a (Maybe Int)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl (Scanl m a (Maybe Int) -> Fold m a (Maybe Int))
-> (a -> Scanl m a (Maybe Int)) -> a -> Fold m a (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Scanl m a (Maybe Int)
forall (m :: * -> *) a.
(Monad m, Eq a) =>
a -> Scanl m a (Maybe Int)
Scanl.elemIndices

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

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

-- Similar to 'eof' parser, but the fold consumes and discards an input element
-- when not at eof. XXX Remove or Rename to "eof"?

-- | Consume one element, return 'True' if successful else return 'False'. In
-- other words, test if the input is empty or not.
--
-- WARNING! It consumes one element if the stream is not empty. If that is not
-- what you want please use the eof parser instead.
--
-- Definition:
--
-- >>> null = fmap isJust Fold.one
--
{-# INLINE null #-}
null :: Monad m => Fold m a Bool
null :: forall (m :: * -> *) a. Monad m => Fold m a Bool
null = (() -> a -> Step () Bool)
-> Step () Bool -> (() -> Bool) -> Fold m a Bool
forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
foldt' (\() a
_ -> Bool -> Step () Bool
forall s b. b -> Step s b
Done Bool
False) (() -> Step () Bool
forall s b. s -> Step s b
Partial ()) (Bool -> () -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | Returns 'True' if any element of the input satisfies the predicate.
--
-- Definition:
--
-- >>> any p = Fold.lmap p Fold.or
--
-- Example:
--
-- >>> Stream.fold (Fold.any (== 0)) $ Stream.fromList [1,0,1]
-- True
--
{-# INLINE any #-}
any :: Monad m => (a -> Bool) -> Fold m a Bool
any :: forall (m :: * -> *) a. Monad m => (a -> Bool) -> Fold m a Bool
any a -> Bool
predicate = (Bool -> a -> Step Bool Bool)
-> Step Bool Bool -> (Bool -> Bool) -> Fold m a Bool
forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
foldt' Bool -> a -> Step Bool Bool
forall {p}. p -> a -> Step Bool Bool
step Step Bool Bool
forall {b}. Step Bool b
initial Bool -> Bool
forall a. a -> a
id

    where

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

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

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

-- | Returns 'True' if all elements of the input satisfy the predicate.
--
-- Definition:
--
-- >>> all p = Fold.lmap p Fold.and
--
-- Example:
--
-- >>> Stream.fold (Fold.all (== 0)) $ Stream.fromList [1,0,1]
-- False
--
{-# INLINE all #-}
all :: Monad m => (a -> Bool) -> Fold m a Bool
all :: forall (m :: * -> *) a. Monad m => (a -> Bool) -> Fold m a Bool
all a -> Bool
predicate = (Bool -> a -> Step Bool Bool)
-> Step Bool Bool -> (Bool -> Bool) -> Fold m a Bool
forall (m :: * -> *) s a b.
Monad m =>
(s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b
foldt' Bool -> a -> Step Bool Bool
forall {p}. p -> a -> Step Bool Bool
step Step Bool Bool
forall {b}. Step Bool b
initial Bool -> Bool
forall a. a -> a
id

    where

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

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

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

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

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

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

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

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

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

{-# INLINE splitAt #-}
splitAt
    :: Monad m
    => Int
    -> Fold m a b
    -> Fold m a c
    -> Fold m a (b, c)
splitAt :: forall (m :: * -> *) a b c.
Monad m =>
Int -> Fold m a b -> Fold m a c -> Fold m a (b, c)
splitAt Int
n Fold m a b
fld = (b -> c -> (b, c)) -> Fold m a b -> Fold m a c -> Fold m a (b, c)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
splitWith (,) (Int -> Fold m a b -> Fold m a b
forall (m :: * -> *) a b.
Monad m =>
Int -> Fold m a b -> Fold m a b
take Int
n Fold m a b
fld)

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

{-# INLINE takingEndByM #-}
takingEndByM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)
takingEndByM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Fold m a (Maybe a)
takingEndByM a -> m Bool
p = (Maybe' a -> a -> m (Step (Maybe' a) (Maybe a)))
-> m (Step (Maybe' a) (Maybe a))
-> (Maybe' a -> m (Maybe a))
-> (Maybe' a -> m (Maybe a))
-> Fold m a (Maybe a)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold Maybe' a -> a -> m (Step (Maybe' a) (Maybe a))
forall {p}. p -> a -> m (Step (Maybe' a) (Maybe a))
step m (Step (Maybe' a) (Maybe a))
forall {a} {b}. m (Step (Maybe' a) b)
initial Maybe' a -> m (Maybe a)
forall {a}. Maybe' a -> m (Maybe a)
extract Maybe' a -> m (Maybe a)
forall {a}. Maybe' a -> m (Maybe a)
extract

    where

    initial :: m (Step (Maybe' a) b)
initial = Step (Maybe' a) b -> m (Step (Maybe' a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' a) b -> m (Step (Maybe' a) b))
-> Step (Maybe' a) b -> m (Step (Maybe' a) b)
forall a b. (a -> b) -> a -> b
$ Maybe' a -> Step (Maybe' a) b
forall s b. s -> Step s b
Partial Maybe' a
forall a. Maybe' a
Nothing'

    step :: p -> a -> m (Step (Maybe' a) (Maybe a))
step p
_ a
a = do
        Bool
r <- a -> m Bool
p a
a
        Step (Maybe' a) (Maybe a) -> m (Step (Maybe' a) (Maybe a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (Maybe' a) (Maybe a) -> m (Step (Maybe' a) (Maybe a)))
-> Step (Maybe' a) (Maybe a) -> m (Step (Maybe' a) (Maybe a))
forall a b. (a -> b) -> a -> b
$ if Bool
r
              then Maybe a -> Step (Maybe' a) (Maybe a)
forall s b. b -> Step s b
Done (Maybe a -> Step (Maybe' a) (Maybe a))
-> Maybe a -> Step (Maybe' a) (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a
              else Maybe' a -> Step (Maybe' a) (Maybe a)
forall s b. s -> Step s b
Partial (Maybe' a -> Step (Maybe' a) (Maybe a))
-> Maybe' a -> Step (Maybe' a) (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe' a
forall a. a -> Maybe' a
Just' a
a

    extract :: Maybe' a -> m (Maybe a)
extract = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a))
-> (Maybe' a -> 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

-- |
--
-- >>> takingEndBy p = Fold.takingEndByM (return . p)
--
{-# INLINE takingEndBy #-}
takingEndBy :: Monad m => (a -> Bool) -> Fold m a (Maybe a)
takingEndBy :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Fold m a (Maybe a)
takingEndBy a -> Bool
p = (a -> m Bool) -> Fold m a (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Fold m a (Maybe a)
takingEndByM (Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (a -> Bool) -> a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

{-# INLINE takingEndByM_ #-}
takingEndByM_ :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)
takingEndByM_ :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Fold m a (Maybe a)
takingEndByM_ a -> m Bool
p = (Maybe' a -> a -> m (Step (Maybe' a) (Maybe a)))
-> m (Step (Maybe' a) (Maybe a))
-> (Maybe' a -> m (Maybe a))
-> (Maybe' a -> m (Maybe a))
-> Fold m a (Maybe a)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold Maybe' a -> a -> m (Step (Maybe' a) (Maybe a))
forall {p} {a}. p -> a -> m (Step (Maybe' a) (Maybe a))
step m (Step (Maybe' a) (Maybe a))
forall {a} {b}. m (Step (Maybe' a) b)
initial Maybe' a -> m (Maybe a)
forall {a}. Maybe' a -> m (Maybe a)
extract Maybe' a -> m (Maybe a)
forall {a}. Maybe' a -> m (Maybe a)
extract

    where

    initial :: m (Step (Maybe' a) b)
initial = Step (Maybe' a) b -> m (Step (Maybe' a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' a) b -> m (Step (Maybe' a) b))
-> Step (Maybe' a) b -> m (Step (Maybe' a) b)
forall a b. (a -> b) -> a -> b
$ Maybe' a -> Step (Maybe' a) b
forall s b. s -> Step s b
Partial Maybe' a
forall a. Maybe' a
Nothing'

    step :: p -> a -> m (Step (Maybe' a) (Maybe a))
step p
_ a
a = do
        Bool
r <- a -> m Bool
p a
a
        Step (Maybe' a) (Maybe a) -> m (Step (Maybe' a) (Maybe a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (Maybe' a) (Maybe a) -> m (Step (Maybe' a) (Maybe a)))
-> Step (Maybe' a) (Maybe a) -> m (Step (Maybe' a) (Maybe a))
forall a b. (a -> b) -> a -> b
$ if Bool
r
              then Maybe a -> Step (Maybe' a) (Maybe a)
forall s b. b -> Step s b
Done Maybe a
forall a. Maybe a
Nothing
              else Maybe' a -> Step (Maybe' a) (Maybe a)
forall s b. s -> Step s b
Partial (Maybe' a -> Step (Maybe' a) (Maybe a))
-> Maybe' a -> Step (Maybe' a) (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe' a
forall a. a -> Maybe' a
Just' a
a

    extract :: Maybe' a -> m (Maybe a)
extract = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a))
-> (Maybe' a -> 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

-- |
--
-- >>> takingEndBy_ p = Fold.takingEndByM_ (return . p)
--
{-# INLINE takingEndBy_ #-}
takingEndBy_ :: Monad m => (a -> Bool) -> Fold m a (Maybe a)
takingEndBy_ :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Fold m a (Maybe a)
takingEndBy_ a -> Bool
p = (a -> m Bool) -> Fold m a (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Fold m a (Maybe a)
takingEndByM_ (Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (a -> Bool) -> a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

{-# INLINE droppingWhileM #-}
droppingWhileM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)
droppingWhileM :: forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Fold m a (Maybe a)
droppingWhileM a -> m Bool
p = (Maybe' a -> a -> m (Step (Maybe' a) (Maybe a)))
-> m (Step (Maybe' a) (Maybe a))
-> (Maybe' a -> m (Maybe a))
-> (Maybe' a -> m (Maybe a))
-> Fold m a (Maybe a)
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold Maybe' a -> a -> m (Step (Maybe' a) (Maybe a))
forall {a} {b}. Maybe' a -> a -> m (Step (Maybe' a) b)
step m (Step (Maybe' a) (Maybe a))
forall {a} {b}. m (Step (Maybe' a) b)
initial Maybe' a -> m (Maybe a)
forall {a}. Maybe' a -> m (Maybe a)
extract Maybe' a -> m (Maybe a)
forall {a}. Maybe' a -> m (Maybe a)
extract

    where

    initial :: m (Step (Maybe' a) b)
initial = Step (Maybe' a) b -> m (Step (Maybe' a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' a) b -> m (Step (Maybe' a) b))
-> Step (Maybe' a) b -> m (Step (Maybe' a) b)
forall a b. (a -> b) -> a -> b
$ Maybe' a -> Step (Maybe' a) b
forall s b. s -> Step s b
Partial Maybe' a
forall a. Maybe' a
Nothing'

    step :: Maybe' a -> a -> m (Step (Maybe' a) b)
step Maybe' a
Nothing' a
a = do
        Bool
r <- a -> m Bool
p a
a
        Step (Maybe' a) b -> m (Step (Maybe' a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (Maybe' a) b -> m (Step (Maybe' a) b))
-> Step (Maybe' a) b -> m (Step (Maybe' a) b)
forall a b. (a -> b) -> a -> b
$ Maybe' a -> Step (Maybe' a) b
forall s b. s -> Step s b
Partial
            (Maybe' a -> Step (Maybe' a) b) -> Maybe' a -> Step (Maybe' a) b
forall a b. (a -> b) -> a -> b
$ if Bool
r
              then Maybe' a
forall a. Maybe' a
Nothing'
              else a -> Maybe' a
forall a. a -> Maybe' a
Just' a
a
    step Maybe' a
_ a
a = Step (Maybe' a) b -> m (Step (Maybe' a) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe' a) b -> m (Step (Maybe' a) b))
-> Step (Maybe' a) b -> m (Step (Maybe' a) b)
forall a b. (a -> b) -> a -> b
$ Maybe' a -> Step (Maybe' a) b
forall s b. s -> Step s b
Partial (Maybe' a -> Step (Maybe' a) b) -> Maybe' a -> Step (Maybe' a) b
forall a b. (a -> b) -> a -> b
$ a -> Maybe' a
forall a. a -> Maybe' a
Just' a
a

    extract :: Maybe' a -> m (Maybe a)
extract = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a))
-> (Maybe' a -> 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

-- |
-- >>> droppingWhile p = Fold.droppingWhileM (return . p)
--
{-# INLINE droppingWhile #-}
droppingWhile :: Monad m => (a -> Bool) -> Fold m a (Maybe a)
droppingWhile :: forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Fold m a (Maybe a)
droppingWhile a -> Bool
p = (a -> m Bool) -> Fold m a (Maybe a)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Fold m a (Maybe a)
droppingWhileM (Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (a -> Bool) -> a -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

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

data SplitOnSeqState mba acc a rh w ck =
      SplitOnSeqEmpty !acc
    | SplitOnSeqSingle !acc !a
    | SplitOnSeqWord !acc !Int !w
    | SplitOnSeqWordLoop !acc !w
    | SplitOnSeqKR !acc !Int !mba
    | SplitOnSeqKRLoop !acc !ck !mba !rh

-- XXX Need to add tests for takeEndBySeq, we have tests for takeEndBySeq_ .

-- | Continue taking the input until the input sequence matches the supplied
-- sequence, taking the supplied sequence as well. If the pattern is empty this
-- acts as an identity fold.
--
-- >>> s = Stream.fromList "Gauss---Euler---Noether"
-- >>> f = Fold.takeEndBySeq (Array.fromList "---") Fold.toList
-- >>> Stream.fold f s
-- "Gauss---"
--
-- >>> Stream.fold Fold.toList $ Stream.foldMany f s
-- ["Gauss---","Euler---","Noether"]
--
-- Uses Rabin-Karp algorithm for substring search.
--
-- See also: 'Streamly.Data.Stream.splitOnSeq' and
-- 'Streamly.Data.Stream.splitEndBySeq'.
--
-- /Pre-release/
{-# INLINE takeEndBySeq #-}
takeEndBySeq :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) =>
       Array.Array a
    -> Fold m a b
    -> Fold m a b
takeEndBySeq :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a, Enum a, Eq a) =>
Array a -> Fold m a b -> Fold m a b
takeEndBySeq Array a
patArr (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract s -> m b
ffinal) =
    (SplitOnSeqState MutByteArray s a Int Word Word32
 -> a
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> (SplitOnSeqState MutByteArray s a Int Word Word32 -> m b)
-> (SplitOnSeqState MutByteArray s a Int Word Word32 -> m b)
-> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold SplitOnSeqState MutByteArray s a Int Word Word32
-> a
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
step m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall {rh} {ck}.
m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
initial SplitOnSeqState MutByteArray s a Int Word Word32 -> m b
forall {mba} {a} {rh} {w} {ck}.
SplitOnSeqState mba s a rh w ck -> m b
extract SplitOnSeqState MutByteArray s a Int Word Word32 -> m b
forall {mba} {a} {rh} {w} {ck}.
SplitOnSeqState mba s a rh w ck -> m b
final

    where

    patLen :: Int
patLen = Array a -> Int
forall a. Unbox a => Array a -> Int
Array.length Array a
patArr
    patBytes :: Int
patBytes = Array a -> Int
forall a. Array a -> Int
Array.byteLength Array a
patArr
    maxIndex :: Int
maxIndex = Int
patLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    maxOffset :: Int
maxOffset = Int
patBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- SIZE_OF(a)

    initial :: m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
initial = do
        Step s b
res <- m (Step s b)
finitial
        case Step s b
res of
            Partial s
acc
                | Int
patLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
                    -- XXX Should we match nothing or everything on empty
                    -- pattern?
                    -- Done <$> ffinal acc
                    Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a rh Word ck) b
 -> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b))
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a rh Word ck
 -> Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
-> SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall a b. (a -> b) -> a -> b
$ s -> SplitOnSeqState MutByteArray s a rh Word ck
forall mba acc a rh w ck. acc -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqEmpty s
acc
                | Int
patLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> do
                    a
pat <- IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> Array a -> IO a
forall a. Unbox a => Int -> Array a -> IO a
Array.unsafeGetIndexIO Int
0 Array a
patArr
                    Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a rh Word ck) b
 -> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b))
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a rh Word ck
 -> Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
-> SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall a b. (a -> b) -> a -> b
$ s -> a -> SplitOnSeqState MutByteArray s a rh Word ck
forall mba acc a rh w ck.
acc -> a -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqSingle s
acc a
pat
                | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->
                    Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a rh Word ck) b
 -> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b))
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a rh Word ck
 -> Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
-> SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall a b. (a -> b) -> a -> b
$ s -> Int -> Word -> SplitOnSeqState MutByteArray s a rh Word ck
forall mba acc a rh w ck.
acc -> Int -> w -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqWord s
acc Int
0 Word
0
                | Bool
otherwise -> do
                    (MutArray MutByteArray
mba Int
_ Int
_ Int
_) :: MutArray a <-
                        IO (MutArray a) -> m (MutArray a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a)
MA.emptyOf Int
patLen
                    Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a rh Word ck) b
 -> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b))
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a rh Word ck
 -> Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
-> SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall a b. (a -> b) -> a -> b
$ s
-> Int
-> MutByteArray
-> SplitOnSeqState MutByteArray s a rh Word ck
forall mba acc a rh w ck.
acc -> Int -> mba -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqKR s
acc Int
0 MutByteArray
mba
            Done b
b -> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a rh Word ck) b
 -> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b))
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall s b. b -> Step s b
Done b
b

    -- Word pattern related
    elemBits :: Int
elemBits = SIZE_OF(a) * 8

    wordMask :: Word
    wordMask :: Word
wordMask = (Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` (Int
elemBits Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
patLen)) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1

    wordPat :: Word
    wordPat :: Word
wordPat = Word
wordMask Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Word -> a -> Word) -> Word -> Array a -> Word
forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b
Array.foldl' Word -> a -> Word
forall {a} {a}. (Bits a, Num a, Enum a) => a -> a -> a
addToWord Word
0 Array a
patArr

    addToWord :: a -> a -> a
addToWord a
wd a
a = (a
wd a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
elemBits) a -> a -> a
forall a. Bits a => a -> a -> a
.|. Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int
forall a. Enum a => a -> Int
fromEnum a
a)

    -- For Rabin-Karp search
    k :: Word32
k = Word32
2891336453 :: Word32
    coeff :: Word32
coeff = Word32
k Word32 -> Int -> Word32
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
patLen

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

    deltaCksum :: Word32 -> a -> a -> Word32
deltaCksum Word32
cksum a
old a
new =
        Word32 -> a -> Word32
forall {a}. Enum a => Word32 -> a -> Word32
addCksum Word32
cksum a
new Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
coeff Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int
forall a. Enum a => a -> Int
fromEnum a
old)

    -- XXX shall we use a random starting hash or 1 instead of 0?
    -- XXX Need to keep this cached across fold calls in foldmany
    -- XXX We may need refold to inject the cached state instead of
    -- initializing the state every time.
    -- XXX Allocation of ring buffer should also be done once
    patHash :: Word32
patHash = (Word32 -> a -> Word32) -> Word32 -> Array a -> Word32
forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b
Array.foldl' Word32 -> a -> Word32
forall {a}. Enum a => Word32 -> a -> Word32
addCksum Word32
0 Array a
patArr

    step :: SplitOnSeqState MutByteArray s a Int Word Word32
-> a
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
step (SplitOnSeqEmpty s
s) a
x = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
x
        case Step s b
res of
            Partial s
s1 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s -> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck. acc -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqEmpty s
s1
            Done b
b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done b
b
    step (SplitOnSeqSingle s
s a
pat) a
x = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
x
        case Step s b
res of
            Partial s
s1
                | a
pat a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s -> a -> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck.
acc -> a -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqSingle s
s1 a
pat
                | Bool
otherwise -> b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done (b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> m b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s1
            Done b
b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done b
b
    step (SplitOnSeqWord s
s Int
idx Word
wrd) a
x = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
x
        let wrd1 :: Word
wrd1 = Word -> a -> Word
forall {a} {a}. (Bits a, Num a, Enum a) => a -> a -> a
addToWord Word
wrd a
x
        case Step s b
res of
            Partial s
s1
                | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxIndex -> do
                    if Word
wrd1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
wordMask Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
wordPat
                    then b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done (b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> m b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s1
                    else Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s -> Word -> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck.
acc -> w -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqWordLoop s
s1 Word
wrd1
                | Bool
otherwise ->
                    Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s
-> Int -> Word -> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck.
acc -> Int -> w -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqWord s
s1 (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word
wrd1
            Done b
b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done b
b
    step (SplitOnSeqWordLoop s
s Word
wrd) a
x = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
x
        let wrd1 :: Word
wrd1 = Word -> a -> Word
forall {a} {a}. (Bits a, Num a, Enum a) => a -> a -> a
addToWord Word
wrd a
x
        case Step s b
res of
            Partial s
s1
                | Word
wrd1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
wordMask Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
wordPat ->
                    b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done (b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> m b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s1
                | Bool
otherwise ->
                    Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s -> Word -> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck.
acc -> w -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqWordLoop s
s1 Word
wrd1
            Done b
b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done b
b
    step (SplitOnSeqKR s
s Int
offset MutByteArray
mba) a
x = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
x
        case Step s b
res of
            Partial s
s1 -> do
                IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
offset MutByteArray
mba a
x
                if Int
offset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxOffset
                then do
                    let Array a
arr :: Array a = Array
                                { arrContents :: MutByteArray
arrContents = MutByteArray
mba
                                , arrStart :: Int
arrStart = Int
0
                                , arrEnd :: Int
arrEnd = Int
patBytes
                                }
                    let ringHash :: Word32
ringHash = (Word32 -> a -> Word32) -> Word32 -> Array a -> Word32
forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b
Array.foldl' Word32 -> a -> Word32
forall {a}. Enum a => Word32 -> a -> Word32
addCksum Word32
0 Array a
arr
                    if Word32
ringHash Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
patHash Bool -> Bool -> Bool
&& Array a -> Array a -> Bool
forall a. Array a -> Array a -> Bool
Array.byteEq Array a
arr Array a
patArr
                    then b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done (b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> m b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s1
                    else Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s
-> Word32
-> MutByteArray
-> Int
-> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck.
acc -> ck -> mba -> rh -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqKRLoop s
s1 Word32
ringHash MutByteArray
mba Int
0
                else
                    Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s
-> Int
-> MutByteArray
-> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck.
acc -> Int -> mba -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqKR s
s1 (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a)) mba
            Done b
b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done b
b
    step (SplitOnSeqKRLoop s
s Word32
cksum MutByteArray
mba Int
offset) a
x = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
x
        case Step s b
res of
            Partial s
s1 -> do
                let rb :: RingArray a
rb = RingArray
                        { ringContents :: MutByteArray
ringContents = MutByteArray
mba
                        , ringSize :: Int
ringSize = Int
patBytes
                        , ringHead :: Int
ringHead = Int
offset
                        }
                (RingArray a
rb1, a
old :: a) <- IO (RingArray a, a) -> m (RingArray a, a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (RingArray a -> a -> IO (RingArray a, a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> a -> m (RingArray a, a)
RingArray.replace RingArray a
forall {a}. RingArray a
rb a
x)
                let ringHash :: Word32
ringHash = Word32 -> a -> a -> Word32
forall {a} {a}. (Enum a, Enum a) => Word32 -> a -> a -> Word32
deltaCksum Word32
cksum a
old a
x
                let rh1 :: Int
rh1 = RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb1
                Bool
matches <-
                    if Word32
ringHash Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
patHash
                    then IO Bool -> m Bool
forall a. IO a -> m a
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
$ RingArray a -> Array a -> IO Bool
forall a. RingArray a -> Array a -> IO Bool
RingArray.eqArray RingArray a
rb1 Array a
patArr
                    else Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                if Bool
matches
                then b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done (b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> m b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s1
                else Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s
-> Word32
-> MutByteArray
-> Int
-> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck.
acc -> ck -> mba -> rh -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqKRLoop s
s1 Word32
ringHash MutByteArray
mba Int
rh1
            Done b
b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done b
b

    extractFunc :: (t -> t) -> SplitOnSeqState mba t a rh w ck -> t
extractFunc t -> t
fex SplitOnSeqState mba t a rh w ck
state =
        let st :: t
st =
                case SplitOnSeqState mba t a rh w ck
state of
                    SplitOnSeqEmpty t
s -> t
s
                    SplitOnSeqSingle t
s a
_ -> t
s
                    SplitOnSeqWord t
s Int
_ w
_ -> t
s
                    SplitOnSeqWordLoop t
s w
_ -> t
s
                    SplitOnSeqKR t
s Int
_ mba
_ -> t
s
                    SplitOnSeqKRLoop t
s ck
_ mba
_ rh
_ -> t
s
        in t -> t
fex t
st

    extract :: SplitOnSeqState mba s a rh w ck -> m b
extract = (s -> m b) -> SplitOnSeqState mba s a rh w ck -> m b
forall {t} {t} {mba} {a} {rh} {w} {ck}.
(t -> t) -> SplitOnSeqState mba t a rh w ck -> t
extractFunc s -> m b
fextract

    final :: SplitOnSeqState mba s a rh w ck -> m b
final = (s -> m b) -> SplitOnSeqState mba s a rh w ck -> m b
forall {t} {t} {mba} {a} {rh} {w} {ck}.
(t -> t) -> SplitOnSeqState mba t a rh w ck -> t
extractFunc s -> m b
ffinal

-- | Like 'takeEndBySeq' but discards the matched sequence.
--
-- >>> s = Stream.fromList "Gauss---Euler---Noether"
-- >>> f = Fold.takeEndBySeq_ (Array.fromList "---") Fold.toList
-- >>> Stream.fold f s
-- "Gauss"
--
-- >>> Stream.fold Fold.toList $ Stream.foldMany f s
-- ["Gauss","Euler","Noether"]
--
-- See also: 'Streamly.Data.Stream.splitOnSeq' and
-- 'Streamly.Data.Stream.splitEndBySeq_'.
--
-- /Pre-release/
--
{-# INLINE takeEndBySeq_ #-}
takeEndBySeq_ :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) =>
       Array.Array a
    -> Fold m a b
    -> Fold m a b
takeEndBySeq_ :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a, Enum a, Eq a) =>
Array a -> Fold m a b -> Fold m a b
takeEndBySeq_ Array a
patArr (Fold s -> a -> m (Step s b)
fstep m (Step s b)
finitial s -> m b
fextract s -> m b
ffinal) =
    (SplitOnSeqState MutByteArray s a Int Word Word32
 -> a
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> (SplitOnSeqState MutByteArray s a Int Word Word32 -> m b)
-> (SplitOnSeqState MutByteArray s a Int Word Word32 -> m b)
-> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold SplitOnSeqState MutByteArray s a Int Word Word32
-> a
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
step m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall {rh} {ck}.
m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
initial SplitOnSeqState MutByteArray s a Int Word Word32 -> m b
forall {a} {ck}.
SplitOnSeqState MutByteArray s a Int Word ck -> m b
extract SplitOnSeqState MutByteArray s a Int Word Word32 -> m b
forall {a} {ck}.
SplitOnSeqState MutByteArray s a Int Word ck -> m b
final

    where

    patLen :: Int
patLen = Array a -> Int
forall a. Unbox a => Array a -> Int
Array.length Array a
patArr
    patBytes :: Int
patBytes = Array a -> Int
forall a. Array a -> Int
Array.byteLength Array a
patArr
    maxIndex :: Int
maxIndex = Int
patLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    maxOffset :: Int
maxOffset = Int
patBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- SIZE_OF(a)

    initial :: m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
initial = do
        Step s b
res <- m (Step s b)
finitial
        case Step s b
res of
            Partial s
acc
                | Int
patLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
                    -- XXX Should we match nothing or everything on empty
                    -- pattern?
                    -- Done <$> ffinal acc
                    Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a rh Word ck) b
 -> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b))
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a rh Word ck
 -> Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
-> SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall a b. (a -> b) -> a -> b
$ s -> SplitOnSeqState MutByteArray s a rh Word ck
forall mba acc a rh w ck. acc -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqEmpty s
acc
                | Int
patLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -> do
                    a
pat <- IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> Array a -> IO a
forall a. Unbox a => Int -> Array a -> IO a
Array.unsafeGetIndexIO Int
0 Array a
patArr
                    Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a rh Word ck) b
 -> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b))
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a rh Word ck
 -> Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
-> SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall a b. (a -> b) -> a -> b
$ s -> a -> SplitOnSeqState MutByteArray s a rh Word ck
forall mba acc a rh w ck.
acc -> a -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqSingle s
acc a
pat
                -- XXX Need to add tests for this case
                | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->
                    Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a rh Word ck) b
 -> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b))
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a rh Word ck
 -> Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
-> SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall a b. (a -> b) -> a -> b
$ s -> Int -> Word -> SplitOnSeqState MutByteArray s a rh Word ck
forall mba acc a rh w ck.
acc -> Int -> w -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqWord s
acc Int
0 Word
0
                | Bool
otherwise -> do
                    (MutArray MutByteArray
mba Int
_ Int
_ Int
_) :: MutArray a <-
                        IO (MutArray a) -> m (MutArray a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (MutArray a) -> m (MutArray a))
-> IO (MutArray a) -> m (MutArray a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
Int -> m (MutArray a)
MA.emptyOf Int
patLen
                    Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a rh Word ck) b
 -> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b))
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a rh Word ck
 -> Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
-> SplitOnSeqState MutByteArray s a rh Word ck
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall a b. (a -> b) -> a -> b
$ s
-> Int
-> MutByteArray
-> SplitOnSeqState MutByteArray s a rh Word ck
forall mba acc a rh w ck.
acc -> Int -> mba -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqKR s
acc Int
0 MutByteArray
mba
            Done b
b -> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a rh Word ck) b
 -> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b))
-> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
-> m (Step (SplitOnSeqState MutByteArray s a rh Word ck) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (SplitOnSeqState MutByteArray s a rh Word ck) b
forall s b. b -> Step s b
Done b
b

    -- Word pattern related
    elemBits :: Int
elemBits = SIZE_OF(a) * 8

    wordMask :: Word
    wordMask :: Word
wordMask = (Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` (Int
elemBits Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
patLen)) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1

    elemMask :: Word
    elemMask :: Word
elemMask = (Word
1 Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftL` Int
elemBits) Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1

    wordPat :: Word
    wordPat :: Word
wordPat = Word
wordMask Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Word -> a -> Word) -> Word -> Array a -> Word
forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b
Array.foldl' Word -> a -> Word
forall {a} {a}. (Bits a, Num a, Enum a) => a -> a -> a
addToWord Word
0 Array a
patArr

    addToWord :: a -> a -> a
addToWord a
wd a
a = (a
wd a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftL` Int
elemBits) a -> a -> a
forall a. Bits a => a -> a -> a
.|. Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int
forall a. Enum a => a -> Int
fromEnum a
a)

    -- For Rabin-Karp search
    k :: Word32
k = Word32
2891336453 :: Word32
    coeff :: Word32
coeff = Word32
k Word32 -> Int -> Word32
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
patLen

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

    deltaCksum :: Word32 -> a -> a -> Word32
deltaCksum Word32
cksum a
old a
new =
        Word32 -> a -> Word32
forall {a}. Enum a => Word32 -> a -> Word32
addCksum Word32
cksum a
new Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
coeff Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Int
forall a. Enum a => a -> Int
fromEnum a
old)

    -- XXX shall we use a random starting hash or 1 instead of 0?
    -- XXX Need to keep this cached across fold calls in foldMany
    -- XXX We may need refold to inject the cached state instead of
    -- initializing the state every time.
    -- XXX Allocation of ring buffer should also be done once
    patHash :: Word32
patHash = (Word32 -> a -> Word32) -> Word32 -> Array a -> Word32
forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b
Array.foldl' Word32 -> a -> Word32
forall {a}. Enum a => Word32 -> a -> Word32
addCksum Word32
0 Array a
patArr

    step :: SplitOnSeqState MutByteArray s a Int Word Word32
-> a
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
step (SplitOnSeqEmpty s
s) a
x = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
x
        case Step s b
res of
            Partial s
s1 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s -> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck. acc -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqEmpty s
s1
            Done b
b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done b
b
    step (SplitOnSeqSingle s
s a
pat) a
x = do
        if a
pat a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x
        then do
            Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
x
            case Step s b
res of
                Partial s
s1 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s -> a -> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck.
acc -> a -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqSingle s
s1 a
pat
                Done b
b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done b
b
        else b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done (b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> m b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s
    step (SplitOnSeqWord s
s Int
idx Word
wrd) a
x = do
        let wrd1 :: Word
wrd1 = Word -> a -> Word
forall {a} {a}. (Bits a, Num a, Enum a) => a -> a -> a
addToWord Word
wrd a
x
        if Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxIndex
        then do
            if Word
wrd1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
wordMask Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
wordPat
            then b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done (b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> m b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s
            else Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s -> Word -> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck.
acc -> w -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqWordLoop s
s Word
wrd1
        else Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s
-> Int -> Word -> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck.
acc -> Int -> w -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqWord s
s (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word
wrd1
    step (SplitOnSeqWordLoop s
s Word
wrd) a
x = do
        let wrd1 :: Word
wrd1 = Word -> a -> Word
forall {a} {a}. (Bits a, Num a, Enum a) => a -> a -> a
addToWord Word
wrd a
x
            old :: Word
old = (Word
wordMask Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
wrd)
                    Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` (Int
elemBits Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
patLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s (Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
old)
        case Step s b
res of
            Partial s
s1
                | Word
wrd1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
wordMask Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
wordPat ->
                    b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done (b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> m b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s1
                | Bool
otherwise ->
                    Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s -> Word -> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck.
acc -> w -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqWordLoop s
s1 Word
wrd1
            Done b
b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done b
b
    step (SplitOnSeqKR s
s Int
offset MutByteArray
mba) a
x = do
        IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> a -> IO ()
forall a. Unbox a => Int -> MutByteArray -> a -> IO ()
pokeAt Int
offset MutByteArray
mba a
x
        if Int
offset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxOffset
        then do
            let Array a
arr :: Array a = Array
                        { arrContents :: MutByteArray
arrContents = MutByteArray
mba
                        , arrStart :: Int
arrStart = Int
0
                        , arrEnd :: Int
arrEnd = Int
patBytes
                        }
            let ringHash :: Word32
ringHash = (Word32 -> a -> Word32) -> Word32 -> Array a -> Word32
forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b
Array.foldl' Word32 -> a -> Word32
forall {a}. Enum a => Word32 -> a -> Word32
addCksum Word32
0 Array a
arr
            if Word32
ringHash Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
patHash Bool -> Bool -> Bool
&& Array a -> Array a -> Bool
forall a. Array a -> Array a -> Bool
Array.byteEq Array a
arr Array a
patArr
            then b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done (b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> m b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s
            else Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s
-> Word32
-> MutByteArray
-> Int
-> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck.
acc -> ck -> mba -> rh -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqKRLoop s
s Word32
ringHash MutByteArray
mba Int
0
        else Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s
-> Int
-> MutByteArray
-> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck.
acc -> Int -> mba -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqKR s
s (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a)) mba
    step (SplitOnSeqKRLoop s
s Word32
cksum MutByteArray
mba Int
offset) a
x = do
        let rb :: RingArray a
rb = RingArray
                { ringContents :: MutByteArray
ringContents = MutByteArray
mba
                , ringSize :: Int
ringSize = Int
patBytes
                , ringHead :: Int
ringHead = Int
offset
                }
        (RingArray a
rb1, a
old :: a) <- IO (RingArray a, a) -> m (RingArray a, a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (RingArray a -> a -> IO (RingArray a, a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
RingArray a -> a -> m (RingArray a, a)
RingArray.replace RingArray a
forall {a}. RingArray a
rb a
x)
        Step s b
res <- s -> a -> m (Step s b)
fstep s
s a
old
        case Step s b
res of
            Partial s
s1 -> do
                let ringHash :: Word32
ringHash = Word32 -> a -> a -> Word32
forall {a} {a}. (Enum a, Enum a) => Word32 -> a -> a -> Word32
deltaCksum Word32
cksum a
old a
x
                let rh1 :: Int
rh1 = RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb1
                Bool
matches <-
                    if Word32
ringHash Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
patHash
                    then IO Bool -> m Bool
forall a. IO a -> m a
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
$ RingArray a -> Array a -> IO Bool
forall a. RingArray a -> Array a -> IO Bool
RingArray.eqArray RingArray a
rb1 Array a
patArr
                    else Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                if Bool
matches
                then b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done (b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> m b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m b
ffinal s
s1
                else Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. s -> Step s b
Partial (SplitOnSeqState MutByteArray s a Int Word Word32
 -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
-> SplitOnSeqState MutByteArray s a Int Word Word32
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall a b. (a -> b) -> a -> b
$ s
-> Word32
-> MutByteArray
-> Int
-> SplitOnSeqState MutByteArray s a Int Word Word32
forall mba acc a rh w ck.
acc -> ck -> mba -> rh -> SplitOnSeqState mba acc a rh w ck
SplitOnSeqKRLoop s
s1 Word32
ringHash MutByteArray
mba Int
rh1
            Done b
b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
 -> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b))
-> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
-> m (Step (SplitOnSeqState MutByteArray s a Int Word Word32) b)
forall a b. (a -> b) -> a -> b
$ b -> Step (SplitOnSeqState MutByteArray s a Int Word Word32) b
forall s b. b -> Step s b
Done b
b

    -- XXX extract should return backtrack count as well. If the fold
    -- terminates early inside extract, we may still have buffered data
    -- remaining which will be lost if we do not communicate that to the
    -- driver.
    extractFunc :: (s -> m b) -> SplitOnSeqState MutByteArray s a Int Word ck -> m b
extractFunc s -> m b
fex SplitOnSeqState MutByteArray s a Int Word ck
state = do
        let consumeWord :: s -> Int -> Word -> m b
consumeWord s
s Int
n Word
wrd = do
                if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then s -> m b
fex s
s
                else do
                    let old :: Word
old = Word
elemMask Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Word
wrd Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` (Int
elemBits Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
                    Step s b
r <- s -> a -> m (Step s b)
fstep s
s (Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
old)
                    case Step s b
r of
                        Partial s
s1 -> s -> Int -> Word -> m b
consumeWord s
s1 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word
wrd
                        Done b
b -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

        let consumeArray :: s -> Int -> MutByteArray -> Int -> m b
consumeArray s
s Int
end MutByteArray
mba Int
offset =
                if Int
offset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
end
                then s -> m b
fex s
s
                else do
                    a
old <- IO a -> m a
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> MutByteArray -> IO a
forall a. Unbox a => Int -> MutByteArray -> IO a
peekAt Int
offset MutByteArray
mba
                    Step s b
r <- s -> a -> m (Step s b)
fstep s
s a
old
                    case Step s b
r of
                        Partial s
s1 ->
                            s -> Int -> MutByteArray -> Int -> m b
consumeArray s
s1 Int
end MutByteArray
mba (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a))
                        Done b
b -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

        let consumeRing :: s -> Int -> MutByteArray -> Int -> m b
consumeRing s
s Int
orig MutByteArray
mba Int
offset = do
                let RingArray a
rb :: RingArray a = RingArray
                            { ringContents :: MutByteArray
ringContents = MutByteArray
mba
                            , ringSize :: Int
ringSize = Int
patBytes
                            , ringHead :: Int
ringHead = Int
offset
                            }
                a
old <- RingArray a -> m a
forall (m :: * -> *) a. (MonadIO m, Unbox a) => RingArray a -> m a
RingArray.unsafeGetHead RingArray a
rb
                let rb1 :: RingArray a
rb1 = RingArray a -> RingArray a
forall a. Unbox a => RingArray a -> RingArray a
RingArray.moveForward RingArray a
rb
                Step s b
r <- s -> a -> m (Step s b)
fstep s
s a
old
                case Step s b
r of
                    Partial s
s1 ->
                        let rh :: Int
rh = RingArray a -> Int
forall a. RingArray a -> Int
ringHead RingArray a
rb1
                         in if Int
rh Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
orig
                            then s -> m b
fex s
s1
                            else s -> Int -> MutByteArray -> Int -> m b
consumeRing s
s1 Int
orig MutByteArray
mba Int
rh
                    Done b
b -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b

        case SplitOnSeqState MutByteArray s a Int Word ck
state of
            SplitOnSeqEmpty s
s -> s -> m b
fex s
s
            SplitOnSeqSingle s
s a
_ -> s -> m b
fex s
s
            SplitOnSeqWord s
s Int
idx Word
wrd -> s -> Int -> Word -> m b
consumeWord s
s Int
idx Word
wrd
            SplitOnSeqWordLoop s
s Word
wrd -> s -> Int -> Word -> m b
consumeWord s
s Int
patLen Word
wrd
            SplitOnSeqKR s
s Int
end MutByteArray
mba -> s -> Int -> MutByteArray -> Int -> m b
consumeArray s
s Int
end MutByteArray
mba Int
0
            SplitOnSeqKRLoop s
s ck
_ MutByteArray
mba Int
rh -> s -> Int -> MutByteArray -> Int -> m b
consumeRing s
s Int
rh MutByteArray
mba Int
rh

    extract :: SplitOnSeqState MutByteArray s a Int Word ck -> m b
extract = (s -> m b) -> SplitOnSeqState MutByteArray s a Int Word ck -> m b
forall {a} {ck}.
(s -> m b) -> SplitOnSeqState MutByteArray s a Int Word ck -> m b
extractFunc s -> m b
fextract

    final :: SplitOnSeqState MutByteArray s a Int Word ck -> m b
final = (s -> m b) -> SplitOnSeqState MutByteArray s a Int Word ck -> m b
forall {a} {ck}.
(s -> m b) -> SplitOnSeqState MutByteArray s a Int Word ck -> m b
extractFunc s -> m b
ffinal

------------------------------------------------------------------------------
-- 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--------|
-- @
--
--  Definition:
--
-- >>> tee = Fold.teeWith (,)
--
-- Example:
--
-- >>> t = Fold.tee Fold.sum Fold.length
-- >>> Stream.fold t (Stream.enumerateFromTo 1.0 100.0)
-- (5050.0,100)
--
{-# INLINE tee #-}
tee :: Monad m => Fold m a b -> Fold m a c -> Fold m a (b,c)
tee :: forall (m :: * -> *) a b c.
Monad m =>
Fold m a b -> Fold m a c -> Fold m a (b, c)
tee = (b -> c -> (b, c)) -> Fold m a b -> Fold m a c -> Fold m a (b, c)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
teeWith (,)

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

-- XXX use mutable cells for better performance.

-- | Distribute the input to the folds returned by an effect. The effect is
-- executed every time an input is processed, and the folds returned by it are
-- added to the distribution list. The scan returns the results of the folds as
-- they complete. To avoid adding the same folds repeatedly, the action must
-- return the folds only once e.g. it can be implemented using modifyIORef
-- replacing the original value by an empty list before returning it.
--
-- >>> import Data.IORef
-- >>> ref <- newIORef [Fold.take 2 Fold.sum, Fold.take 2 Fold.length :: Fold IO Int Int]
-- >>> gen = atomicModifyIORef ref (\xs -> ([], xs))
-- >>> Stream.toList $ Stream.scanl (Fold.distributeScan gen) (Stream.enumerateFromTo 1 10)
-- [[],[],[],[2,3],[],[],[],[],[],[],[]]
--
{-# INLINE distributeScan #-}
distributeScan :: Monad m => m [Fold m a b] -> Scanl m a [b]
distributeScan :: forall (m :: * -> *) a b.
Monad m =>
m [Fold m a b] -> Scanl m a [b]
distributeScan m [Fold m a b]
getFolds = (Tuple' [Fold m a b] [b]
 -> a -> m (Step (Tuple' [Fold m a b] [b]) [b]))
-> m (Step (Tuple' [Fold m a b] [b]) [b])
-> (Tuple' [Fold m a b] [b] -> m [b])
-> (Tuple' [Fold m a b] [b] -> m [b])
-> Scanl m a [b]
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Scanl m a b
Scanl Tuple' [Fold m a b] [b]
-> a -> m (Step (Tuple' [Fold m a b] [b]) [b])
forall {b} {b}.
Tuple' [Fold m a b] b -> a -> m (Step (Tuple' [Fold m a b] [b]) b)
consume m (Step (Tuple' [Fold m a b] [b]) [b])
forall {a} {a} {b}. m (Step (Tuple' [a] [a]) b)
initial Tuple' [Fold m a b] [b] -> m [b]
forall {m :: * -> *} {a} {a}. Monad m => Tuple' a a -> m a
extract Tuple' [Fold m a b] [b] -> m [b]
forall {t :: * -> *} {m :: * -> *} {a} {b} {b}.
(Foldable t, Monad m) =>
Tuple' (t (Fold m a b)) b -> m b
final

    where

    initial :: m (Step (Tuple' [a] [a]) b)
initial = Step (Tuple' [a] [a]) b -> m (Step (Tuple' [a] [a]) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' [a] [a]) b -> m (Step (Tuple' [a] [a]) b))
-> Step (Tuple' [a] [a]) b -> m (Step (Tuple' [a] [a]) b)
forall a b. (a -> b) -> a -> b
$ Tuple' [a] [a] -> Step (Tuple' [a] [a]) b
forall s b. s -> Step s b
Partial ([a] -> [a] -> Tuple' [a] [a]
forall a b. a -> b -> Tuple' a b
Tuple' [] [])

    run :: Tuple' [Fold m a b] [b]
-> [Fold m a b] -> a -> m (Step (Tuple' [Fold m a b] [b]) b)
run Tuple' [Fold m a b] [b]
st [] a
_ = Step (Tuple' [Fold m a b] [b]) b
-> m (Step (Tuple' [Fold m a b] [b]) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' [Fold m a b] [b]) b
 -> m (Step (Tuple' [Fold m a b] [b]) b))
-> Step (Tuple' [Fold m a b] [b]) b
-> m (Step (Tuple' [Fold m a b] [b]) b)
forall a b. (a -> b) -> a -> b
$ Tuple' [Fold m a b] [b] -> Step (Tuple' [Fold m a b] [b]) b
forall s b. s -> Step s b
Partial Tuple' [Fold m a b] [b]
st
    run (Tuple' [Fold m a b]
ys [b]
zs) (Fold s -> a -> m (Step s b)
step m (Step s b)
init s -> m b
extr s -> m b
fin : [Fold m a b]
xs) a
a = do
        Step s b
res <- m (Step s b)
init
        case Step s b
res of
            Partial s
fs -> do
              Step s b
r <- s -> a -> m (Step s b)
step s
fs a
a
              Tuple' [Fold m a b] [b]
-> [Fold m a b] -> a -> m (Step (Tuple' [Fold m a b] [b]) b)
run ([Fold m a b] -> [b] -> Tuple' [Fold m a b] [b]
forall a b. a -> b -> Tuple' a b
Tuple' ((s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s b)
step (Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step s b
r) s -> m b
extr s -> m b
fin Fold m a b -> [Fold m a b] -> [Fold m a b]
forall a. a -> [a] -> [a]
: [Fold m a b]
ys) [b]
zs) [Fold m a b]
xs a
a
            Done b
b -> do
              Tuple' [Fold m a b] [b]
-> [Fold m a b] -> a -> m (Step (Tuple' [Fold m a b] [b]) b)
run ([Fold m a b] -> [b] -> Tuple' [Fold m a b] [b]
forall a b. a -> b -> Tuple' a b
Tuple' [Fold m a b]
ys (b
b b -> [b] -> [b]
forall a. a -> [a] -> [a]
: [b]
zs)) [Fold m a b]
xs a
a

    consume :: Tuple' [Fold m a b] b -> a -> m (Step (Tuple' [Fold m a b] [b]) b)
consume (Tuple' [Fold m a b]
st b
_) a
x = do
        [Fold m a b]
xs <- m [Fold m a b]
getFolds
        [Fold m a b]
xs1 <- (Fold m a b -> m (Fold m a b)) -> [Fold m a b] -> m [Fold m a b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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)
reduce [Fold m a b]
xs
        let st1 :: [Fold m a b]
st1 = [Fold m a b]
st [Fold m a b] -> [Fold m a b] -> [Fold m a b]
forall a. [a] -> [a] -> [a]
++ [Fold m a b]
xs1
        Tuple' [Fold m a b] [b]
-> [Fold m a b] -> a -> m (Step (Tuple' [Fold m a b] [b]) b)
forall {m :: * -> *} {a} {b} {b}.
Monad m =>
Tuple' [Fold m a b] [b]
-> [Fold m a b] -> a -> m (Step (Tuple' [Fold m a b] [b]) b)
run ([Fold m a b] -> [b] -> Tuple' [Fold m a b] [b]
forall a b. a -> b -> Tuple' a b
Tuple' [] []) [Fold m a b]
st1 a
x

    extract :: Tuple' a a -> m a
extract (Tuple' a
_ a
done) = a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
done

    final :: Tuple' (t (Fold m a b)) b -> m b
final (Tuple' t (Fold m a b)
st b
done) = 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 m a b -> m b
forall (m :: * -> *) a b. Monad m => Fold m a b -> m b
finalM t (Fold m a b)
st
        b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
done

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

{-# INLINE partitionByMUsing #-}
partitionByMUsing :: Monad m =>
       (  (x -> y -> (x, y))
       -> Fold m (Either b c) x
       -> Fold m (Either b c) y
       -> Fold m (Either b c) (x, y)
       )
    -> (a -> m (Either b c))
    -> Fold m b x
    -> Fold m c y
    -> Fold m a (x, y)
partitionByMUsing :: forall (m :: * -> *) x y b c a.
Monad m =>
((x -> y -> (x, y))
 -> Fold m (Either b c) x
 -> Fold m (Either b c) y
 -> Fold m (Either b c) (x, y))
-> (a -> m (Either b c))
-> Fold m b x
-> Fold m c y
-> Fold m a (x, y)
partitionByMUsing (x -> y -> (x, y))
-> Fold m (Either b c) x
-> Fold m (Either b c) y
-> Fold m (Either b c) (x, y)
t a -> m (Either b c)
f Fold m b x
fld1 Fold m c y
fld2 =
    let l :: Fold m (Either b b) x
l = (Either b b -> b) -> Fold m b x -> Fold m (Either b b) x
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (b -> Either b b -> b
forall a b. a -> Either a b -> a
fromLeft b
forall a. HasCallStack => a
undefined) Fold m b x
fld1  -- :: Fold m (Either b c) x
        r :: Fold m (Either a c) y
r = (Either a c -> c) -> Fold m c y -> Fold m (Either a c) y
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (c -> Either a c -> c
forall b a. b -> Either a b -> b
fromRight c
forall a. HasCallStack => a
undefined) Fold m c y
fld2 -- :: Fold m (Either b c) y
     in (a -> m (Either b c))
-> Fold m (Either b c) (x, y) -> Fold m a (x, y)
forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> Fold m b r -> Fold m a r
lmapM a -> m (Either b c)
f ((x -> y -> (x, y))
-> Fold m (Either b c) x
-> Fold m (Either b c) y
-> Fold m (Either b c) (x, y)
t (,) ((Either b c -> Bool)
-> Fold m (Either b c) x -> Fold m (Either b c) x
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Fold m a r -> Fold m a r
filter Either b c -> Bool
forall a b. Either a b -> Bool
isLeft Fold m (Either b c) x
forall {b}. Fold m (Either b b) x
l) ((Either b c -> Bool)
-> Fold m (Either b c) y -> Fold m (Either b c) y
forall (m :: * -> *) a r.
Monad m =>
(a -> Bool) -> Fold m a r -> Fold m a r
filter Either b c -> Bool
forall a b. Either a b -> Bool
isRight Fold m (Either b c) y
forall {a}. Fold m (Either a c) y
r))

-- | 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--------|
-- @
--
-- Example, send input to either fold randomly:
--
-- >>> :set -package random
-- >>> import System.Random (randomIO)
-- >>> randomly a = randomIO >>= \x -> return $ if x then Left a else Right a
-- >>> f = Fold.partitionByM randomly Fold.length Fold.length
-- >>> Stream.fold f (Stream.enumerateFromTo 1 100)
-- ...
--
-- Example, send input to the two folds in a proportion of 2:1:
--
-- >>> :set -fno-warn-unrecognised-warning-flags
-- >>> :set -fno-warn-x-partial
-- >>> :{
-- 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 $ Prelude.head r a
-- :}
--
-- >>> :{
-- main = do
--  g <- proportionately 2 1
--  let f = Fold.partitionByM g Fold.length Fold.length
--  r <- Stream.fold f (Stream.enumerateFromTo (1 :: Int) 100)
--  print r
-- :}
--
-- >>> main
-- (67,33)
--
--
-- This is the consumer side dual of the producer side 'mergeBy' operation.
--
-- When one fold is done, any input meant for it is ignored until the other
-- fold is also done.
--
-- Stops when both the folds stop.
--
-- /See also: 'partitionByFstM' and 'partitionByMinM'./
--
-- /Pre-release/
{-# INLINE partitionByM #-}
partitionByM :: Monad m
    => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionByM :: 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 = ((x -> y -> (x, y))
 -> Fold m (Either b c) x
 -> Fold m (Either b c) y
 -> Fold m (Either b c) (x, y))
-> (a -> m (Either b c))
-> Fold m b x
-> Fold m c y
-> Fold m a (x, y)
forall (m :: * -> *) x y b c a.
Monad m =>
((x -> y -> (x, y))
 -> Fold m (Either b c) x
 -> Fold m (Either b c) y
 -> Fold m (Either b c) (x, y))
-> (a -> m (Either b c))
-> Fold m b x
-> Fold m c y
-> Fold m a (x, y)
partitionByMUsing (x -> y -> (x, y))
-> Fold m (Either b c) x
-> Fold m (Either b c) y
-> Fold m (Either b c) (x, y)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
teeWith

-- | Similar to 'partitionByM' but terminates when the first fold terminates.
--
{-# INLINE partitionByFstM #-}
partitionByFstM :: Monad m
    => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionByFstM :: 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)
partitionByFstM = ((x -> y -> (x, y))
 -> Fold m (Either b c) x
 -> Fold m (Either b c) y
 -> Fold m (Either b c) (x, y))
-> (a -> m (Either b c))
-> Fold m b x
-> Fold m c y
-> Fold m a (x, y)
forall (m :: * -> *) x y b c a.
Monad m =>
((x -> y -> (x, y))
 -> Fold m (Either b c) x
 -> Fold m (Either b c) y
 -> Fold m (Either b c) (x, y))
-> (a -> m (Either b c))
-> Fold m b x
-> Fold m c y
-> Fold m a (x, y)
partitionByMUsing (x -> y -> (x, y))
-> Fold m (Either b c) x
-> Fold m (Either b c) y
-> Fold m (Either b c) (x, y)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
teeWithFst

-- | Similar to 'partitionByM' but terminates when any fold terminates.
--
{-# INLINE partitionByMinM #-}
partitionByMinM :: Monad m =>
    (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionByMinM :: 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)
partitionByMinM = ((x -> y -> (x, y))
 -> Fold m (Either b c) x
 -> Fold m (Either b c) y
 -> Fold m (Either b c) (x, y))
-> (a -> m (Either b c))
-> Fold m b x
-> Fold m c y
-> Fold m a (x, y)
forall (m :: * -> *) x y b c a.
Monad m =>
((x -> y -> (x, y))
 -> Fold m (Either b c) x
 -> Fold m (Either b c) y
 -> Fold m (Either b c) (x, y))
-> (a -> m (Either b c))
-> Fold m b x
-> Fold m c y
-> Fold m a (x, y)
partitionByMUsing (x -> y -> (x, y))
-> Fold m (Either b c) x
-> Fold m (Either b c) y
-> Fold m (Either b c) (x, y)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
teeWithMin

-- 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.
--
-- Example, count even and odd numbers in a stream:
--
-- >>> :{
--  let f = Fold.partitionBy (\n -> if even n then Left n else Right n)
--                      (fmap (("Even " ++) . show) Fold.length)
--                      (fmap (("Odd "  ++) . show) Fold.length)
--   in Stream.fold f (Stream.enumerateFromTo 1 100)
-- :}
-- ("Even 50","Odd 50")
--
-- /Pre-release/
{-# INLINE partitionBy #-}
partitionBy :: Monad m
    => (a -> Either b c) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionBy :: forall (m :: * -> *) a b c x y.
Monad m =>
(a -> Either b c) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
partitionBy a -> Either b c
f = (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 a. a -> m a
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.
--
-- Definition:
--
-- >>> partition = Fold.partitionBy id
--
{-# INLINE partition #-}
partition :: Monad m
    => Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)
partition :: forall (m :: * -> *) b x c y.
Monad m =>
Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)
partition = (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
-}

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

{-# INLINE unzipWithMUsing #-}
unzipWithMUsing :: Monad m =>
       (  (x -> y -> (x, y))
       -> Fold m (b, c) x
       -> Fold m (b, c) y
       -> Fold m (b, c) (x, y)
       )
    -> (a -> m (b, c))
    -> Fold m b x
    -> Fold m c y
    -> Fold m a (x, y)
unzipWithMUsing :: forall (m :: * -> *) x y b c a.
Monad m =>
((x -> y -> (x, y))
 -> Fold m (b, c) x -> Fold m (b, c) y -> Fold m (b, c) (x, y))
-> (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
unzipWithMUsing (x -> y -> (x, y))
-> Fold m (b, c) x -> Fold m (b, c) y -> Fold m (b, c) (x, y)
t a -> m (b, c)
f Fold m b x
fld1 Fold m c y
fld2 =
    let f1 :: Fold m (b, b) x
f1 = ((b, b) -> b) -> Fold m b x -> Fold m (b, b) x
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (b, b) -> b
forall a b. (a, b) -> a
fst Fold m b x
fld1  -- :: Fold m (b, c) b
        f2 :: Fold m (a, c) y
f2 = ((a, c) -> c) -> Fold m c y -> Fold m (a, c) y
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
lmap (a, c) -> c
forall a b. (a, b) -> b
snd Fold m c y
fld2  -- :: Fold m (b, c) c
     in (a -> m (b, c)) -> Fold m (b, c) (x, y) -> Fold m a (x, y)
forall (m :: * -> *) a b r.
Monad m =>
(a -> m b) -> Fold m b r -> Fold m a r
lmapM a -> m (b, c)
f ((x -> y -> (x, y))
-> Fold m (b, c) x -> Fold m (b, c) y -> Fold m (b, c) (x, y)
t (,) Fold m (b, c) x
forall {b}. Fold m (b, b) x
f1 Fold m (b, c) y
forall {a}. Fold m (a, c) y
f2)

-- | Like 'unzipWith' but with a monadic splitter function.
--
-- Definition:
--
-- >>> unzipWithM k f1 f2 = Fold.lmapM k (Fold.unzip f1 f2)
--
-- /Pre-release/
{-# INLINE unzipWithM #-}
unzipWithM :: Monad m
    => (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
unzipWithM :: 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 = ((x -> y -> (x, y))
 -> Fold m (b, c) x -> Fold m (b, c) y -> Fold m (b, c) (x, y))
-> (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
forall (m :: * -> *) x y b c a.
Monad m =>
((x -> y -> (x, y))
 -> Fold m (b, c) x -> Fold m (b, c) y -> Fold m (b, c) (x, y))
-> (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
unzipWithMUsing (x -> y -> (x, y))
-> Fold m (b, c) x -> Fold m (b, c) y -> Fold m (b, c) (x, y)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
teeWith

-- | Similar to 'unzipWithM' but terminates when the first fold terminates.
--
{-# INLINE unzipWithFstM #-}
unzipWithFstM :: Monad m =>
    (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
unzipWithFstM :: 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)
unzipWithFstM = ((x -> y -> (x, y))
 -> Fold m (b, c) x -> Fold m (b, c) y -> Fold m (b, c) (x, y))
-> (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
forall (m :: * -> *) x y b c a.
Monad m =>
((x -> y -> (x, y))
 -> Fold m (b, c) x -> Fold m (b, c) y -> Fold m (b, c) (x, y))
-> (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
unzipWithMUsing (x -> y -> (x, y))
-> Fold m (b, c) x -> Fold m (b, c) y -> Fold m (b, c) (x, y)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
teeWithFst

-- | Similar to 'unzipWithM' but terminates when any fold terminates.
--
{-# INLINE unzipWithMinM #-}
unzipWithMinM :: Monad m =>
    (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
unzipWithMinM :: 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)
unzipWithMinM = ((x -> y -> (x, y))
 -> Fold m (b, c) x -> Fold m (b, c) y -> Fold m (b, c) (x, y))
-> (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
forall (m :: * -> *) x y b c a.
Monad m =>
((x -> y -> (x, y))
 -> Fold m (b, c) x -> Fold m (b, c) y -> Fold m (b, c) (x, y))
-> (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
unzipWithMUsing (x -> y -> (x, y))
-> Fold m (b, c) x -> Fold m (b, c) y -> Fold m (b, c) (x, y)
forall (m :: * -> *) a b c x.
Monad m =>
(a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c
teeWithMin

-- | 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.
--
-- Definitions:
--
-- >>> unzipWith f = Fold.unzipWithM (return . f)
-- >>> unzipWith f fld1 fld2 = Fold.lmap f (Fold.unzip fld1 fld2)
--
-- This fold terminates when both the input folds terminate.
--
-- /Pre-release/
{-# INLINE unzipWith #-}
unzipWith :: Monad m
    => (a -> (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)
unzipWith :: forall (m :: * -> *) a b c x y.
Monad m =>
(a -> (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
unzipWith a -> (b, c)
f = (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 a. a -> m a
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--------|
--
-- @
--
-- Definition:
--
-- >>> unzip = Fold.unzipWith id
--
-- This is the consumer side dual of the producer side 'zip' operation.
--
{-# INLINE unzip #-}
unzip :: Monad m => Fold m a x -> Fold m b y -> Fold m (a,b) (x,y)
unzip :: forall (m :: * -> *) a x b y.
Monad m =>
Fold m a x -> Fold m b y -> Fold m (a, b) (x, y)
unzip = ((a, b) -> (a, b))
-> Fold m a x -> Fold m b y -> Fold m (a, b) (x, y)
forall (m :: * -> *) a b c x y.
Monad m =>
(a -> (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)
unzipWith (a, b) -> (a, b)
forall a. a -> a
id

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

-- XXX These can be implemented using the fold scan, using the stream as a
-- state.
-- XXX Stream Skip state cannot be efficiently handled in folds but can be
-- handled in parsers using the Continue facility. See zipWithM in the Parser
-- module.
--
-- cmpBy, eqBy, isPrefixOf, isSubsequenceOf etc can be implemented using
-- zipStream.

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

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

-- | Pair each element of a fold input with its index, starting from index 0.
--
{-# DEPRECATED indexingWith "Use Scanl.indexingWith instead" #-}
{-# INLINE indexingWith #-}
indexingWith :: Monad m => Int -> (Int -> Int) -> Fold m a (Maybe (Int, a))
indexingWith :: forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> Int) -> Fold m a (Maybe (Int, a))
indexingWith Int
i Int -> Int
f = (Maybe' (Int, a) -> Maybe (Int, a))
-> Fold m a (Maybe' (Int, a)) -> Fold m a (Maybe (Int, a))
forall a b. (a -> b) -> Fold m a a -> Fold m a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe' (Int, a) -> Maybe (Int, a)
forall a. Maybe' a -> Maybe a
toMaybe (Fold m a (Maybe' (Int, a)) -> Fold m a (Maybe (Int, a)))
-> Fold m a (Maybe' (Int, a)) -> Fold m a (Maybe (Int, a))
forall a b. (a -> b) -> a -> b
$ (Maybe' (Int, a) -> a -> Maybe' (Int, a))
-> Maybe' (Int, a) -> Fold m a (Maybe' (Int, a))
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> b) -> b -> Fold m a b
foldl' Maybe' (Int, a) -> a -> Maybe' (Int, a)
forall {b} {b}. Maybe' (Int, b) -> b -> Maybe' (Int, b)
step Maybe' (Int, a)
forall a. Maybe' a
initial

    where

    initial :: Maybe' a
initial = Maybe' a
forall a. Maybe' a
Nothing'

    step :: Maybe' (Int, b) -> b -> Maybe' (Int, b)
step Maybe' (Int, b)
Nothing' b
a = (Int, b) -> Maybe' (Int, b)
forall a. a -> Maybe' a
Just' (Int
i, b
a)
    step (Just' (Int
n, b
_)) b
a = (Int, b) -> Maybe' (Int, b)
forall a. a -> Maybe' a
Just' (Int -> Int
f Int
n, b
a)

-- |
-- >> indexing = Fold.indexingWith 0 (+ 1)
--
{-# DEPRECATED indexing "Use Scanl.indexing instead" #-}
{-# INLINE indexing #-}
indexing :: Monad m => Fold m a (Maybe (Int, a))
indexing :: forall (m :: * -> *) a. Monad m => Fold m a (Maybe (Int, a))
indexing = Int -> (Int -> Int) -> Fold m a (Maybe (Int, a))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> Int) -> Fold m a (Maybe (Int, a))
indexingWith Int
0 (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- |
-- >> indexingRev n = Fold.indexingWith n (subtract 1)
--
{-# DEPRECATED indexingRev "Use Scanl.indexingRev instead" #-}
{-# INLINE indexingRev #-}
indexingRev :: Monad m => Int -> Fold m a (Maybe (Int, a))
indexingRev :: forall (m :: * -> *) a. Monad m => Int -> Fold m a (Maybe (Int, a))
indexingRev Int
n = Int -> (Int -> Int) -> Fold m a (Maybe (Int, a))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> Int) -> Fold m a (Maybe (Int, a))
indexingWith Int
n (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1)

-- | Pair each element of a fold input with its index, starting from index 0.
--
-- >>> indexed = Fold.postscanlMaybe Scanl.indexing
--
{-# INLINE indexed #-}
indexed :: Monad m => Fold m (Int, a) b -> Fold m a b
indexed :: forall (m :: * -> *) a b.
Monad m =>
Fold m (Int, a) b -> Fold m a b
indexed = Scanl m a (Maybe (Int, a)) -> Fold m (Int, a) b -> Fold m a b
forall (m :: * -> *) a b c.
Monad m =>
Scanl m a (Maybe b) -> Fold m b c -> Fold m a c
postscanlMaybe Scanl m a (Maybe (Int, a))
forall (m :: * -> *) a. Monad m => Scanl m a (Maybe (Int, a))
Scanl.indexing

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

-- XXX Implement as a filter
-- sampleFromthen :: Monad m => Int -> Int -> Fold m a (Maybe a)

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

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

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

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

-- | A fold that buffers its input to a pure stream.
--
-- /Warning!/ working on large streams accumulated as buffers in memory could
-- be very inefficient, consider using "Streamly.Data.Array" instead.
--
-- >>> toStream = fmap Stream.fromList Fold.toList
--
-- /Pre-release/
{-# INLINE toStream #-}
toStream :: (Monad m, Monad n) => Fold m a (Stream n a)
toStream :: forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
Fold m a (Stream n a)
toStream = Scanl m a (Stream n a) -> Fold m a (Stream n a)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl Scanl m a (Stream n a)
forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
Scanl m a (Stream n a)
Scanl.toStream

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

--  xn : ... : x2 : x1 : []
{-# INLINE toStreamRev #-}
toStreamRev :: (Monad m, Monad n) => Fold m a (Stream n a)
toStreamRev :: forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
Fold m a (Stream n a)
toStreamRev = Scanl m a (Stream n a) -> Fold m a (Stream n a)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl Scanl m a (Stream n a)
forall (m :: * -> *) (n :: * -> *) a.
(Monad m, Monad n) =>
Scanl m a (Stream n a)
Scanl.toStreamRev

-- XXX This does not fuse. It contains a recursive step function. We will need
-- a Skip input constructor in the fold type to make it fuse.
--
-- | Unfold and flatten the input stream of a fold.
--
-- @
-- Stream.fold (unfoldMany u f) = Stream.fold f . Stream.unfoldMany u
-- @
--
-- /Pre-release/
{-# INLINE unfoldMany #-}
unfoldMany :: Monad m => Unfold m a b -> Fold m b c -> Fold m a c
unfoldMany :: forall (m :: * -> *) a b c.
Monad m =>
Unfold m a b -> Fold m b c -> Fold m a c
unfoldMany (Unfold s -> m (Step s b)
ustep a -> m s
inject) (Fold s -> b -> m (Step s c)
fstep m (Step s c)
initial s -> m c
extract s -> m c
final) =
    (s -> a -> m (Step s c))
-> m (Step s c) -> (s -> m c) -> (s -> m c) -> Fold m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold s -> a -> m (Step s c)
consume m (Step s c)
initial s -> m c
extract s -> m c
final

    where

    {-# INLINE produce #-}
    produce :: s -> s -> m (Step s c)
produce s
fs s
us = do
        Step s b
ures <- s -> m (Step s b)
ustep s
us
        case Step s b
ures of
            StreamD.Yield b
b s
us1 -> do
                Step s c
fres <- s -> b -> m (Step s c)
fstep s
fs b
b
                case Step s c
fres of
                    Partial s
fs1 -> s -> s -> m (Step s c)
produce s
fs1 s
us1
                    -- XXX What to do with the remaining stream?
                    Done c
c -> Step s c -> m (Step s c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s c -> m (Step s c)) -> Step s c -> m (Step s c)
forall a b. (a -> b) -> a -> b
$ c -> Step s c
forall s b. b -> Step s b
Done c
c
            StreamD.Skip s
us1 -> s -> s -> m (Step s c)
produce s
fs s
us1
            Step s b
StreamD.Stop -> Step s c -> m (Step s c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s c -> m (Step s c)) -> Step s c -> m (Step s c)
forall a b. (a -> b) -> a -> b
$ s -> Step s c
forall s b. s -> Step s b
Partial s
fs

    {-# INLINE_LATE consume #-}
    consume :: s -> a -> m (Step s c)
consume s
s a
a = a -> m s
inject a
a m s -> (s -> m (Step s c)) -> m (Step s c)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= s -> s -> m (Step s c)
produce s
s

-- | Get the bottom most @n@ elements using the supplied comparison function.
--
{-# INLINE bottomBy #-}
bottomBy :: (MonadIO m, Unbox a) =>
       (a -> a -> Ordering)
    -> Int
    -> Fold m a (MutArray a)
bottomBy :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(a -> a -> Ordering) -> Int -> Fold m a (MutArray a)
bottomBy a -> a -> Ordering
cmp = Scanl m a (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl (Scanl m a (MutArray a) -> Fold m a (MutArray a))
-> (Int -> Scanl m a (MutArray a)) -> Int -> Fold m a (MutArray a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Ordering) -> Int -> Scanl m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(a -> a -> Ordering) -> Int -> Scanl m a (MutArray a)
Scanl.bottomBy a -> a -> Ordering
cmp

-- | Get the top @n@ elements using the supplied comparison function.
--
-- To get bottom n elements instead:
--
-- >>> bottomBy cmp = Fold.topBy (flip cmp)
--
-- Example:
--
-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]
-- >>> Stream.fold (Fold.topBy compare 3) stream >>= MutArray.toList
-- [17,11,9]
--
-- /Pre-release/
--
{-# INLINE topBy #-}
topBy :: (MonadIO m, Unbox a) =>
       (a -> a -> Ordering)
    -> Int
    -> Fold m a (MutArray a)
topBy :: forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(a -> a -> Ordering) -> Int -> Fold m a (MutArray a)
topBy a -> a -> Ordering
cmp = (a -> a -> Ordering) -> Int -> Fold m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a) =>
(a -> a -> Ordering) -> Int -> Fold m a (MutArray a)
bottomBy ((a -> a -> Ordering) -> a -> a -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> Ordering
cmp)

-- | Fold the input stream to top n elements.
--
-- Definition:
--
-- >>> top = Fold.topBy compare
--
-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]
-- >>> Stream.fold (Fold.top 3) stream >>= MutArray.toList
-- [17,11,9]
--
-- /Pre-release/
{-# INLINE top #-}
top :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MutArray a)
top :: forall (m :: * -> *) a.
(MonadIO m, Unbox a, Ord a) =>
Int -> Fold m a (MutArray a)
top = Scanl m a (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl (Scanl m a (MutArray a) -> Fold m a (MutArray a))
-> (Int -> Scanl m a (MutArray a)) -> Int -> Fold m a (MutArray a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Scanl m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a, Ord a) =>
Int -> Scanl m a (MutArray a)
Scanl.top

-- | Fold the input stream to bottom n elements.
--
-- Definition:
--
-- >>> bottom = Fold.bottomBy compare
--
-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]
-- >>> Stream.fold (Fold.bottom 3) stream >>= MutArray.toList
-- [1,2,3]
--
-- /Pre-release/
{-# INLINE bottom #-}
bottom :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MutArray a)
bottom :: forall (m :: * -> *) a.
(MonadIO m, Unbox a, Ord a) =>
Int -> Fold m a (MutArray a)
bottom = Scanl m a (MutArray a) -> Fold m a (MutArray a)
forall (m :: * -> *) a b. Scanl m a b -> Fold m a b
fromScanl (Scanl m a (MutArray a) -> Fold m a (MutArray a))
-> (Int -> Scanl m a (MutArray a)) -> Int -> Fold m a (MutArray a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Scanl m a (MutArray a)
forall (m :: * -> *) a.
(MonadIO m, Unbox a, Ord a) =>
Int -> Scanl m a (MutArray a)
Scanl.bottom

------------------------------------------------------------------------------
-- Interspersed parsing
------------------------------------------------------------------------------

data IntersperseQState fs ps =
      IntersperseQUnquoted !fs !ps
    | IntersperseQQuoted !fs !ps
    | IntersperseQQuotedEsc !fs !ps

-- Useful for parsing CSV with quoting and escaping
{-# INLINE intersperseWithQuotes #-}
intersperseWithQuotes :: (Monad m, Eq a) =>
    a -> a -> a -> Fold m a b -> Fold m b c -> Fold m a c
intersperseWithQuotes :: forall (m :: * -> *) a b c.
(Monad m, Eq a) =>
a -> a -> a -> Fold m a b -> Fold m b c -> Fold m a c
intersperseWithQuotes
    a
quote
    a
esc
    a
separator
    (Fold s -> a -> m (Step s b)
stepL m (Step s b)
initialL s -> m b
_ s -> m b
finalL)
    (Fold s -> b -> m (Step s c)
stepR m (Step s c)
initialR s -> m c
extractR s -> m c
finalR) = (IntersperseQState s s -> a -> m (Step (IntersperseQState s s) c))
-> m (Step (IntersperseQState s s) c)
-> (IntersperseQState s s -> m c)
-> (IntersperseQState s s -> m c)
-> Fold m a c
forall (m :: * -> *) a b s.
(s -> a -> m (Step s b))
-> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b
Fold IntersperseQState s s -> a -> m (Step (IntersperseQState s s) c)
step m (Step (IntersperseQState s s) c)
initial IntersperseQState s s -> m c
forall {ps}. IntersperseQState s ps -> m c
extract IntersperseQState s s -> m c
final

    where

    errMsg :: [Char] -> [Char] -> a
errMsg [Char]
p [Char]
status =
        [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
"intersperseWithQuotes: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" parsing fold cannot "
                [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
status [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" without input"

    {-# INLINE initL #-}
    initL :: (s -> s) -> m (Step s b)
initL s -> s
mkState = do
        Step s b
resL <- m (Step s b)
initialL
        case Step s b
resL of
            Partial s
sL ->
                Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ s -> Step s b
forall s b. s -> Step s b
Partial (s -> Step s b) -> s -> Step s b
forall a b. (a -> b) -> a -> b
$ s -> s
mkState s
sL
            Done b
_ ->
                [Char] -> [Char] -> m (Step s b)
forall {a}. [Char] -> [Char] -> a
errMsg [Char]
"content" [Char]
"succeed"

    initial :: m (Step (IntersperseQState s s) c)
initial = do
        Step s c
res <- m (Step s c)
initialR
        case Step s c
res of
            Partial s
sR -> (s -> IntersperseQState s s) -> m (Step (IntersperseQState s s) c)
forall {s} {b}. (s -> s) -> m (Step s b)
initL (s -> s -> IntersperseQState s s
forall fs ps. fs -> ps -> IntersperseQState fs ps
IntersperseQUnquoted s
sR)
            Done c
b -> Step (IntersperseQState s s) c
-> m (Step (IntersperseQState s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (IntersperseQState s s) c
 -> m (Step (IntersperseQState s s) c))
-> Step (IntersperseQState s s) c
-> m (Step (IntersperseQState s s) c)
forall a b. (a -> b) -> a -> b
$ c -> Step (IntersperseQState s s) c
forall s b. b -> Step s b
Done c
b

    {-# INLINE collect #-}
    collect :: (s -> s -> s) -> s -> b -> m (Step s c)
collect s -> s -> s
nextS s
sR b
b = do
        Step s c
res <- s -> b -> m (Step s c)
stepR s
sR b
b
        case Step s c
res of
            Partial s
s ->
                (s -> s) -> m (Step s c)
forall {s} {b}. (s -> s) -> m (Step s b)
initL (s -> s -> s
nextS s
s)
            Done c
c -> Step s c -> m (Step s c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> Step s c
forall s b. b -> Step s b
Done c
c)

    {-# INLINE process #-}
    process :: a -> s -> s -> (s -> s -> s) -> m (Step s c)
process a
a s
sL s
sR s -> s -> s
nextState = do
        Step s b
r <- s -> a -> m (Step s b)
stepL s
sL a
a
        case Step s b
r of
            Partial s
s -> Step s c -> m (Step s c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s c -> m (Step s c)) -> Step s c -> m (Step s c)
forall a b. (a -> b) -> a -> b
$ s -> Step s c
forall s b. s -> Step s b
Partial (s -> s -> s
nextState s
sR s
s)
            Done b
b -> (s -> s -> s) -> s -> b -> m (Step s c)
forall {s}. (s -> s -> s) -> s -> b -> m (Step s c)
collect s -> s -> s
nextState s
sR b
b

    {-# INLINE processQuoted #-}
    processQuoted :: a -> s -> s -> (s -> s -> s) -> m (Step s b)
processQuoted a
a s
sL s
sR s -> s -> s
nextState = do
        Step s b
r <- s -> a -> m (Step s b)
stepL s
sL a
a
        case Step s b
r of
            Partial s
s -> Step s b -> m (Step s b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s b -> m (Step s b)) -> Step s b -> m (Step s b)
forall a b. (a -> b) -> a -> b
$ s -> Step s b
forall s b. s -> Step s b
Partial (s -> s -> s
nextState s
sR s
s)
            Done b
_ -> do
                c
_ <- s -> m c
finalR s
sR
                [Char] -> m (Step s b)
forall a. HasCallStack => [Char] -> a
error [Char]
"Collecting fold finished inside quote"

    step :: IntersperseQState s s -> a -> m (Step (IntersperseQState s s) c)
step (IntersperseQUnquoted s
sR s
sL) a
a
        | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
separator = do
            b
b <- s -> m b
finalL s
sL
            (s -> s -> IntersperseQState s s)
-> s -> b -> m (Step (IntersperseQState s s) c)
forall {s}. (s -> s -> s) -> s -> b -> m (Step s c)
collect s -> s -> IntersperseQState s s
forall fs ps. fs -> ps -> IntersperseQState fs ps
IntersperseQUnquoted s
sR b
b
        | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
quote = a
-> s
-> s
-> (s -> s -> IntersperseQState s s)
-> m (Step (IntersperseQState s s) c)
forall {s} {b}. a -> s -> s -> (s -> s -> s) -> m (Step s b)
processQuoted a
a s
sL s
sR s -> s -> IntersperseQState s s
forall fs ps. fs -> ps -> IntersperseQState fs ps
IntersperseQQuoted
        | Bool
otherwise = a
-> s
-> s
-> (s -> s -> IntersperseQState s s)
-> m (Step (IntersperseQState s s) c)
forall {s}. a -> s -> s -> (s -> s -> s) -> m (Step s c)
process a
a s
sL s
sR s -> s -> IntersperseQState s s
forall fs ps. fs -> ps -> IntersperseQState fs ps
IntersperseQUnquoted

    step (IntersperseQQuoted s
sR s
sL) a
a
        | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
esc = a
-> s
-> s
-> (s -> s -> IntersperseQState s s)
-> m (Step (IntersperseQState s s) c)
forall {s} {b}. a -> s -> s -> (s -> s -> s) -> m (Step s b)
processQuoted a
a s
sL s
sR s -> s -> IntersperseQState s s
forall fs ps. fs -> ps -> IntersperseQState fs ps
IntersperseQQuotedEsc
        | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
quote = a
-> s
-> s
-> (s -> s -> IntersperseQState s s)
-> m (Step (IntersperseQState s s) c)
forall {s}. a -> s -> s -> (s -> s -> s) -> m (Step s c)
process a
a s
sL s
sR s -> s -> IntersperseQState s s
forall fs ps. fs -> ps -> IntersperseQState fs ps
IntersperseQUnquoted
        | Bool
otherwise = a
-> s
-> s
-> (s -> s -> IntersperseQState s s)
-> m (Step (IntersperseQState s s) c)
forall {s} {b}. a -> s -> s -> (s -> s -> s) -> m (Step s b)
processQuoted a
a s
sL s
sR s -> s -> IntersperseQState s s
forall fs ps. fs -> ps -> IntersperseQState fs ps
IntersperseQQuoted

    step (IntersperseQQuotedEsc s
sR s
sL) a
a =
        a
-> s
-> s
-> (s -> s -> IntersperseQState s s)
-> m (Step (IntersperseQState s s) c)
forall {s} {b}. a -> s -> s -> (s -> s -> s) -> m (Step s b)
processQuoted a
a s
sL s
sR s -> s -> IntersperseQState s s
forall fs ps. fs -> ps -> IntersperseQState fs ps
IntersperseQQuoted

    extract :: IntersperseQState s ps -> m c
extract (IntersperseQUnquoted s
sR ps
_) = s -> m c
extractR s
sR
    extract (IntersperseQQuoted s
_ ps
_) =
        [Char] -> m c
forall a. HasCallStack => [Char] -> a
error [Char]
"intersperseWithQuotes: finished inside quote"
    extract (IntersperseQQuotedEsc s
_ ps
_) =
        [Char] -> m c
forall a. HasCallStack => [Char] -> a
error [Char]
"intersperseWithQuotes: finished inside quote, at escape char"

    final :: IntersperseQState s s -> m c
final (IntersperseQUnquoted s
sR s
sL) = s -> m b
finalL s
sL m b -> m c -> m c
forall a b. m a -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> s -> m c
finalR s
sR
    final (IntersperseQQuoted s
sR s
sL) = do
        c
_ <- s -> m c
finalR s
sR
        b
_ <- s -> m b
finalL s
sL
        [Char] -> m c
forall a. HasCallStack => [Char] -> a
error [Char]
"intersperseWithQuotes: finished inside quote"
    final (IntersperseQQuotedEsc s
sR s
sL) = do
        c
_ <- s -> m c
finalR s
sR
        b
_ <- s -> m b
finalL s
sL
        [Char] -> m c
forall a. HasCallStack => [Char] -> a
error [Char]
"intersperseWithQuotes: finished inside quote, at escape char"