{-# LANGUAGE CPP #-}
-- |
-- Module      : Streamly.Internal.Data.Stream.Nesting
-- Copyright   : (c) 2018 Composewell Technologies
--               (c) Roman Leshchinskiy 2008-2010
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC
--
-- This module contains transformations involving multiple streams, unfolds or
-- folds. There are two types of transformations generational or eliminational.
-- Generational transformations are like the "Generate" module but they
-- generate a stream by combining streams instead of elements. Eliminational
-- transformations are like the "Eliminate" module but they transform a stream
-- by eliminating parts of the stream instead of eliminating the whole stream.
--
-- These combinators involve transformation, generation, elimination so can be
-- classified under any of those.

-- The zipWithM combinator in this module has been adapted from the vector
-- package (c) Roman Leshchinskiy.
--
-- Flipped versions can be named as:
-- mapFor/forEach, concatFor, unfoldStepFor (only step function)
-- foreach would be better for streams than mapFor as map could be used for any
-- type not just containers with multiple elements.
--
-- Flipped versions for folding streams:
-- groupsFor :: stream -> fold -> stream (flipped groupsWhile)
--
-- Flipped versions for folds:
-- foldMany :: outer fold -> inner fold -> fold (original version)
-- groupFoldFor :: inner fold -> outer fold -> fold (flipped version)
-- groupStepFor :: inner fold -> outer fold step -> fold (flipped version)
-- This can be convenient for defining the outer fold step using a lambda.
--
module Streamly.Internal.Data.Stream.Nesting
    (
    -- * Generate
    -- | Combining streams to generate streams.

    -- ** Combine Two Streams
    -- | Functions ending in the shape:
    --
    -- @Stream m a -> Stream m a -> Stream m a@.

    -- *** Interleaving
    -- | Interleave elements from two streams alternately. A special case of
    -- unfoldEachInterleave. Interleave is equivalent to mergeBy with a round
    -- robin merge function.
      InterleaveState(..)
    , interleave
    , interleaveEndBy'
    , interleaveSepBy'
    , interleaveBeginBy
    , interleaveEndBy
    , interleaveSepBy

    -- *** Co-operative Scheduling
    -- | Execute streams alternately irrespective of whether they generate
    -- elements or not. Note that scheduling is affected by the Skip
    -- constructor; implementations with more skips receive proportionally less
    -- scheduling time. A more programmer controlled approach would be to emit
    -- a Maybe in a stream and use the output driven scheduling combinators
    -- instead of Skip driven, even if a stream emits Nothing, the output will
    -- force scheduling of another stream.
    --
    , roundRobin -- interleaveFair?/ParallelFair

    -- *** Merging
    -- | Interleave elements from two streams based on a condition.
    , mergeBy
    , mergeByM
    , mergeMinBy
    , mergeFstBy

    -- ** Combine N Streams
    -- | Functions generally ending in these shapes:
    --
    -- @
    -- concat: f (Stream m a) -> Stream m a
    -- concatMap: (a -> Stream m b) -> Stream m a -> Stream m b
    -- unfoldEach: Unfold m a b -> Stream m a -> Stream m b
    -- @

    -- *** unfoldEach
    -- | Generate streams by using an unfold on each element of an input
    -- stream, append the resulting streams and flatten. A special case of
    -- intercalate.
    , unfoldEachFoldBy
    , ConcatUnfoldInterleaveState (..)
    , bfsUnfoldEach
    , altBfsUnfoldEach
    , fairUnfoldEach

    -- *** unfoldEach joined by elements
    -- | Like unfoldEach but intersperses an element between the streams after
    -- unfolding. A special case of intercalate.
    , unfoldEachSepBy
    , unfoldEachSepByM
    , unfoldEachEndBy
    , unfoldEachEndByM

    -- *** unfoldEach joined by sequences
    -- | Like unfoldEach but intersperses a sequence between the unfolded
    -- streams before unfolding. A special case of intercalate.
    , unfoldEachSepBySeq
    , unfoldEachEndBySeq

    -- *** unfoldEach joined by streams
    -- | Like unfoldEach but intersperses streams between the unfolded streams.
    , intercalateSepBy
    , intercalateEndBy

    -- *** concatMap
    , fairConcatMapM
    , fairConcatMap
    , fairConcatForM
    , fairConcatFor

    -- *** unfoldSched
    -- Note appending does not make sense for sched, only bfs or diagonal.

    -- | Like unfoldEach but schedules the generated streams based on time
    -- slice instead of based on the outputs.
    , unfoldSched
    -- , altUnfoldSched -- alternating directions
    , fairUnfoldSched

    -- *** schedMap
    , schedMapM
    , schedMap
    , fairSchedMapM
    , fairSchedMap

    -- *** schedFor
    , schedForM
    , schedFor
    , fairSchedForM
    , fairSchedFor

    -- * Eliminate
    -- | Folding and Parsing chunks of streams to eliminate nested streams.
    -- Functions generally ending in these shapes:
    --
    -- @
    -- f (Fold m a b) -> t m a -> t m b
    -- f (Parser a m b) -> t m a -> t m b
    -- @

    -- ** Folding
    -- | Apply folds on a stream.
    , foldSequence
    , foldIterateM

    -- ** Parsing
    -- | Parsing is opposite to flattening. 'parseMany' is dual to concatMap or
    -- unfoldEach concatMap generates a stream from single values in a
    -- stream and flattens, parseMany does the opposite of flattening by
    -- splitting the stream and then folds each such split to single value in
    -- the output stream.
    , parseMany
    , parseManyPos
    , parseSequence
    , parseManyTill
    , parseIterate
    , parseIteratePos

    -- ** Grouping
    -- | Group segments of a stream and fold. Special case of parsing.
    , groupsWhile
    , groupsRollingBy

    -- ** Splitting
    -- | A special case of parsing.
    , takeEndBySeq
    , takeEndBySeq_
    , wordsBy
    , splitSepBySeq_
    , splitEndBySeq
    , splitEndBySeq_
    , splitOnSuffixSeq -- internal

    , splitBeginBy_
    , splitEndBySeqOneOf
    , splitSepBySeqOneOf

    -- * Transform (Nested Containers)
    -- | Opposite to compact in ArrayStream
    , splitInnerBy -- XXX innerSplitOn
    , splitInnerBySuffix -- XXX innerSplitOnSuffix

    -- * Reduce By Streams
    , dropPrefix
    , dropInfix
    , dropSuffix

    -- * Deprecated
    , interpose
    , interposeM
    , interposeSuffix
    , interposeSuffixM
    , gintercalate
    , gintercalateSuffix
    , intercalate
    , intercalateSuffix
    , unfoldInterleave
    , unfoldRoundRobin
    , interleaveMin
    , interleaveFst
    , interleaveFstSuffix
    , parseManyD
    , parseIterateD
    , groupsBy
    , splitOnSeq
    )
where

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

import Control.Exception (assert)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Bits (shiftR, shiftL, (.|.), (.&.))
import Data.Proxy (Proxy(..))
import Data.Word (Word32)
import Fusion.Plugin.Types (Fuse(..))
import GHC.Types (SPEC(..))

import Streamly.Internal.Data.Array.Type (Array(..))
import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.MutArray.Type (MutArray(..))
import Streamly.Internal.Data.Parser (ParseError(..), ParseErrorPos)
import Streamly.Internal.Data.RingArray (RingArray(..))
import Streamly.Internal.Data.SVar.Type (adaptState)
import Streamly.Internal.Data.Unbox (Unbox(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))

import qualified Streamly.Internal.Data.Array.Type as A
import qualified Streamly.Internal.Data.MutArray.Type as MutArray
import qualified Streamly.Internal.Data.Fold as FL
import qualified Streamly.Internal.Data.Parser as PR
import qualified Streamly.Internal.Data.Parser as PRD
import qualified Streamly.Internal.Data.ParserDrivers as Drivers
import qualified Streamly.Internal.Data.RingArray as RB
import qualified Streamly.Internal.Data.Stream.Generate as Stream
import qualified Streamly.Internal.Data.Unfold.Type as Unfold

import Streamly.Internal.Data.Stream.Transform
    (intersperse, intersperseEndByM)
import Streamly.Internal.Data.Stream.Type hiding (splitAt)

import Prelude hiding (concatMap, mapM, zipWith, splitAt)

#include "DocTestDataStream.hs"

------------------------------------------------------------------------------
-- Interleaving
------------------------------------------------------------------------------

data InterleaveState s1 s2 = InterleaveFirst s1 s2 | InterleaveSecond s1 s2
    | InterleaveSecondOnly s2 | InterleaveFirstOnly s1

-- XXX Ideally we should change the order of the arguments but we have the same
-- convention in append as well, we will have to change that too. Also, the
-- argument order of append makes sense for infix use.

-- | WARNING! O(n^2) time complexity wrt number of streams. Suitable for
-- statically fusing a small number of streams. Use the O(n) complexity
-- StreamK.'Streamly.Data.StreamK.interleave' otherwise.
--
-- Interleaves two streams, yielding one element from each stream alternately,
-- starting from the first stream. When one stream is exhausted, all the
-- remaining elements of the other stream are emitted in the output stream.
--
-- Both the streams are completely exhausted.
--
-- @
-- (a b c) (. . .) => a . b . c .
-- (a b c) (. .  ) => a . b . c
-- (a b  ) (. . .) => a . b .  .
-- @
--
-- Examples:
--
-- >>> f x y = Stream.toList $ Stream.interleave (Stream.fromList x) (Stream.fromList y)
-- >>> f "abc" "..."
-- "a.b.c."
-- >>> f "abc" ".."
-- "a.b.c"
-- >>> f "ab" "..."
-- "a.b.."
--
{-# INLINE_NORMAL interleave #-}
interleave :: Monad m => Stream m a -> Stream m a -> Stream m a
interleave :: forall (m :: * -> *) a.
Monad m =>
Stream m a -> Stream m a -> Stream m a
interleave (Stream State StreamK m a -> s -> m (Step s a)
step1 s
state1) (Stream State StreamK m a -> s -> m (Step s a)
step2 s
state2) =
    (State StreamK m a
 -> InterleaveState s s -> m (Step (InterleaveState s s) a))
-> InterleaveState s s -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
state1 s
state2)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step State StreamK m a
gst (InterleaveFirst s
st1 s
st2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 State StreamK m a
gst s
st1
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a))
-> Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveSecond s
s s
st2)
            Skip s
s -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
s s
st2)
            Step s a
Stop -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> InterleaveState s s
forall s1 s2. s2 -> InterleaveState s1 s2
InterleaveSecondOnly s
st2)

    step State StreamK m a
gst (InterleaveSecond s
st1 s
st2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step2 State StreamK m a
gst s
st2
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a))
-> Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
st1 s
s)
            Skip s
s -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveSecond s
st1 s
s)
            Step s a
Stop -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> InterleaveState s s
forall s1 s2. s1 -> InterleaveState s1 s2
InterleaveFirstOnly s
st1)

    step State StreamK m a
gst (InterleaveFirstOnly s
st1) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 State StreamK m a
gst s
st1
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a))
-> Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> InterleaveState s s
forall s1 s2. s1 -> InterleaveState s1 s2
InterleaveFirstOnly s
s)
            Skip s
s -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> InterleaveState s s
forall s1 s2. s1 -> InterleaveState s1 s2
InterleaveFirstOnly s
s)
            Step s a
Stop -> Step (InterleaveState s s) a
forall s a. Step s a
Stop

    step State StreamK m a
gst (InterleaveSecondOnly s
st2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step2 State StreamK m a
gst s
st2
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a))
-> Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> InterleaveState s s
forall s1 s2. s2 -> InterleaveState s1 s2
InterleaveSecondOnly s
s)
            Skip s
s -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> InterleaveState s s
forall s1 s2. s2 -> InterleaveState s1 s2
InterleaveSecondOnly s
s)
            Step s a
Stop -> Step (InterleaveState s s) a
forall s a. Step s a
Stop

-- XXX Check the performance of the implementation, we can write a custom one.

{-# ANN module "HLint: ignore Use zip" #-}

-- | Interleave the two streams such that the elements of the second stream are
-- ended by the elements of the first stream. If one of the streams is
-- exhausted then interleaving stops.
--
-- @
-- (. . .) (a b c) => a . b . c .
-- (. .  ) (a b c) => a . b .      -- c is discarded
-- (. . .) (a b  ) => a . b .      -- . is discarded
-- @
--
-- Examples:
--
-- >>> f x y = Stream.toList $ Stream.interleaveEndBy' (Stream.fromList x) (Stream.fromList y)
-- >>> f "..." "abc"
-- "a.b.c."
-- >>> f ".." "abc"
-- "a.b."
-- >>> f "..." "ab"
-- "a.b."
--
-- Definition:
--
-- >>> interleaveEndBy' s1 s2 = Stream.unfoldEach Unfold.fromTuple $ Stream.zipWith (,) s2 s1
--
-- Similarly, we can defined interleaveBeginBy' as:
--
-- >>> interleaveBeginBy' = flip interleaveEndBy'
--
{-# INLINE_NORMAL interleaveEndBy' #-}
interleaveEndBy' :: Monad m => Stream m a -> Stream m a -> Stream m a
interleaveEndBy' :: forall (m :: * -> *) a.
Monad m =>
Stream m a -> Stream m a -> Stream m a
interleaveEndBy' Stream m a
s1 Stream m a
s2 = Unfold m (a, a) a -> Stream m (a, a) -> Stream m a
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
unfoldEach Unfold m (a, a) a
forall (m :: * -> *) a. Applicative m => Unfold m (a, a) a
Unfold.fromTuple (Stream m (a, a) -> Stream m a) -> Stream m (a, a) -> Stream m a
forall a b. (a -> b) -> a -> b
$ (a -> a -> (a, a)) -> Stream m a -> Stream m a -> Stream m (a, a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
zipWith (,) Stream m a
s2 Stream m a
s1

-- | Like `interleave` but stops interleaving as soon as any of the two streams
-- stops. The suffix 'Min' in the name determines the stop behavior.
--
-- This is the same as interleaveEndBy' but it might emit an additional element
-- at the end.
--
{-# DEPRECATED interleaveMin "Please use flip interleaveEndBy' instead." #-}
{-# INLINE_NORMAL interleaveMin #-}
interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a
interleaveMin :: forall (m :: * -> *) a.
Monad m =>
Stream m a -> Stream m a -> Stream m a
interleaveMin (Stream State StreamK m a -> s -> m (Step s a)
step1 s
state1) (Stream State StreamK m a -> s -> m (Step s a)
step2 s
state2) =
    (State StreamK m a
 -> InterleaveState s s -> m (Step (InterleaveState s s) a))
-> InterleaveState s s -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
state1 s
state2)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step State StreamK m a
gst (InterleaveFirst s
st1 s
st2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 State StreamK m a
gst s
st1
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a))
-> Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveSecond s
s s
st2)
            Skip s
s -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
s s
st2)
            Step s a
Stop -> Step (InterleaveState s s) a
forall s a. Step s a
Stop

    step State StreamK m a
gst (InterleaveSecond s
st1 s
st2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step2 State StreamK m a
gst s
st2
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a))
-> Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
st1 s
s)
            Skip s
s -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveSecond s
st1 s
s)
            Step s a
Stop -> Step (InterleaveState s s) a
forall s a. Step s a
Stop

    step State StreamK m a
_ (InterleaveFirstOnly s
_) =  m (Step (InterleaveState s s) a)
forall a. HasCallStack => a
undefined
    step State StreamK m a
_ (InterleaveSecondOnly s
_) =  m (Step (InterleaveState s s) a)
forall a. HasCallStack => a
undefined

-- | Interleave the two streams such that the elements of the first stream are
-- infixed between the elements of the second stream. If one of the streams is
-- exhausted then interleaving stops.
--
-- @
-- (. . .) (a b c) => a . b . c    -- additional . is discarded
-- (. .  ) (a b c) => a . b . c
-- (.    ) (a b c) => a . b        -- c is discarded
-- @
--
-- >>> f x y = Stream.toList $ Stream.interleaveSepBy' (Stream.fromList x) (Stream.fromList y)
-- >>> f "..." "abc"
-- "a.b.c"
-- >>> f ".." "abc"
-- "a.b.c"
-- >>> f "." "abc"
-- "a.b"
--
{-# INLINE_NORMAL interleaveSepBy' #-}
interleaveSepBy' :: Monad m => Stream m a -> Stream m a -> Stream m a
-- XXX Not an efficient implementation, need to write a fused one.
interleaveSepBy' :: forall (m :: * -> *) a.
Monad m =>
Stream m a -> Stream m a -> Stream m a
interleaveSepBy' Stream m a
s1 Stream m a
s2 = m (Stream m a) -> Stream m a
forall (m :: * -> *) a. Monad m => m (Stream m a) -> Stream m a
concatEffect (m (Stream m a) -> Stream m a) -> m (Stream m a) -> Stream m a
forall a b. (a -> b) -> a -> b
$ do
    Maybe (a, Stream m a)
r <- Stream m a -> m (Maybe (a, Stream m a))
forall (m :: * -> *) a.
Monad m =>
Stream m a -> m (Maybe (a, Stream m a))
uncons Stream m a
s2
    case Maybe (a, Stream m a)
r of
        Maybe (a, Stream m a)
Nothing -> Stream m a -> m (Stream m a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Stream m a
forall (m :: * -> *) a. Applicative m => Stream m a
Stream.nil
        Just (a
h, Stream m a
t) ->
            Stream m a -> m (Stream m a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream m a -> m (Stream m a)) -> Stream m a -> m (Stream m a)
forall a b. (a -> b) -> a -> b
$ a
h a -> Stream m a -> Stream m a
forall (m :: * -> *) a.
Applicative m =>
a -> Stream m a -> Stream m a
`Stream.cons`
                Unfold m (a, a) a -> Stream m (a, a) -> Stream m a
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
unfoldEach Unfold m (a, a) a
forall (m :: * -> *) a. Applicative m => Unfold m (a, a) a
Unfold.fromTuple ((a -> a -> (a, a)) -> Stream m a -> Stream m a -> Stream m (a, a)
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
zipWith (,) Stream m a
s1 Stream m a
t)

-- | Interleave the two streams such that the elements of the second stream are
-- prefixed by the elements of the first stream. Interleaving stops when and
-- only when the second stream is exhausted. Shortfall of the prefix stream is
-- ignored and excess is discarded.
--
-- @
-- (. . .) (a b c) => . a . b . c
-- (. . .) (a b  ) => . a . b      -- additional . is discarded
-- (. .  ) (a b c) => . a . b c    -- missing . is ignored
-- @
--
-- /Unimplemented/
--
{-# INLINE_NORMAL interleaveBeginBy #-}
interleaveBeginBy :: -- Monad m =>
    Stream m a -> Stream m a -> Stream m a
interleaveBeginBy :: forall (m :: * -> *) a. Stream m a -> Stream m a -> Stream m a
interleaveBeginBy = Stream m a -> Stream m a -> Stream m a
forall a. HasCallStack => a
undefined

-- | Like 'interleaveEndBy'' but interleaving stops when and only when the
-- second stream is exhausted. Shortfall of the suffix stream is ignored and
-- excess is discarded.
--
-- @
-- (. . .) (a b c) => a . b . c .
-- (. .  ) (a b c) => a . b . c    -- missing . is ignored
-- (. . .) (a b  ) => a . b .      -- additional . is discarded
-- @
--
-- >>> f x y = Stream.toList $ Stream.interleaveEndBy (Stream.fromList x) (Stream.fromList y)
-- >>> f "..." "abc"
-- "a.b.c."
-- >>> f ".." "abc"
-- "a.b.c"
-- >>> f "..." "ab"
-- "a.b."
--
{-# INLINE_NORMAL interleaveEndBy #-}
interleaveEndBy :: Monad m => Stream m a -> Stream m a -> Stream m a
interleaveEndBy :: forall (m :: * -> *) a.
Monad m =>
Stream m a -> Stream m a -> Stream m a
interleaveEndBy (Stream State StreamK m a -> s -> m (Step s a)
step2 s
state2) (Stream State StreamK m a -> s -> m (Step s a)
step1 s
state1) =
    (State StreamK m a
 -> InterleaveState s s -> m (Step (InterleaveState s s) a))
-> InterleaveState s s -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
state1 s
state2)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step State StreamK m a
gst (InterleaveFirst s
st1 s
st2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 State StreamK m a
gst s
st1
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a))
-> Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveSecond s
s s
st2)
            Skip s
s -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
s s
st2)
            Step s a
Stop -> Step (InterleaveState s s) a
forall s a. Step s a
Stop

    step State StreamK m a
gst (InterleaveSecond s
st1 s
st2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step2 State StreamK m a
gst s
st2
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a))
-> Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
st1 s
s)
            Skip s
s -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveSecond s
st1 s
s)
            Step s a
Stop -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> InterleaveState s s
forall s1 s2. s1 -> InterleaveState s1 s2
InterleaveFirstOnly s
st1)

    step State StreamK m a
gst (InterleaveFirstOnly s
st1) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 State StreamK m a
gst s
st1
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a))
-> Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> InterleaveState s s
forall s1 s2. s1 -> InterleaveState s1 s2
InterleaveFirstOnly s
s)
            Skip s
s -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> InterleaveState s s
forall s1 s2. s1 -> InterleaveState s1 s2
InterleaveFirstOnly s
s)
            Step s a
Stop -> Step (InterleaveState s s) a
forall s a. Step s a
Stop

    step State StreamK m a
_ (InterleaveSecondOnly s
_) =  m (Step (InterleaveState s s) a)
forall a. HasCallStack => a
undefined

{-# INLINE interleaveFstSuffix #-}
{-# DEPRECATED interleaveFstSuffix "Please use flip interleaveEndBy instead." #-}
interleaveFstSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a
interleaveFstSuffix :: forall (m :: * -> *) a.
Monad m =>
Stream m a -> Stream m a -> Stream m a
interleaveFstSuffix = (Stream m a -> Stream m a -> Stream m a)
-> Stream m a -> Stream m a -> Stream m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Stream m a -> Stream m a -> Stream m a
forall (m :: * -> *) a.
Monad m =>
Stream m a -> Stream m a -> Stream m a
interleaveEndBy

data InterleaveInfixState s1 s2 a
    = InterleaveInfixFirst s1 s2
    | InterleaveInfixSecondBuf s1 s2
    | InterleaveInfixSecondYield s1 s2 a
    | InterleaveInfixFirstYield s1 s2 a
    | InterleaveInfixFirstOnly s1

-- | Like 'interleaveSepBy'' but interleaving stops when and only when the
-- second stream is exhausted. Shortfall of the infix stream is ignored and
-- excess is discarded.
--
-- @
-- (. . .) (a b c) => a . b . c    -- additional . is discarded
-- (. .  ) (a b c) => a . b . c
-- (.    ) (a b c) => a . b c      -- missing . is ignored
-- @
--
-- Examples:
--
-- >>> f x y = Stream.toList $ Stream.interleaveSepBy (Stream.fromList x) (Stream.fromList y)
-- >>> f "..." "abc"
-- "a.b.c"
-- >>> f ".." "abc"
-- "a.b.c"
-- >>> f "." "abc"
-- "a.bc"
--
{-# INLINE_NORMAL interleaveSepBy #-}
interleaveSepBy :: Monad m => Stream m a -> Stream m a -> Stream m a
interleaveSepBy :: forall (m :: * -> *) a.
Monad m =>
Stream m a -> Stream m a -> Stream m a
interleaveSepBy (Stream State StreamK m a -> s -> m (Step s a)
step2 s
state2) (Stream State StreamK m a -> s -> m (Step s a)
step1 s
state1) =
    (State StreamK m a
 -> InterleaveInfixState s s a
 -> m (Step (InterleaveInfixState s s a) a))
-> InterleaveInfixState s s a -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m a
-> InterleaveInfixState s s a
-> m (Step (InterleaveInfixState s s a) a)
step (s -> s -> InterleaveInfixState s s a
forall s1 s2 a. s1 -> s2 -> InterleaveInfixState s1 s2 a
InterleaveInfixFirst s
state1 s
state2)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> InterleaveInfixState s s a
-> m (Step (InterleaveInfixState s s a) a)
step State StreamK m a
gst (InterleaveInfixFirst s
st1 s
st2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 State StreamK m a
gst s
st1
        Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveInfixState s s a) a
 -> m (Step (InterleaveInfixState s s a) a))
-> Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a
-> InterleaveInfixState s s a
-> Step (InterleaveInfixState s s a) a
forall s a. a -> s -> Step s a
Yield a
a (s -> s -> InterleaveInfixState s s a
forall s1 s2 a. s1 -> s2 -> InterleaveInfixState s1 s2 a
InterleaveInfixSecondBuf s
s s
st2)
            Skip s
s -> InterleaveInfixState s s a -> Step (InterleaveInfixState s s a) a
forall s a. s -> Step s a
Skip (s -> s -> InterleaveInfixState s s a
forall s1 s2 a. s1 -> s2 -> InterleaveInfixState s1 s2 a
InterleaveInfixFirst s
s s
st2)
            Step s a
Stop -> Step (InterleaveInfixState s s a) a
forall s a. Step s a
Stop

    step State StreamK m a
gst (InterleaveInfixSecondBuf s
st1 s
st2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step2 State StreamK m a
gst s
st2
        Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveInfixState s s a) a
 -> m (Step (InterleaveInfixState s s a) a))
-> Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> InterleaveInfixState s s a -> Step (InterleaveInfixState s s a) a
forall s a. s -> Step s a
Skip (s -> s -> a -> InterleaveInfixState s s a
forall s1 s2 a. s1 -> s2 -> a -> InterleaveInfixState s1 s2 a
InterleaveInfixSecondYield s
st1 s
s a
a)
            Skip s
s -> InterleaveInfixState s s a -> Step (InterleaveInfixState s s a) a
forall s a. s -> Step s a
Skip (s -> s -> InterleaveInfixState s s a
forall s1 s2 a. s1 -> s2 -> InterleaveInfixState s1 s2 a
InterleaveInfixSecondBuf s
st1 s
s)
            Step s a
Stop -> InterleaveInfixState s s a -> Step (InterleaveInfixState s s a) a
forall s a. s -> Step s a
Skip (s -> InterleaveInfixState s s a
forall s1 s2 a. s1 -> InterleaveInfixState s1 s2 a
InterleaveInfixFirstOnly s
st1)

    step State StreamK m a
gst (InterleaveInfixSecondYield s
st1 s
st2 a
x) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 State StreamK m a
gst s
st1
        Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveInfixState s s a) a
 -> m (Step (InterleaveInfixState s s a) a))
-> Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a
-> InterleaveInfixState s s a
-> Step (InterleaveInfixState s s a) a
forall s a. a -> s -> Step s a
Yield a
x (s -> s -> a -> InterleaveInfixState s s a
forall s1 s2 a. s1 -> s2 -> a -> InterleaveInfixState s1 s2 a
InterleaveInfixFirstYield s
s s
st2 a
a)
            Skip s
s -> InterleaveInfixState s s a -> Step (InterleaveInfixState s s a) a
forall s a. s -> Step s a
Skip (s -> s -> a -> InterleaveInfixState s s a
forall s1 s2 a. s1 -> s2 -> a -> InterleaveInfixState s1 s2 a
InterleaveInfixSecondYield s
s s
st2 a
x)
            Step s a
Stop -> Step (InterleaveInfixState s s a) a
forall s a. Step s a
Stop

    step State StreamK m a
_ (InterleaveInfixFirstYield s
st1 s
st2 a
x) = do
        Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveInfixState s s a) a
 -> m (Step (InterleaveInfixState s s a) a))
-> Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) a)
forall a b. (a -> b) -> a -> b
$ a
-> InterleaveInfixState s s a
-> Step (InterleaveInfixState s s a) a
forall s a. a -> s -> Step s a
Yield a
x (s -> s -> InterleaveInfixState s s a
forall s1 s2 a. s1 -> s2 -> InterleaveInfixState s1 s2 a
InterleaveInfixSecondBuf s
st1 s
st2)

    step State StreamK m a
gst (InterleaveInfixFirstOnly s
st1) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 State StreamK m a
gst s
st1
        Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveInfixState s s a) a
 -> m (Step (InterleaveInfixState s s a) a))
-> Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a
-> InterleaveInfixState s s a
-> Step (InterleaveInfixState s s a) a
forall s a. a -> s -> Step s a
Yield a
a (s -> InterleaveInfixState s s a
forall s1 s2 a. s1 -> InterleaveInfixState s1 s2 a
InterleaveInfixFirstOnly s
s)
            Skip s
s -> InterleaveInfixState s s a -> Step (InterleaveInfixState s s a) a
forall s a. s -> Step s a
Skip (s -> InterleaveInfixState s s a
forall s1 s2 a. s1 -> InterleaveInfixState s1 s2 a
InterleaveInfixFirstOnly s
s)
            Step s a
Stop -> Step (InterleaveInfixState s s a) a
forall s a. Step s a
Stop

{-# DEPRECATED interleaveFst "Please use flip interleaveSepBy instead." #-}
{-# INLINE_NORMAL interleaveFst #-}
interleaveFst :: Monad m => Stream m a -> Stream m a -> Stream m a
interleaveFst :: forall (m :: * -> *) a.
Monad m =>
Stream m a -> Stream m a -> Stream m a
interleaveFst = (Stream m a -> Stream m a -> Stream m a)
-> Stream m a -> Stream m a -> Stream m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Stream m a -> Stream m a -> Stream m a
forall (m :: * -> *) a.
Monad m =>
Stream m a -> Stream m a -> Stream m a
interleaveSepBy

------------------------------------------------------------------------------
-- Scheduling
------------------------------------------------------------------------------

-- | Schedule the execution of two streams in a fair round-robin manner,
-- executing each stream once, alternately. Execution of a stream may not
-- necessarily result in an output, a stream may choose to @Skip@ producing an
-- element until later giving the other stream a chance to run. Therefore, this
-- combinator fairly interleaves the execution of two streams rather than
-- fairly interleaving the output of the two streams. This can be useful in
-- co-operative multitasking without using explicit threads. This can be used
-- as an alternative to `async`.
--
-- Scheduling is affected by the Skip constructor; implementations with more
-- skips receive proportionally less scheduling time.
--
-- /Pre-release/
{-# INLINE_NORMAL roundRobin #-}
roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a
roundRobin :: forall (m :: * -> *) a.
Monad m =>
Stream m a -> Stream m a -> Stream m a
roundRobin (Stream State StreamK m a -> s -> m (Step s a)
step1 s
state1) (Stream State StreamK m a -> s -> m (Step s a)
step2 s
state2) =
    (State StreamK m a
 -> InterleaveState s s -> m (Step (InterleaveState s s) a))
-> InterleaveState s s -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
state1 s
state2)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step State StreamK m a
gst (InterleaveFirst s
st1 s
st2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 State StreamK m a
gst s
st1
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a))
-> Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveSecond s
s s
st2)
            Skip s
s -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveSecond s
s s
st2)
            Step s a
Stop -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> InterleaveState s s
forall s1 s2. s2 -> InterleaveState s1 s2
InterleaveSecondOnly s
st2)

    step State StreamK m a
gst (InterleaveSecond s
st1 s
st2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step2 State StreamK m a
gst s
st2
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a))
-> Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
st1 s
s)
            Skip s
s -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
st1 s
s)
            Step s a
Stop -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> InterleaveState s s
forall s1 s2. s1 -> InterleaveState s1 s2
InterleaveFirstOnly s
st1)

    step State StreamK m a
gst (InterleaveSecondOnly s
st2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step2 State StreamK m a
gst s
st2
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a))
-> Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> InterleaveState s s
forall s1 s2. s2 -> InterleaveState s1 s2
InterleaveSecondOnly s
s)
            Skip s
s -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> InterleaveState s s
forall s1 s2. s2 -> InterleaveState s1 s2
InterleaveSecondOnly s
s)
            Step s a
Stop -> Step (InterleaveState s s) a
forall s a. Step s a
Stop

    step State StreamK m a
gst (InterleaveFirstOnly s
st1) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 State StreamK m a
gst s
st1
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a))
-> Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> InterleaveState s s
forall s1 s2. s1 -> InterleaveState s1 s2
InterleaveFirstOnly s
s)
            Skip s
s -> InterleaveState s s -> Step (InterleaveState s s) a
forall s a. s -> Step s a
Skip (s -> InterleaveState s s
forall s1 s2. s1 -> InterleaveState s1 s2
InterleaveFirstOnly s
s)
            Step s a
Stop -> Step (InterleaveState s s) a
forall s a. Step s a
Stop

------------------------------------------------------------------------------
-- Merging
------------------------------------------------------------------------------

-- | Like 'mergeBy' but with a monadic comparison function.
--
-- Example, to merge two streams randomly:
--
-- @
-- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT
-- > Stream.toList $ Stream.mergeByM randomly (Stream.fromList [1,1,1,1]) (Stream.fromList [2,2,2,2])
-- [2,1,2,2,2,1,1,1]
-- @
--
-- Example, merge two streams in a proportion of 2:1:
--
-- >>> :set -fno-warn-unrecognised-warning-flags
-- >>> :set -fno-warn-x-partial
-- >>> :{
-- do
--  let s1 = Stream.fromList [1,1,1,1,1,1]
--      s2 = Stream.fromList [2,2,2]
--  let proportionately m n = do
--       ref <- newIORef $ cycle $ Prelude.concat [Prelude.replicate m LT, Prelude.replicate n GT]
--       return $ \_ _ -> do
--          r <- readIORef ref
--          writeIORef ref $ Prelude.tail r
--          return $ Prelude.head r
--  f <- proportionately 2 1
--  xs <- Stream.fold Fold.toList $ Stream.mergeByM f s1 s2
--  print xs
-- :}
-- [1,1,2,1,1,2,1,1,2]
--
{-# INLINE_NORMAL mergeByM #-}
mergeByM
    :: (Monad m)
    => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
mergeByM :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
mergeByM a -> a -> m Ordering
cmp (Stream State StreamK m a -> s -> m (Step s a)
stepa s
ta) (Stream State StreamK m a -> s -> m (Step s a)
stepb s
tb) =
    (State StreamK m a
 -> (Maybe s, Maybe s, Maybe a, Maybe a)
 -> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a))
-> (Maybe s, Maybe s, Maybe a, Maybe a) -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m a
-> (Maybe s, Maybe s, Maybe a, Maybe a)
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
step (s -> Maybe s
forall a. a -> Maybe a
Just s
ta, s -> Maybe s
forall a. a -> Maybe a
Just s
tb, Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
  where
    {-# INLINE_LATE step #-}

    -- one of the values is missing, and the corresponding stream is running
    step :: State StreamK m a
-> (Maybe s, Maybe s, Maybe a, Maybe a)
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
step State StreamK m a
gst (Just s
sa, Maybe s
sb, Maybe a
Nothing, Maybe a
b) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
stepa State StreamK m a
gst s
sa
        Step (Maybe s, Maybe s, Maybe a, Maybe a) a
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe s, Maybe s, Maybe a, Maybe a) a
 -> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a))
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
sa' -> (Maybe s, Maybe s, Maybe a, Maybe a)
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
forall s a. s -> Step s a
Skip (s -> Maybe s
forall a. a -> Maybe a
Just s
sa', Maybe s
sb, a -> Maybe a
forall a. a -> Maybe a
Just a
a, Maybe a
b)
            Skip s
sa'    -> (Maybe s, Maybe s, Maybe a, Maybe a)
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
forall s a. s -> Step s a
Skip (s -> Maybe s
forall a. a -> Maybe a
Just s
sa', Maybe s
sb, Maybe a
forall a. Maybe a
Nothing, Maybe a
b)
            Step s a
Stop        -> (Maybe s, Maybe s, Maybe a, Maybe a)
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
forall s a. s -> Step s a
Skip (Maybe s
forall a. Maybe a
Nothing, Maybe s
sb, Maybe a
forall a. Maybe a
Nothing, Maybe a
b)

    step State StreamK m a
gst (Maybe s
sa, Just s
sb, Maybe a
a, Maybe a
Nothing) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
stepb State StreamK m a
gst s
sb
        Step (Maybe s, Maybe s, Maybe a, Maybe a) a
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe s, Maybe s, Maybe a, Maybe a) a
 -> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a))
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
b s
sb' -> (Maybe s, Maybe s, Maybe a, Maybe a)
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
forall s a. s -> Step s a
Skip (Maybe s
sa, s -> Maybe s
forall a. a -> Maybe a
Just s
sb', Maybe a
a, a -> Maybe a
forall a. a -> Maybe a
Just a
b)
            Skip s
sb'    -> (Maybe s, Maybe s, Maybe a, Maybe a)
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
forall s a. s -> Step s a
Skip (Maybe s
sa, s -> Maybe s
forall a. a -> Maybe a
Just s
sb', Maybe a
a, Maybe a
forall a. Maybe a
Nothing)
            Step s a
Stop        -> (Maybe s, Maybe s, Maybe a, Maybe a)
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
forall s a. s -> Step s a
Skip (Maybe s
sa, Maybe s
forall a. Maybe a
Nothing, Maybe a
a, Maybe a
forall a. Maybe a
Nothing)

    -- both the values are available
    step State StreamK m a
_ (Maybe s
sa, Maybe s
sb, Just a
a, Just a
b) = do
        Ordering
res <- a -> a -> m Ordering
cmp a
a a
b
        Step (Maybe s, Maybe s, Maybe a, Maybe a) a
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe s, Maybe s, Maybe a, Maybe a) a
 -> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a))
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
forall a b. (a -> b) -> a -> b
$ case Ordering
res of
            Ordering
GT -> a
-> (Maybe s, Maybe s, Maybe a, Maybe a)
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
forall s a. a -> s -> Step s a
Yield a
b (Maybe s
sa, Maybe s
sb, a -> Maybe a
forall a. a -> Maybe a
Just a
a, Maybe a
forall a. Maybe a
Nothing)
            Ordering
_  -> a
-> (Maybe s, Maybe s, Maybe a, Maybe a)
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
forall s a. a -> s -> Step s a
Yield a
a (Maybe s
sa, Maybe s
sb, Maybe a
forall a. Maybe a
Nothing, a -> Maybe a
forall a. a -> Maybe a
Just a
b)

    -- one of the values is missing, corresponding stream is done
    step State StreamK m a
_ (Maybe s
Nothing, Maybe s
sb, Maybe a
Nothing, Just a
b) =
            Step (Maybe s, Maybe s, Maybe a, Maybe a) a
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe s, Maybe s, Maybe a, Maybe a) a
 -> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a))
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
forall a b. (a -> b) -> a -> b
$ a
-> (Maybe s, Maybe s, Maybe a, Maybe a)
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
forall s a. a -> s -> Step s a
Yield a
b (Maybe s
forall a. Maybe a
Nothing, Maybe s
sb, Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)

    step State StreamK m a
_ (Maybe s
sa, Maybe s
Nothing, Just a
a, Maybe a
Nothing) =
            Step (Maybe s, Maybe s, Maybe a, Maybe a) a
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Maybe s, Maybe s, Maybe a, Maybe a) a
 -> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a))
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
forall a b. (a -> b) -> a -> b
$ a
-> (Maybe s, Maybe s, Maybe a, Maybe a)
-> Step (Maybe s, Maybe s, Maybe a, Maybe a) a
forall s a. a -> s -> Step s a
Yield a
a (Maybe s
sa, Maybe s
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)

    step State StreamK m a
_ (Maybe s
Nothing, Maybe s
Nothing, Maybe a
Nothing, Maybe a
Nothing) = Step (Maybe s, Maybe s, Maybe a, Maybe a) a
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (Maybe s, Maybe s, Maybe a, Maybe a) a
forall s a. Step s a
Stop

-- | WARNING! O(n^2) time complexity wrt number of streams. Suitable for
-- statically fusing a small number of streams. Use the O(n) complexity
-- StreamK.'Streamly.Data.StreamK.mergeBy' otherwise.
--
-- Merge two streams using a comparison function. The head elements of both
-- the streams are compared and the smaller of the two elements is emitted, if
-- both elements are equal then the element from the first stream is used
-- first.
--
-- If the streams are sorted in ascending order, the resulting stream would
-- also remain sorted in ascending order.
--
-- >>> s1 = Stream.fromList [1,3,5]
-- >>> s2 = Stream.fromList [2,4,6,8]
-- >>> Stream.fold Fold.toList $ Stream.mergeBy compare s1 s2
-- [1,2,3,4,5,6,8]
--
{-# INLINE mergeBy #-}
mergeBy
    :: (Monad m)
    => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a
mergeBy :: forall (m :: * -> *) a.
Monad m =>
(a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a
mergeBy a -> a -> Ordering
cmp = (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
forall (m :: * -> *) a.
Monad m =>
(a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
mergeByM (\a
a a
b -> Ordering -> m Ordering
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ordering -> m Ordering) -> Ordering -> m Ordering
forall a b. (a -> b) -> a -> b
$ a -> a -> Ordering
cmp a
a a
b)

-- | Like 'mergeByM' but stops merging as soon as any of the two streams stops.
--
-- /Unimplemented/
{-# INLINABLE mergeMinBy #-}
mergeMinBy :: -- Monad m =>
    (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
mergeMinBy :: forall a (m :: * -> *).
(a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
mergeMinBy a -> a -> m Ordering
_f Stream m a
_m1 Stream m a
_m2 = Stream m a
forall a. HasCallStack => a
undefined
    -- fromStreamD $ D.mergeMinBy f (toStreamD m1) (toStreamD m2)

-- | Like 'mergeByM' but stops merging as soon as the first stream stops.
--
-- /Unimplemented/
{-# INLINABLE mergeFstBy #-}
mergeFstBy :: -- Monad m =>
    (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
mergeFstBy :: forall a (m :: * -> *).
(a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
mergeFstBy a -> a -> m Ordering
_f Stream m a
_m1 Stream m a
_m2 = Stream m a
forall a. HasCallStack => a
undefined
    -- fromStreamK $ D.mergeFstBy f (toStreamD m1) (toStreamD m2)

------------------------------------------------------------------------------
-- Combine N Streams - unfoldEach
------------------------------------------------------------------------------

-- XXX If we want to have strictly N elements in each batch then we can supply a
-- Maybe input to the fold. That could be another variant of this combinator.

-- | Stream must be finite. Unfolds each element of the input stream to
-- generate streams. After generating one element from each stream fold those
-- using the supplied fold and emit the result in the output stream. Continue
-- doing this until the streams are exhausted.
--
-- /Unimplemented/
{-# INLINE_NORMAL unfoldEachFoldBy #-}
unfoldEachFoldBy :: -- Monad m =>
    Fold m b c -> Unfold m a b -> Stream m a -> Stream m c
unfoldEachFoldBy :: forall (m :: * -> *) b c a.
Fold m b c -> Unfold m a b -> Stream m a -> Stream m c
unfoldEachFoldBy = Fold m b c -> Unfold m a b -> Stream m a -> Stream m c
forall a. HasCallStack => a
undefined

data BfsUnfoldEachState o i =
      BfsUnfoldEachOuter o ([i] -> [i])
    | BfsUnfoldEachInner [i] ([i] -> [i])

-- XXX use arrays to store state instead of lists?
--
-- XXX In general we can use different scheduling strategies e.g. how to
-- schedule the outer vs inner loop or assigning weights to different streams
-- or outer and inner loops.

-- After a yield, switch to the next stream. Do not switch streams on Skip.
-- Yield from outer stream switches to the inner stream.
--
-- There are two choices here, (1) exhaust the outer stream first and then
-- start yielding from the inner streams, this is much simpler to implement,
-- (2) yield at least one element from an inner stream before going back to
-- outer stream and opening the next stream from it.
--
-- Ideally, we need some scheduling bias to inner streams vs outer stream.
-- Maybe we can configure the behavior.

-- | Like 'unfoldEach' but interleaves the resulting streams in a breadth first
-- manner instead of appending them. Unfolds each element in the input stream
-- to a stream and then interleave the resulting streams.
--
-- >>> lists = Stream.fromList [[1,4,7],[2,5,8],[3,6,9]]
-- >>> Stream.toList $ Stream.bfsUnfoldEach Unfold.fromList lists
-- [1,2,3,4,5,6,7,8,9]
--
-- CAUTION! Do not use on infinite streams.
--
{-# INLINE_NORMAL bfsUnfoldEach #-}
bfsUnfoldEach :: Monad m =>
    Unfold m a b -> Stream m a -> Stream m b
bfsUnfoldEach :: forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
bfsUnfoldEach (Unfold s -> m (Step s b)
istep a -> m s
inject) (Stream State StreamK m a -> s -> m (Step s a)
ostep s
ost) =
    (State StreamK m b
 -> BfsUnfoldEachState s s -> m (Step (BfsUnfoldEachState s s) b))
-> BfsUnfoldEachState s s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> BfsUnfoldEachState s s -> m (Step (BfsUnfoldEachState s s) b)
forall {m :: * -> *} {a}.
State StreamK m a
-> BfsUnfoldEachState s s -> m (Step (BfsUnfoldEachState s s) b)
step (s -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. o -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachOuter s
ost [s] -> [s]
forall a. a -> a
id)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> BfsUnfoldEachState s s -> m (Step (BfsUnfoldEachState s s) b)
step State StreamK m a
gst (BfsUnfoldEachOuter s
o [s] -> [s]
ls) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
ostep (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
o
        case Step s a
r of
            Yield a
a s
o' -> do
                s
i <- a -> m s
inject a
a
                s
i s
-> m (Step (BfsUnfoldEachState s s) b)
-> m (Step (BfsUnfoldEachState s s) b)
forall a b. a -> b -> b
`seq` Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BfsUnfoldEachState s s -> Step (BfsUnfoldEachState s s) b
forall s a. s -> Step s a
Skip (s -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. o -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachOuter s
o' ([s] -> [s]
ls ([s] -> [s]) -> ([s] -> [s]) -> [s] -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
i s -> [s] -> [s]
forall a. a -> [a] -> [a]
:))))
            Skip s
o' -> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (BfsUnfoldEachState s s) b
 -> m (Step (BfsUnfoldEachState s s) b))
-> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a b. (a -> b) -> a -> b
$ BfsUnfoldEachState s s -> Step (BfsUnfoldEachState s s) b
forall s a. s -> Step s a
Skip (s -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. o -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachOuter s
o' [s] -> [s]
ls)
            Step s a
Stop -> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (BfsUnfoldEachState s s) b
 -> m (Step (BfsUnfoldEachState s s) b))
-> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a b. (a -> b) -> a -> b
$ BfsUnfoldEachState s s -> Step (BfsUnfoldEachState s s) b
forall s a. s -> Step s a
Skip ([s] -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner ([s] -> [s]
ls []) [s] -> [s]
forall a. a -> a
id)

    step State StreamK m a
_ (BfsUnfoldEachInner [] [s] -> [s]
rs) =
        case [s] -> [s]
rs [] of
            [] -> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (BfsUnfoldEachState s s) b
forall s a. Step s a
Stop
            [s]
ls -> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (BfsUnfoldEachState s s) b
 -> m (Step (BfsUnfoldEachState s s) b))
-> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a b. (a -> b) -> a -> b
$ BfsUnfoldEachState s s -> Step (BfsUnfoldEachState s s) b
forall s a. s -> Step s a
Skip ([s] -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner [s]
ls [s] -> [s]
forall a. a -> a
id)

    step State StreamK m a
_ (BfsUnfoldEachInner (s
st:[s]
ls) [s] -> [s]
rs) = do
        Step s b
r <- s -> m (Step s b)
istep s
st
        Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (BfsUnfoldEachState s s) b
 -> m (Step (BfsUnfoldEachState s s) b))
-> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b -> BfsUnfoldEachState s s -> Step (BfsUnfoldEachState s s) b
forall s a. a -> s -> Step s a
Yield b
x ([s] -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner [s]
ls ([s] -> [s]
rs ([s] -> [s]) -> ([s] -> [s]) -> [s] -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
s s -> [s] -> [s]
forall a. a -> [a] -> [a]
:)))
            Skip s
s    -> BfsUnfoldEachState s s -> Step (BfsUnfoldEachState s s) b
forall s a. s -> Step s a
Skip ([s] -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner (s
ss -> [s] -> [s]
forall a. a -> [a] -> [a]
:[s]
ls) [s] -> [s]
rs)
            Step s b
Stop      -> BfsUnfoldEachState s s -> Step (BfsUnfoldEachState s s) b
forall s a. s -> Step s a
Skip ([s] -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner [s]
ls [s] -> [s]
rs)

data ConcatUnfoldInterleaveState o i =
      ConcatUnfoldInterleaveOuter o [i]
    | ConcatUnfoldInterleaveInner o [i]
    | ConcatUnfoldInterleaveInnerL [i] [i]
    | ConcatUnfoldInterleaveInnerR [i] [i]

-- | Like 'bfsUnfoldEach' but reverses the traversal direction after reaching
-- the last stream and then after reaching the first stream, thus alternating
-- the directions. This could be a little bit more efficient if the order of
-- traversal is not important.
--
-- >>> lists = Stream.fromList [[1,4,7],[2,5,8],[3,6,9]]
-- >>> Stream.toList $ Stream.altBfsUnfoldEach Unfold.fromList lists
-- [1,2,3,6,5,4,7,8,9]
--
-- CAUTION! Do not use on infinite streams.
--
{-# INLINE_NORMAL altBfsUnfoldEach #-}
altBfsUnfoldEach, unfoldInterleave :: Monad m =>
    Unfold m a b -> Stream m a -> Stream m b
altBfsUnfoldEach :: forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
altBfsUnfoldEach (Unfold s -> m (Step s b)
istep a -> m s
inject) (Stream State StreamK m a -> s -> m (Step s a)
ostep s
ost) =
    (State StreamK m b
 -> ConcatUnfoldInterleaveState s s
 -> m (Step (ConcatUnfoldInterleaveState s s) b))
-> ConcatUnfoldInterleaveState s s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> ConcatUnfoldInterleaveState s s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall {m :: * -> *} {a}.
State StreamK m a
-> ConcatUnfoldInterleaveState s s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
step (s -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. o -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveOuter s
ost [])

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> ConcatUnfoldInterleaveState s s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
step State StreamK m a
gst (ConcatUnfoldInterleaveOuter s
o [s]
ls) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
ostep (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
o
        case Step s a
r of
            Yield a
a s
o' -> do
                s
i <- a -> m s
inject a
a
                s
i s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a b. a -> b -> b
`seq` Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. s -> Step s a
Skip (s -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. o -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveInner s
o' (s
i s -> [s] -> [s]
forall a. a -> [a] -> [a]
: [s]
ls)))
            Skip s
o' -> Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatUnfoldInterleaveState s s) b
 -> m (Step (ConcatUnfoldInterleaveState s s) b))
-> Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a b. (a -> b) -> a -> b
$ ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. s -> Step s a
Skip (s -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. o -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveOuter s
o' [s]
ls)
            Step s a
Stop -> Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatUnfoldInterleaveState s s) b
 -> m (Step (ConcatUnfoldInterleaveState s s) b))
-> Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a b. (a -> b) -> a -> b
$ ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. s -> Step s a
Skip ([s] -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. [i] -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveInnerL [s]
ls [])

    step State StreamK m a
_ (ConcatUnfoldInterleaveInner s
_ []) = m (Step (ConcatUnfoldInterleaveState s s) b)
forall a. HasCallStack => a
undefined
    step State StreamK m a
_ (ConcatUnfoldInterleaveInner s
o (s
st:[s]
ls)) = do
        Step s b
r <- s -> m (Step s b)
istep s
st
        Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatUnfoldInterleaveState s s) b
 -> m (Step (ConcatUnfoldInterleaveState s s) b))
-> Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b
-> ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. a -> s -> Step s a
Yield b
x (s -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. o -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveOuter s
o (s
ss -> [s] -> [s]
forall a. a -> [a] -> [a]
:[s]
ls))
            Skip s
s    -> ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. s -> Step s a
Skip (s -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. o -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveInner s
o (s
ss -> [s] -> [s]
forall a. a -> [a] -> [a]
:[s]
ls))
            Step s b
Stop      -> ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. s -> Step s a
Skip (s -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. o -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveOuter s
o [s]
ls)

    step State StreamK m a
_ (ConcatUnfoldInterleaveInnerL [] []) = Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ConcatUnfoldInterleaveState s s) b
forall s a. Step s a
Stop
    step State StreamK m a
_ (ConcatUnfoldInterleaveInnerL [] [s]
rs) =
        Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatUnfoldInterleaveState s s) b
 -> m (Step (ConcatUnfoldInterleaveState s s) b))
-> Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a b. (a -> b) -> a -> b
$ ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. s -> Step s a
Skip ([s] -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. [i] -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveInnerR [] [s]
rs)

    step State StreamK m a
_ (ConcatUnfoldInterleaveInnerL (s
st:[s]
ls) [s]
rs) = do
        Step s b
r <- s -> m (Step s b)
istep s
st
        Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatUnfoldInterleaveState s s) b
 -> m (Step (ConcatUnfoldInterleaveState s s) b))
-> Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b
-> ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. a -> s -> Step s a
Yield b
x ([s] -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. [i] -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveInnerL [s]
ls (s
ss -> [s] -> [s]
forall a. a -> [a] -> [a]
:[s]
rs))
            Skip s
s    -> ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. s -> Step s a
Skip ([s] -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. [i] -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveInnerL (s
ss -> [s] -> [s]
forall a. a -> [a] -> [a]
:[s]
ls) [s]
rs)
            Step s b
Stop      -> ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. s -> Step s a
Skip ([s] -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. [i] -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveInnerL [s]
ls [s]
rs)

    step State StreamK m a
_ (ConcatUnfoldInterleaveInnerR [] []) = Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ConcatUnfoldInterleaveState s s) b
forall s a. Step s a
Stop
    step State StreamK m a
_ (ConcatUnfoldInterleaveInnerR [s]
ls []) =
        Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatUnfoldInterleaveState s s) b
 -> m (Step (ConcatUnfoldInterleaveState s s) b))
-> Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a b. (a -> b) -> a -> b
$ ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. s -> Step s a
Skip ([s] -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. [i] -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveInnerL [s]
ls [])

    step State StreamK m a
_ (ConcatUnfoldInterleaveInnerR [s]
ls (s
st:[s]
rs)) = do
        Step s b
r <- s -> m (Step s b)
istep s
st
        Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatUnfoldInterleaveState s s) b
 -> m (Step (ConcatUnfoldInterleaveState s s) b))
-> Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b
-> ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. a -> s -> Step s a
Yield b
x ([s] -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. [i] -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveInnerR (s
ss -> [s] -> [s]
forall a. a -> [a] -> [a]
:[s]
ls) [s]
rs)
            Skip s
s    -> ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. s -> Step s a
Skip ([s] -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. [i] -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveInnerR [s]
ls (s
ss -> [s] -> [s]
forall a. a -> [a] -> [a]
:[s]
rs))
            Step s b
Stop      -> ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. s -> Step s a
Skip ([s] -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. [i] -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveInnerR [s]
ls [s]
rs)

RENAME(unfoldInterleave,altBfsUnfoldEach)

-- XXX In general we can use different scheduling strategies e.g. how to
-- schedule the outer vs inner loop or assigning weights to different streams
-- or outer and inner loops.
--
-- This could be inefficient if the tasks are too small.
--
-- Compared to unfoldEachInterleave this one switches streams on Skips.

-- | Similar to 'bfsUnfoldEach' but scheduling is independent of output.
--
-- This is an N-ary version of 'roundRobin'.
--
-- >>> lists = Stream.fromList [[1,4,7],[2,5,8],[3,6,9]]
-- >>> Stream.toList $ Stream.unfoldSched Unfold.fromList lists
-- [1,2,3,4,5,6,7,8,9]
--
-- Scheduling is affected by the Skip constructor; implementations with more
-- skips receive proportionally less scheduling time.
--
-- CAUTION! Do not use on infinite streams.
--
{-# INLINE_NORMAL unfoldSched #-}
unfoldSched, unfoldRoundRobin :: Monad m =>
    Unfold m a b -> Stream m a -> Stream m b
unfoldSched :: forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
unfoldSched (Unfold s -> m (Step s b)
istep a -> m s
inject) (Stream State StreamK m a -> s -> m (Step s a)
ostep s
ost) =
    (State StreamK m b
 -> BfsUnfoldEachState s s -> m (Step (BfsUnfoldEachState s s) b))
-> BfsUnfoldEachState s s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> BfsUnfoldEachState s s -> m (Step (BfsUnfoldEachState s s) b)
forall {m :: * -> *} {a}.
State StreamK m a
-> BfsUnfoldEachState s s -> m (Step (BfsUnfoldEachState s s) b)
step (s -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. o -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachOuter s
ost [s] -> [s]
forall a. a -> a
id)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> BfsUnfoldEachState s s -> m (Step (BfsUnfoldEachState s s) b)
step State StreamK m a
gst (BfsUnfoldEachOuter s
o [s] -> [s]
ls) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
ostep (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
o
        case Step s a
r of
            Yield a
a s
o' -> do
                s
i <- a -> m s
inject a
a
                s
i s
-> m (Step (BfsUnfoldEachState s s) b)
-> m (Step (BfsUnfoldEachState s s) b)
forall a b. a -> b -> b
`seq` Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BfsUnfoldEachState s s -> Step (BfsUnfoldEachState s s) b
forall s a. s -> Step s a
Skip (s -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. o -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachOuter s
o' ([s] -> [s]
ls ([s] -> [s]) -> ([s] -> [s]) -> [s] -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
i s -> [s] -> [s]
forall a. a -> [a] -> [a]
:))))
            Skip s
o' -> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (BfsUnfoldEachState s s) b
 -> m (Step (BfsUnfoldEachState s s) b))
-> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a b. (a -> b) -> a -> b
$ BfsUnfoldEachState s s -> Step (BfsUnfoldEachState s s) b
forall s a. s -> Step s a
Skip (s -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. o -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachOuter s
o' [s] -> [s]
ls)
            Step s a
Stop -> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (BfsUnfoldEachState s s) b
 -> m (Step (BfsUnfoldEachState s s) b))
-> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a b. (a -> b) -> a -> b
$ BfsUnfoldEachState s s -> Step (BfsUnfoldEachState s s) b
forall s a. s -> Step s a
Skip ([s] -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner ([s] -> [s]
ls []) [s] -> [s]
forall a. a -> a
id)

    step State StreamK m a
_ (BfsUnfoldEachInner [] [s] -> [s]
rs) =
        case [s] -> [s]
rs [] of
            [] -> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (BfsUnfoldEachState s s) b
forall s a. Step s a
Stop
            [s]
ls -> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (BfsUnfoldEachState s s) b
 -> m (Step (BfsUnfoldEachState s s) b))
-> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a b. (a -> b) -> a -> b
$ BfsUnfoldEachState s s -> Step (BfsUnfoldEachState s s) b
forall s a. s -> Step s a
Skip ([s] -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner [s]
ls [s] -> [s]
forall a. a -> a
id)

    step State StreamK m a
_ (BfsUnfoldEachInner (s
st:[s]
ls) [s] -> [s]
rs) = do
        Step s b
r <- s -> m (Step s b)
istep s
st
        Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (BfsUnfoldEachState s s) b
 -> m (Step (BfsUnfoldEachState s s) b))
-> Step (BfsUnfoldEachState s s) b
-> m (Step (BfsUnfoldEachState s s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b -> BfsUnfoldEachState s s -> Step (BfsUnfoldEachState s s) b
forall s a. a -> s -> Step s a
Yield b
x ([s] -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner [s]
ls ([s] -> [s]
rs ([s] -> [s]) -> ([s] -> [s]) -> [s] -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
s s -> [s] -> [s]
forall a. a -> [a] -> [a]
:)))
            Skip s
s    -> BfsUnfoldEachState s s -> Step (BfsUnfoldEachState s s) b
forall s a. s -> Step s a
Skip ([s] -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner [s]
ls ([s] -> [s]
rs ([s] -> [s]) -> ([s] -> [s]) -> [s] -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
s s -> [s] -> [s]
forall a. a -> [a] -> [a]
:)))
            Step s b
Stop      -> BfsUnfoldEachState s s -> Step (BfsUnfoldEachState s s) b
forall s a. s -> Step s a
Skip ([s] -> ([s] -> [s]) -> BfsUnfoldEachState s s
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner [s]
ls [s] -> [s]
rs)

RENAME(unfoldRoundRobin,unfoldSched)

-- | Round robin co-operative scheduling of multiple streams.
--
-- Like concatMap but schedules the generated streams in a round robin
-- fashion. Note that it does not strive to interleave the outputs of the
-- streams, just gives the streams a chance to run whether it produces an
-- output or not. Therefore, the outputs may not seem to be fairly interleaved
-- if a stream decides to skip the output.
--
-- Scheduling is affected by the Skip constructor; implementations with more
-- skips receive proportionally less scheduling time.
--
-- CAUTION! Do not use on infinite streams.
--
{-# INLINE_NORMAL schedMapM #-}
schedMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b
schedMapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Stream m b)) -> Stream m a -> Stream m b
schedMapM a -> m (Stream m b)
f (Stream State StreamK m a -> s -> m (Step s a)
ostep s
ost) =
    (State StreamK m b
 -> BfsUnfoldEachState s (Stream m b)
 -> m (Step (BfsUnfoldEachState s (Stream m b)) b))
-> BfsUnfoldEachState s (Stream m b) -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> BfsUnfoldEachState s (Stream m b)
-> m (Step (BfsUnfoldEachState s (Stream m b)) b)
step (s
-> ([Stream m b] -> [Stream m b])
-> BfsUnfoldEachState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachOuter s
ost [Stream m b] -> [Stream m b]
forall a. a -> a
id)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m b
-> BfsUnfoldEachState s (Stream m b)
-> m (Step (BfsUnfoldEachState s (Stream m b)) b)
step State StreamK m b
gst (BfsUnfoldEachOuter s
o [Stream m b] -> [Stream m b]
ls) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
ostep (State StreamK m b -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m b
gst) s
o
        case Step s a
r of
            Yield a
a s
o' -> do
                Stream m b
i <- a -> m (Stream m b)
f a
a
                Step (BfsUnfoldEachState s (Stream m b)) b
-> m (Step (BfsUnfoldEachState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (BfsUnfoldEachState s (Stream m b)
-> Step (BfsUnfoldEachState s (Stream m b)) b
forall s a. s -> Step s a
Skip (s
-> ([Stream m b] -> [Stream m b])
-> BfsUnfoldEachState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachOuter s
o' ([Stream m b] -> [Stream m b]
ls ([Stream m b] -> [Stream m b])
-> ([Stream m b] -> [Stream m b]) -> [Stream m b] -> [Stream m b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stream m b
i Stream m b -> [Stream m b] -> [Stream m b]
forall a. a -> [a] -> [a]
:))))
            Skip s
o' -> Step (BfsUnfoldEachState s (Stream m b)) b
-> m (Step (BfsUnfoldEachState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (BfsUnfoldEachState s (Stream m b)) b
 -> m (Step (BfsUnfoldEachState s (Stream m b)) b))
-> Step (BfsUnfoldEachState s (Stream m b)) b
-> m (Step (BfsUnfoldEachState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ BfsUnfoldEachState s (Stream m b)
-> Step (BfsUnfoldEachState s (Stream m b)) b
forall s a. s -> Step s a
Skip (s
-> ([Stream m b] -> [Stream m b])
-> BfsUnfoldEachState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachOuter s
o' [Stream m b] -> [Stream m b]
ls)
            Step s a
Stop -> Step (BfsUnfoldEachState s (Stream m b)) b
-> m (Step (BfsUnfoldEachState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (BfsUnfoldEachState s (Stream m b)) b
 -> m (Step (BfsUnfoldEachState s (Stream m b)) b))
-> Step (BfsUnfoldEachState s (Stream m b)) b
-> m (Step (BfsUnfoldEachState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ BfsUnfoldEachState s (Stream m b)
-> Step (BfsUnfoldEachState s (Stream m b)) b
forall s a. s -> Step s a
Skip ([Stream m b]
-> ([Stream m b] -> [Stream m b])
-> BfsUnfoldEachState s (Stream m b)
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner ([Stream m b] -> [Stream m b]
ls []) [Stream m b] -> [Stream m b]
forall a. a -> a
id)

    step State StreamK m b
_ (BfsUnfoldEachInner [] [Stream m b] -> [Stream m b]
rs) =
        case [Stream m b] -> [Stream m b]
rs [] of
            [] -> Step (BfsUnfoldEachState s (Stream m b)) b
-> m (Step (BfsUnfoldEachState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (BfsUnfoldEachState s (Stream m b)) b
forall s a. Step s a
Stop
            [Stream m b]
ls -> Step (BfsUnfoldEachState s (Stream m b)) b
-> m (Step (BfsUnfoldEachState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (BfsUnfoldEachState s (Stream m b)) b
 -> m (Step (BfsUnfoldEachState s (Stream m b)) b))
-> Step (BfsUnfoldEachState s (Stream m b)) b
-> m (Step (BfsUnfoldEachState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ BfsUnfoldEachState s (Stream m b)
-> Step (BfsUnfoldEachState s (Stream m b)) b
forall s a. s -> Step s a
Skip ([Stream m b]
-> ([Stream m b] -> [Stream m b])
-> BfsUnfoldEachState s (Stream m b)
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner [Stream m b]
ls [Stream m b] -> [Stream m b]
forall a. a -> a
id)

    step State StreamK m b
gst (BfsUnfoldEachInner (UnStream State StreamK m b -> s -> m (Step s b)
istep s
st:[Stream m b]
ls) [Stream m b] -> [Stream m b]
rs) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
istep State StreamK m b
gst s
st
        Step (BfsUnfoldEachState s (Stream m b)) b
-> m (Step (BfsUnfoldEachState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (BfsUnfoldEachState s (Stream m b)) b
 -> m (Step (BfsUnfoldEachState s (Stream m b)) b))
-> Step (BfsUnfoldEachState s (Stream m b)) b
-> m (Step (BfsUnfoldEachState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b
-> BfsUnfoldEachState s (Stream m b)
-> Step (BfsUnfoldEachState s (Stream m b)) b
forall s a. a -> s -> Step s a
Yield b
x ([Stream m b]
-> ([Stream m b] -> [Stream m b])
-> BfsUnfoldEachState s (Stream m b)
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner [Stream m b]
ls ([Stream m b] -> [Stream m b]
rs ([Stream m b] -> [Stream m b])
-> ([Stream m b] -> [Stream m b]) -> [Stream m b] -> [Stream m b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((State StreamK m b -> s -> m (Step s b)) -> s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b -> s -> m (Step s b)
istep s
s Stream m b -> [Stream m b] -> [Stream m b]
forall a. a -> [a] -> [a]
:)))
            Skip s
s    -> BfsUnfoldEachState s (Stream m b)
-> Step (BfsUnfoldEachState s (Stream m b)) b
forall s a. s -> Step s a
Skip ([Stream m b]
-> ([Stream m b] -> [Stream m b])
-> BfsUnfoldEachState s (Stream m b)
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner [Stream m b]
ls ([Stream m b] -> [Stream m b]
rs ([Stream m b] -> [Stream m b])
-> ([Stream m b] -> [Stream m b]) -> [Stream m b] -> [Stream m b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((State StreamK m b -> s -> m (Step s b)) -> s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b -> s -> m (Step s b)
istep s
s Stream m b -> [Stream m b] -> [Stream m b]
forall a. a -> [a] -> [a]
:)))
            Step s b
Stop      -> BfsUnfoldEachState s (Stream m b)
-> Step (BfsUnfoldEachState s (Stream m b)) b
forall s a. s -> Step s a
Skip ([Stream m b]
-> ([Stream m b] -> [Stream m b])
-> BfsUnfoldEachState s (Stream m b)
forall o i. [i] -> ([i] -> [i]) -> BfsUnfoldEachState o i
BfsUnfoldEachInner [Stream m b]
ls [Stream m b] -> [Stream m b]
rs)

-- | See 'SchedFor' for documentation.
--
-- Scheduling is affected by the Skip constructor; implementations with more
-- skips receive proportionally less scheduling time.
--
-- CAUTION! Do not use on infinite streams.
--
{-# INLINE schedMap #-}
schedMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b
schedMap :: forall (m :: * -> *) a b.
Monad m =>
(a -> Stream m b) -> Stream m a -> Stream m b
schedMap a -> Stream m b
f = (a -> m (Stream m b)) -> Stream m a -> Stream m b
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Stream m b)) -> Stream m a -> Stream m b
schedMapM (Stream m b -> m (Stream m b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream m b -> m (Stream m b))
-> (a -> Stream m b) -> a -> m (Stream m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Stream m b
f)

-- | See 'SchedFor' for documentation.
--
-- Scheduling is affected by the Skip constructor; implementations with more
-- skips receive proportionally less scheduling time.
--
-- CAUTION! Do not use on infinite streams.
--
{-# INLINE schedForM #-}
schedForM :: Monad m => Stream m a -> (a -> m (Stream m b)) -> Stream m b
schedForM :: forall (m :: * -> *) a b.
Monad m =>
Stream m a -> (a -> m (Stream m b)) -> Stream m b
schedForM = ((a -> m (Stream m b)) -> Stream m a -> Stream m b)
-> Stream m a -> (a -> m (Stream m b)) -> Stream m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m (Stream m b)) -> Stream m a -> Stream m b
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Stream m b)) -> Stream m a -> Stream m b
schedMapM

-- | Similar to 'bfsConcatFor' but scheduling is independent of output.
--
-- >>> lists = Stream.fromList [[1,4,7],[2,5,8],[3,6,9]]
-- >>> Stream.toList $ Stream.schedFor lists $ \xs -> Stream.fromList xs
-- [1,2,3,4,5,6,7,8,9]
--
-- Scheduling is affected by the Skip constructor; implementations with more
-- skips receive proportionally less scheduling time.
--
-- CAUTION! Do not use on infinite streams.
--
{-# INLINE schedFor #-}
schedFor :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b
schedFor :: forall (m :: * -> *) a b.
Monad m =>
Stream m a -> (a -> Stream m b) -> Stream m b
schedFor = ((a -> Stream m b) -> Stream m a -> Stream m b)
-> Stream m a -> (a -> Stream m b) -> Stream m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Stream m b) -> Stream m a -> Stream m b
forall (m :: * -> *) a b.
Monad m =>
(a -> Stream m b) -> Stream m a -> Stream m b
schedMap

-- | Similar to 'fairUnfoldEach' but scheduling is independent of the output.
--
-- >>> :{
-- outerLoop = Stream.fromList [1,2,3]
-- innerLoop = Unfold.carry $ Unfold.lmap (const [4,5,6]) Unfold.fromList
-- :}
--
-- >>> Stream.toList $ Stream.fairUnfoldSched innerLoop outerLoop
-- [(1,4),(1,5),(2,4),(1,6),(2,5),(3,4),(2,6),(3,5),(3,6)]
--
-- Scheduling is affected by the Skip constructor; implementations with more
-- skips receive proportionally less scheduling time.
--
{-# INLINE_NORMAL fairUnfoldSched #-}
fairUnfoldSched :: Monad m =>
    Unfold m a b -> Stream m a -> Stream m b
fairUnfoldSched :: forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
fairUnfoldSched (Unfold s -> m (Step s b)
istep a -> m s
inject) (Stream State StreamK m a -> s -> m (Step s a)
ostep s
ost) =
    (State StreamK m b
 -> FairUnfoldState s s -> m (Step (FairUnfoldState s s) b))
-> FairUnfoldState s s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> FairUnfoldState s s -> m (Step (FairUnfoldState s s) b)
forall {m :: * -> *} {a}.
State StreamK m a
-> FairUnfoldState s s -> m (Step (FairUnfoldState s s) b)
step (s -> ([s] -> [s]) -> FairUnfoldState s s
forall o i. o -> ([i] -> [i]) -> FairUnfoldState o i
FairUnfoldInit s
ost [s] -> [s]
forall a. a -> a
id)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> FairUnfoldState s s -> m (Step (FairUnfoldState s s) b)
step State StreamK m a
gst (FairUnfoldInit s
o [s] -> [s]
ls) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
ostep (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
o
        case Step s a
r of
            Yield a
a s
o' -> do
                s
i <- a -> m s
inject a
a
                s
i s
-> m (Step (FairUnfoldState s s) b)
-> m (Step (FairUnfoldState s s) b)
forall a b. a -> b -> b
`seq` Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (s -> ([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o' [s] -> [s]
forall a. a -> a
id ([s] -> [s]
ls [s
i])))
            Skip s
o' -> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b))
-> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (s -> ([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o' [s] -> [s]
forall a. a -> a
id ([s] -> [s]
ls []))
            Step s a
Stop -> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b))
-> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain [s] -> [s]
forall a. a -> a
id ([s] -> [s]
ls []))

    step State StreamK m a
_ (FairUnfoldNext s
o [s] -> [s]
ys []) =
            Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b))
-> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (s -> ([s] -> [s]) -> FairUnfoldState s s
forall o i. o -> ([i] -> [i]) -> FairUnfoldState o i
FairUnfoldInit s
o [s] -> [s]
ys)

    step State StreamK m a
_ (FairUnfoldNext s
o [s] -> [s]
ys (s
st:[s]
ls)) = do
        Step s b
r <- s -> m (Step s b)
istep s
st
        Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b))
-> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b -> FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. a -> s -> Step s a
Yield b
x (s -> ([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o ([s] -> [s]
ys ([s] -> [s]) -> ([s] -> [s]) -> [s] -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
s s -> [s] -> [s]
forall a. a -> [a] -> [a]
:)) [s]
ls)
            Skip s
s    -> FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (s -> ([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o ([s] -> [s]
ys ([s] -> [s]) -> ([s] -> [s]) -> [s] -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
s s -> [s] -> [s]
forall a. a -> [a] -> [a]
:)) [s]
ls)
            Step s b
Stop      -> FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (s -> ([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o [s] -> [s]
ys [s]
ls)

    step State StreamK m a
_ (FairUnfoldDrain [s] -> [s]
ys []) =
        case [s] -> [s]
ys [] of
            [] -> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (FairUnfoldState s s) b
forall s a. Step s a
Stop
            [s]
xs -> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b))
-> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain [s] -> [s]
forall a. a -> a
id [s]
xs)

    step State StreamK m a
_ (FairUnfoldDrain [s] -> [s]
ys (s
st:[s]
ls)) = do
        Step s b
r <- s -> m (Step s b)
istep s
st
        Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b))
-> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b -> FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. a -> s -> Step s a
Yield b
x (([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain ([s] -> [s]
ys ([s] -> [s]) -> ([s] -> [s]) -> [s] -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
s s -> [s] -> [s]
forall a. a -> [a] -> [a]
:)) [s]
ls)
            Skip s
s    -> FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain ([s] -> [s]
ys ([s] -> [s]) -> ([s] -> [s]) -> [s] -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
s s -> [s] -> [s]
forall a. a -> [a] -> [a]
:)) [s]
ls)
            Step s b
Stop      -> FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain [s] -> [s]
ys [s]
ls)

-- | See 'fairConcatFor' for more details. This is similar except that this
-- uses unfolds, therefore, it is much faster due to fusion.
--
-- >>> :{
-- outerLoop = Stream.fromList [1,2,3]
-- innerLoop = Unfold.carry $ Unfold.lmap (const [4,5,6]) Unfold.fromList
-- :}
--
-- >>> Stream.toList $ Stream.fairUnfoldEach innerLoop outerLoop
-- [(1,4),(1,5),(2,4),(1,6),(2,5),(3,4),(2,6),(3,5),(3,6)]
--
{-# INLINE_NORMAL fairUnfoldEach #-}
fairUnfoldEach :: Monad m =>
    Unfold m a b -> Stream m a -> Stream m b
fairUnfoldEach :: forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
fairUnfoldEach (Unfold s -> m (Step s b)
istep a -> m s
inject) (Stream State StreamK m a -> s -> m (Step s a)
ostep s
ost) =
    (State StreamK m b
 -> FairUnfoldState s s -> m (Step (FairUnfoldState s s) b))
-> FairUnfoldState s s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> FairUnfoldState s s -> m (Step (FairUnfoldState s s) b)
forall {m :: * -> *} {a}.
State StreamK m a
-> FairUnfoldState s s -> m (Step (FairUnfoldState s s) b)
step (s -> ([s] -> [s]) -> FairUnfoldState s s
forall o i. o -> ([i] -> [i]) -> FairUnfoldState o i
FairUnfoldInit s
ost [s] -> [s]
forall a. a -> a
id)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> FairUnfoldState s s -> m (Step (FairUnfoldState s s) b)
step State StreamK m a
gst (FairUnfoldInit s
o [s] -> [s]
ls) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
ostep (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
o
        case Step s a
r of
            Yield a
a s
o' -> do
                s
i <- a -> m s
inject a
a
                s
i s
-> m (Step (FairUnfoldState s s) b)
-> m (Step (FairUnfoldState s s) b)
forall a b. a -> b -> b
`seq` Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (s -> ([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o' [s] -> [s]
forall a. a -> a
id ([s] -> [s]
ls [s
i])))
            Skip s
o' -> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b))
-> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (s -> ([s] -> [s]) -> FairUnfoldState s s
forall o i. o -> ([i] -> [i]) -> FairUnfoldState o i
FairUnfoldInit s
o' [s] -> [s]
ls)
            Step s a
Stop -> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b))
-> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain [s] -> [s]
forall a. a -> a
id ([s] -> [s]
ls []))

    step State StreamK m a
_ (FairUnfoldNext s
o [s] -> [s]
ys []) =
            Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b))
-> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (s -> ([s] -> [s]) -> FairUnfoldState s s
forall o i. o -> ([i] -> [i]) -> FairUnfoldState o i
FairUnfoldInit s
o [s] -> [s]
ys)

    step State StreamK m a
_ (FairUnfoldNext s
o [s] -> [s]
ys (s
st:[s]
ls)) = do
        Step s b
r <- s -> m (Step s b)
istep s
st
        Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b))
-> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b -> FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. a -> s -> Step s a
Yield b
x (s -> ([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o ([s] -> [s]
ys ([s] -> [s]) -> ([s] -> [s]) -> [s] -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
s s -> [s] -> [s]
forall a. a -> [a] -> [a]
:)) [s]
ls)
            Skip s
s    -> FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (s -> ([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o [s] -> [s]
ys (s
s s -> [s] -> [s]
forall a. a -> [a] -> [a]
: [s]
ls))
            Step s b
Stop      -> FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (s -> ([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o [s] -> [s]
ys [s]
ls)

    step State StreamK m a
_ (FairUnfoldDrain [s] -> [s]
ys []) =
        case [s] -> [s]
ys [] of
            [] -> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (FairUnfoldState s s) b
forall s a. Step s a
Stop
            [s]
xs -> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b))
-> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain [s] -> [s]
forall a. a -> a
id [s]
xs)

    step State StreamK m a
_ (FairUnfoldDrain [s] -> [s]
ys (s
st:[s]
ls)) = do
        Step s b
r <- s -> m (Step s b)
istep s
st
        Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b))
-> Step (FairUnfoldState s s) b -> m (Step (FairUnfoldState s s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b -> FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. a -> s -> Step s a
Yield b
x (([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain ([s] -> [s]
ys ([s] -> [s]) -> ([s] -> [s]) -> [s] -> [s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
s s -> [s] -> [s]
forall a. a -> [a] -> [a]
:)) [s]
ls)
            Skip s
s    -> FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain [s] -> [s]
ys (s
s s -> [s] -> [s]
forall a. a -> [a] -> [a]
: [s]
ls))
            Step s b
Stop      -> FairUnfoldState s s -> Step (FairUnfoldState s s) b
forall s a. s -> Step s a
Skip (([s] -> [s]) -> [s] -> FairUnfoldState s s
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain [s] -> [s]
ys [s]
ls)

-- | See 'fairSchedFor' for documentation.
--
-- Scheduling is affected by the Skip constructor; implementations with more
-- skips receive proportionally less scheduling time.
--
{-# INLINE_NORMAL fairSchedMapM #-}
fairSchedMapM :: Monad m =>
    (a -> m (Stream m b)) -> Stream m a -> Stream m b
fairSchedMapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Stream m b)) -> Stream m a -> Stream m b
fairSchedMapM a -> m (Stream m b)
f (Stream State StreamK m a -> s -> m (Step s a)
ostep s
ost) =
    (State StreamK m b
 -> FairUnfoldState s (Stream m b)
 -> m (Step (FairUnfoldState s (Stream m b)) b))
-> FairUnfoldState s (Stream m b) -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> FairUnfoldState s (Stream m b)
-> m (Step (FairUnfoldState s (Stream m b)) b)
step (s
-> ([Stream m b] -> [Stream m b]) -> FairUnfoldState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> FairUnfoldState o i
FairUnfoldInit s
ost [Stream m b] -> [Stream m b]
forall a. a -> a
id)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m b
-> FairUnfoldState s (Stream m b)
-> m (Step (FairUnfoldState s (Stream m b)) b)
step State StreamK m b
gst (FairUnfoldInit s
o [Stream m b] -> [Stream m b]
ls) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
ostep (State StreamK m b -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m b
gst) s
o
        case Step s a
r of
            Yield a
a s
o' -> do
                Stream m b
i <- a -> m (Stream m b)
f a
a
                Stream m b
i Stream m b
-> m (Step (FairUnfoldState s (Stream m b)) b)
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a b. a -> b -> b
`seq` Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (s
-> ([Stream m b] -> [Stream m b])
-> [Stream m b]
-> FairUnfoldState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o' [Stream m b] -> [Stream m b]
forall a. a -> a
id ([Stream m b] -> [Stream m b]
ls [Stream m b
i])))
            Skip s
o' -> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s (Stream m b)) b
 -> m (Step (FairUnfoldState s (Stream m b)) b))
-> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (s
-> ([Stream m b] -> [Stream m b])
-> [Stream m b]
-> FairUnfoldState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o' [Stream m b] -> [Stream m b]
forall a. a -> a
id ([Stream m b] -> [Stream m b]
ls []))
            Step s a
Stop -> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s (Stream m b)) b
 -> m (Step (FairUnfoldState s (Stream m b)) b))
-> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (([Stream m b] -> [Stream m b])
-> [Stream m b] -> FairUnfoldState s (Stream m b)
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain [Stream m b] -> [Stream m b]
forall a. a -> a
id ([Stream m b] -> [Stream m b]
ls []))

    step State StreamK m b
_ (FairUnfoldNext s
o [Stream m b] -> [Stream m b]
ys []) =
            Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s (Stream m b)) b
 -> m (Step (FairUnfoldState s (Stream m b)) b))
-> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (s
-> ([Stream m b] -> [Stream m b]) -> FairUnfoldState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> FairUnfoldState o i
FairUnfoldInit s
o [Stream m b] -> [Stream m b]
ys)

    step State StreamK m b
gst (FairUnfoldNext s
o [Stream m b] -> [Stream m b]
ys (UnStream State StreamK m b -> s -> m (Step s b)
istep s
st:[Stream m b]
ls)) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
istep State StreamK m b
gst s
st
        Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s (Stream m b)) b
 -> m (Step (FairUnfoldState s (Stream m b)) b))
-> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b
-> FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. a -> s -> Step s a
Yield b
x (s
-> ([Stream m b] -> [Stream m b])
-> [Stream m b]
-> FairUnfoldState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o ([Stream m b] -> [Stream m b]
ys ([Stream m b] -> [Stream m b])
-> ([Stream m b] -> [Stream m b]) -> [Stream m b] -> [Stream m b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((State StreamK m b -> s -> m (Step s b)) -> s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b -> s -> m (Step s b)
istep s
s Stream m b -> [Stream m b] -> [Stream m b]
forall a. a -> [a] -> [a]
:)) [Stream m b]
ls)
            Skip s
s    -> FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (s
-> ([Stream m b] -> [Stream m b])
-> [Stream m b]
-> FairUnfoldState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o ([Stream m b] -> [Stream m b]
ys ([Stream m b] -> [Stream m b])
-> ([Stream m b] -> [Stream m b]) -> [Stream m b] -> [Stream m b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((State StreamK m b -> s -> m (Step s b)) -> s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b -> s -> m (Step s b)
istep s
s Stream m b -> [Stream m b] -> [Stream m b]
forall a. a -> [a] -> [a]
:)) [Stream m b]
ls)
            Step s b
Stop      -> FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (s
-> ([Stream m b] -> [Stream m b])
-> [Stream m b]
-> FairUnfoldState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o [Stream m b] -> [Stream m b]
ys [Stream m b]
ls)

    step State StreamK m b
_ (FairUnfoldDrain [Stream m b] -> [Stream m b]
ys []) =
        case [Stream m b] -> [Stream m b]
ys [] of
            [] -> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (FairUnfoldState s (Stream m b)) b
forall s a. Step s a
Stop
            [Stream m b]
xs -> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s (Stream m b)) b
 -> m (Step (FairUnfoldState s (Stream m b)) b))
-> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (([Stream m b] -> [Stream m b])
-> [Stream m b] -> FairUnfoldState s (Stream m b)
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain [Stream m b] -> [Stream m b]
forall a. a -> a
id [Stream m b]
xs)

    step State StreamK m b
gst (FairUnfoldDrain [Stream m b] -> [Stream m b]
ys (UnStream State StreamK m b -> s -> m (Step s b)
istep s
st:[Stream m b]
ls)) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
istep State StreamK m b
gst s
st
        Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s (Stream m b)) b
 -> m (Step (FairUnfoldState s (Stream m b)) b))
-> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b
-> FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. a -> s -> Step s a
Yield b
x (([Stream m b] -> [Stream m b])
-> [Stream m b] -> FairUnfoldState s (Stream m b)
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain ([Stream m b] -> [Stream m b]
ys ([Stream m b] -> [Stream m b])
-> ([Stream m b] -> [Stream m b]) -> [Stream m b] -> [Stream m b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((State StreamK m b -> s -> m (Step s b)) -> s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b -> s -> m (Step s b)
istep s
s Stream m b -> [Stream m b] -> [Stream m b]
forall a. a -> [a] -> [a]
:)) [Stream m b]
ls)
            Skip s
s    -> FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (([Stream m b] -> [Stream m b])
-> [Stream m b] -> FairUnfoldState s (Stream m b)
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain ([Stream m b] -> [Stream m b]
ys ([Stream m b] -> [Stream m b])
-> ([Stream m b] -> [Stream m b]) -> [Stream m b] -> [Stream m b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((State StreamK m b -> s -> m (Step s b)) -> s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b -> s -> m (Step s b)
istep s
s Stream m b -> [Stream m b] -> [Stream m b]
forall a. a -> [a] -> [a]
:)) [Stream m b]
ls)
            Step s b
Stop      -> FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (([Stream m b] -> [Stream m b])
-> [Stream m b] -> FairUnfoldState s (Stream m b)
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain [Stream m b] -> [Stream m b]
ys [Stream m b]
ls)

-- | See 'fairSchedFor' for documentation.
--
-- Scheduling is affected by the Skip constructor; implementations with more
-- skips receive proportionally less scheduling time.
--
{-# INLINE fairSchedMap #-}
fairSchedMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b
fairSchedMap :: forall (m :: * -> *) a b.
Monad m =>
(a -> Stream m b) -> Stream m a -> Stream m b
fairSchedMap a -> Stream m b
f = (a -> m (Stream m b)) -> Stream m a -> Stream m b
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Stream m b)) -> Stream m a -> Stream m b
fairSchedMapM (Stream m b -> m (Stream m b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream m b -> m (Stream m b))
-> (a -> Stream m b) -> a -> m (Stream m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Stream m b
f)

-- | See 'fairSchedFor' for documentation.
--
-- Scheduling is affected by the Skip constructor; implementations with more
-- skips receive proportionally less scheduling time.
--
{-# INLINE fairSchedForM #-}
fairSchedForM :: Monad m => Stream m a -> (a -> m (Stream m b)) -> Stream m b
fairSchedForM :: forall (m :: * -> *) a b.
Monad m =>
Stream m a -> (a -> m (Stream m b)) -> Stream m b
fairSchedForM = ((a -> m (Stream m b)) -> Stream m a -> Stream m b)
-> Stream m a -> (a -> m (Stream m b)) -> Stream m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m (Stream m b)) -> Stream m a -> Stream m b
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Stream m b)) -> Stream m a -> Stream m b
fairSchedMapM

-- | 'fairSchedFor' is just like 'fairConcatFor', it traverses the depth and
-- breadth of nesting equally. It maintains fairness among different levels of
-- loop iterations.  Therefore, the outer and the inner loops in a nested loop
-- get equal priority. It can be used to nest infinite streams without starving
-- outer streams due to inner ones.
--
-- There is one crucial difference, while 'fairConcatFor' necessarily produces
-- an output from one stream before it schedules the next, 'fairSchedFor'
-- schedules the next stream even if a stream did not produce an output. Thus
-- it interleaves the CPU rather than the outputs of the streams. Thus even if
-- an infinite stream does not produce an output it can not block all other
-- streams.
--
-- Note that the order of emitting the output from different streams may not be
-- predictable, it depends on the skip points inside the stream. Scheduling is
-- affected by the Skip constructor; implementations with more skips receive
-- proportionally less scheduling time.
--
-- == Non-Productive Streams
--
-- Unlike in 'fairConcatFor', if one of the two interleaved streams does not
-- produce an output at all and continues forever then the other stream will
-- still get scheduled. The following program will hang forever for
-- 'fairConcatFor' but will work fine with 'fairSchedFor'.
--
-- >>> :{
-- oddsIf x = Stream.fromList (if x then [1,3..] else [2,4..])
-- filterEven x = if even x then Stream.fromPure x else Stream.nil
-- :}
--
-- >>> :{
-- evens =
--     Stream.fairSchedFor (Stream.fromList [True,False]) $ \r ->
--      Stream.fairSchedFor (oddsIf r) filterEven
-- :}
--
-- >>> Stream.toList $ Stream.take 3 $ evens
-- [2,4,6]
--
-- When @r@ is True, the nested 'fairSchedFor' is a non-productive infinite
-- loop, but still the outer loop gets a chance to generate the @False@ value,
-- and the @evens@ function can produce output. The same code won't terminate
-- if we use 'fairConcatFor' instead of 'fairSchedFor'. Thus even without
-- explicit concurrency we can schedule multiple streams on the same CPU.
--
-- == Logic Programming
--
-- When exploring large streams in logic programming, 'fairSchedFor' can be
-- used as a safe alternative to 'fairConcatFor' as it cannot block due to
-- non-productive infinite streams.
--
{-# INLINE fairSchedFor #-}
fairSchedFor :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b
fairSchedFor :: forall (m :: * -> *) a b.
Monad m =>
Stream m a -> (a -> Stream m b) -> Stream m b
fairSchedFor = ((a -> Stream m b) -> Stream m a -> Stream m b)
-> Stream m a -> (a -> Stream m b) -> Stream m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Stream m b) -> Stream m a -> Stream m b
forall (m :: * -> *) a b.
Monad m =>
(a -> Stream m b) -> Stream m a -> Stream m b
fairSchedMap

-- | See 'fairConcatFor' for documentation.
{-# INLINE_NORMAL fairConcatMapM #-}
fairConcatMapM :: Monad m =>
    (a -> m (Stream m b)) -> Stream m a -> Stream m b
fairConcatMapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Stream m b)) -> Stream m a -> Stream m b
fairConcatMapM a -> m (Stream m b)
f (Stream State StreamK m a -> s -> m (Step s a)
ostep s
ost) =
    (State StreamK m b
 -> FairUnfoldState s (Stream m b)
 -> m (Step (FairUnfoldState s (Stream m b)) b))
-> FairUnfoldState s (Stream m b) -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> FairUnfoldState s (Stream m b)
-> m (Step (FairUnfoldState s (Stream m b)) b)
step (s
-> ([Stream m b] -> [Stream m b]) -> FairUnfoldState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> FairUnfoldState o i
FairUnfoldInit s
ost [Stream m b] -> [Stream m b]
forall a. a -> a
id)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m b
-> FairUnfoldState s (Stream m b)
-> m (Step (FairUnfoldState s (Stream m b)) b)
step State StreamK m b
gst (FairUnfoldInit s
o [Stream m b] -> [Stream m b]
ls) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
ostep (State StreamK m b -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m b
gst) s
o
        case Step s a
r of
            Yield a
a s
o' -> do
                Stream m b
i <- a -> m (Stream m b)
f a
a
                Stream m b
i Stream m b
-> m (Step (FairUnfoldState s (Stream m b)) b)
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a b. a -> b -> b
`seq` Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (s
-> ([Stream m b] -> [Stream m b])
-> [Stream m b]
-> FairUnfoldState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o' [Stream m b] -> [Stream m b]
forall a. a -> a
id ([Stream m b] -> [Stream m b]
ls [Stream m b
i])))
            Skip s
o' -> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s (Stream m b)) b
 -> m (Step (FairUnfoldState s (Stream m b)) b))
-> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (s
-> ([Stream m b] -> [Stream m b]) -> FairUnfoldState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> FairUnfoldState o i
FairUnfoldInit s
o' [Stream m b] -> [Stream m b]
ls)
            Step s a
Stop -> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s (Stream m b)) b
 -> m (Step (FairUnfoldState s (Stream m b)) b))
-> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (([Stream m b] -> [Stream m b])
-> [Stream m b] -> FairUnfoldState s (Stream m b)
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain [Stream m b] -> [Stream m b]
forall a. a -> a
id ([Stream m b] -> [Stream m b]
ls []))

    step State StreamK m b
_ (FairUnfoldNext s
o [Stream m b] -> [Stream m b]
ys []) =
            Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s (Stream m b)) b
 -> m (Step (FairUnfoldState s (Stream m b)) b))
-> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (s
-> ([Stream m b] -> [Stream m b]) -> FairUnfoldState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> FairUnfoldState o i
FairUnfoldInit s
o [Stream m b] -> [Stream m b]
ys)

    step State StreamK m b
gst (FairUnfoldNext s
o [Stream m b] -> [Stream m b]
ys (UnStream State StreamK m b -> s -> m (Step s b)
istep s
st:[Stream m b]
ls)) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
istep State StreamK m b
gst s
st
        Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s (Stream m b)) b
 -> m (Step (FairUnfoldState s (Stream m b)) b))
-> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b
-> FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. a -> s -> Step s a
Yield b
x (s
-> ([Stream m b] -> [Stream m b])
-> [Stream m b]
-> FairUnfoldState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o ([Stream m b] -> [Stream m b]
ys ([Stream m b] -> [Stream m b])
-> ([Stream m b] -> [Stream m b]) -> [Stream m b] -> [Stream m b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((State StreamK m b -> s -> m (Step s b)) -> s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b -> s -> m (Step s b)
istep s
s Stream m b -> [Stream m b] -> [Stream m b]
forall a. a -> [a] -> [a]
:)) [Stream m b]
ls)
            Skip s
s    -> FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (s
-> ([Stream m b] -> [Stream m b])
-> [Stream m b]
-> FairUnfoldState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o [Stream m b] -> [Stream m b]
ys ((State StreamK m b -> s -> m (Step s b)) -> s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
UnStream State StreamK m b -> s -> m (Step s b)
istep s
sStream m b -> [Stream m b] -> [Stream m b]
forall a. a -> [a] -> [a]
:[Stream m b]
ls))
            Step s b
Stop      -> FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (s
-> ([Stream m b] -> [Stream m b])
-> [Stream m b]
-> FairUnfoldState s (Stream m b)
forall o i. o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldNext s
o [Stream m b] -> [Stream m b]
ys [Stream m b]
ls)

    step State StreamK m b
_ (FairUnfoldDrain [Stream m b] -> [Stream m b]
ys []) =
        case [Stream m b] -> [Stream m b]
ys [] of
            [] -> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (FairUnfoldState s (Stream m b)) b
forall s a. Step s a
Stop
            [Stream m b]
xs -> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s (Stream m b)) b
 -> m (Step (FairUnfoldState s (Stream m b)) b))
-> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (([Stream m b] -> [Stream m b])
-> [Stream m b] -> FairUnfoldState s (Stream m b)
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain [Stream m b] -> [Stream m b]
forall a. a -> a
id [Stream m b]
xs)

    step State StreamK m b
gst (FairUnfoldDrain [Stream m b] -> [Stream m b]
ys (UnStream State StreamK m b -> s -> m (Step s b)
istep s
st:[Stream m b]
ls)) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
istep State StreamK m b
gst s
st
        Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FairUnfoldState s (Stream m b)) b
 -> m (Step (FairUnfoldState s (Stream m b)) b))
-> Step (FairUnfoldState s (Stream m b)) b
-> m (Step (FairUnfoldState s (Stream m b)) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b
-> FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. a -> s -> Step s a
Yield b
x (([Stream m b] -> [Stream m b])
-> [Stream m b] -> FairUnfoldState s (Stream m b)
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain ([Stream m b] -> [Stream m b]
ys ([Stream m b] -> [Stream m b])
-> ([Stream m b] -> [Stream m b]) -> [Stream m b] -> [Stream m b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((State StreamK m b -> s -> m (Step s b)) -> s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b -> s -> m (Step s b)
istep s
s Stream m b -> [Stream m b] -> [Stream m b]
forall a. a -> [a] -> [a]
:)) [Stream m b]
ls)
            Skip s
s    -> FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (([Stream m b] -> [Stream m b])
-> [Stream m b] -> FairUnfoldState s (Stream m b)
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain [Stream m b] -> [Stream m b]
ys ((State StreamK m b -> s -> m (Step s b)) -> s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b -> s -> m (Step s b)
istep s
s Stream m b -> [Stream m b] -> [Stream m b]
forall a. a -> [a] -> [a]
: [Stream m b]
ls))
            Step s b
Stop      -> FairUnfoldState s (Stream m b)
-> Step (FairUnfoldState s (Stream m b)) b
forall s a. s -> Step s a
Skip (([Stream m b] -> [Stream m b])
-> [Stream m b] -> FairUnfoldState s (Stream m b)
forall o i. ([i] -> [i]) -> [i] -> FairUnfoldState o i
FairUnfoldDrain [Stream m b] -> [Stream m b]
ys [Stream m b]
ls)

-- | See 'fairConcatFor' for documentation.
{-# INLINE fairConcatMap #-}
fairConcatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b
fairConcatMap :: forall (m :: * -> *) a b.
Monad m =>
(a -> Stream m b) -> Stream m a -> Stream m b
fairConcatMap a -> Stream m b
f = (a -> m (Stream m b)) -> Stream m a -> Stream m b
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Stream m b)) -> Stream m a -> Stream m b
fairConcatMapM (Stream m b -> m (Stream m b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Stream m b -> m (Stream m b))
-> (a -> Stream m b) -> a -> m (Stream m b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Stream m b
f)

-- | See 'fairConcatFor' for documentation.
{-# INLINE fairConcatForM #-}
fairConcatForM :: Monad m => Stream m a -> (a -> m (Stream m b)) -> Stream m b
fairConcatForM :: forall (m :: * -> *) a b.
Monad m =>
Stream m a -> (a -> m (Stream m b)) -> Stream m b
fairConcatForM = ((a -> m (Stream m b)) -> Stream m a -> Stream m b)
-> Stream m a -> (a -> m (Stream m b)) -> Stream m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m (Stream m b)) -> Stream m a -> Stream m b
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Stream m b)) -> Stream m a -> Stream m b
fairConcatMapM

-- | 'fairConcatFor' is like 'concatFor' but traverses the depth and breadth of
-- nesting equally. Therefore, the outer and the inner loops in a nested loop
-- get equal priority. It can be used to nest infinite streams without starving
-- outer streams due to inner ones.
--
-- Given a stream of three streams:
--
-- @
-- 1. [1,2,3]
-- 2. [4,5,6]
-- 3. [7,8,9]
-- @
--
-- Here, outer loop is the stream of streams and the inner loops are the
-- individual streams. The traversal sweeps the diagonals in the above grid to
-- give equal chance to outer and inner loops. The resulting stream is
-- @(1),(2,4),(3,5,7),(6,8),(9)@, diagonals are parenthesized for emphasis.
--
-- == Looping
--
-- A single stream case is equivalent to 'concatFor':
--
-- >>> Stream.toList $ Stream.fairConcatFor (Stream.fromList [1,2]) $ \x -> Stream.fromPure x
-- [1,2]
--
-- == Fair Nested Looping
--
-- Multiple streams nest like @for@ loops. The result is a cross product of the
-- streams. However, the ordering of the results of the cross product is such
-- that each stream gets consumed equally. In other words, inner iterations of
-- a nested loop get the same priority as the outer iterations. Inner
-- iterations do not finish completely before the outer iterations start.
--
-- >>> :{
-- Stream.toList $ do
--     Stream.fairConcatFor (Stream.fromList [1,2,3]) $ \x ->
--      Stream.fairConcatFor (Stream.fromList [4,5,6]) $ \y ->
--       Stream.fromPure (x, y)
-- :}
-- [(1,4),(1,5),(2,4),(1,6),(2,5),(3,4),(2,6),(3,5),(3,6)]
--
-- == Nesting Infinite Streams
--
-- Example with infinite streams. Print all pairs in the cross product with sum
-- less than a specified number.
--
-- >>> :{
-- Stream.toList
--  $ Stream.takeWhile (\(x,y) -> x + y < 6)
--  $ Stream.fairConcatFor (Stream.fromList [1..]) $ \x ->
--     Stream.fairConcatFor (Stream.fromList [1..]) $ \y ->
--      Stream.fromPure (x, y)
-- :}
-- [(1,1),(1,2),(2,1),(1,3),(2,2),(3,1),(1,4),(2,3),(3,2),(4,1)]
--
-- == How the nesting works?
--
-- If we look at the cross product of [1,2,3], [4,5,6], the streams being
-- combined using 'fairConcatFor' are the following sequential loop iterations:
--
-- @
-- (1,4) (1,5) (1,6) -- first iteration of the outer loop
-- (2,4) (2,5) (2,6) -- second iteration of the outer loop
-- (3,4) (3,5) (3,6) -- third iteration of the outer loop
-- @
--
-- The result is a triangular or diagonal traversal of these iterations:
--
-- @
-- [(1,4),(1,5),(2,4),(1,6),(2,5),(3,4),(2,6),(3,5),(3,6)]
-- @
--
-- == Non-Termination Cases
--
-- If one of the two interleaved streams does not produce an output at all and
-- continues forever then the other stream will never get scheduled. This is
-- because a stream is unscheduled only after it produces an output. This can
-- lead to non-terminating programs, an example is provided below.
--
-- >>> :{
-- oddsIf x = Stream.fromList (if x then [1,3..] else [2,4..])
-- filterEven x = if even x then Stream.fromPure x else Stream.nil
-- :}
--
-- >>> :{
-- evens =
--     Stream.fairConcatFor (Stream.fromList [True,False]) $ \r ->
--      Stream.concatFor (oddsIf r) filterEven
-- :}
--
-- The @evens@ function does not terminate because, when r is True, the nested
-- 'concatFor' is a non-productive infinite loop, therefore, the outer loop
-- never gets a chance to generate the @False@ value.
--
-- But the following refactoring of the above code works as expected:
--
-- >>> :{
-- mixed =
--      Stream.fairConcatFor (Stream.fromList [True,False]) $ \r ->
--          Stream.concatFor (oddsIf r) Stream.fromPure
-- :}
--
-- >>> evens = Stream.fairConcatFor mixed filterEven
-- >>> Stream.toList $ Stream.take 3 $ evens
-- [2,4,6]
--
-- This works because in @mixed@ both the streams being interleaved are
-- productive.
--
-- Care should be taken how you write your program, keep in mind the scheduling
-- implications. To avoid such scheduling problems in serial interleaving, you
-- can use 'fairSchedFor' or concurrent scheduling i.e. parFairConcatFor. Due
-- to concurrent scheduling the other branch will make progress even if one is
-- an infinite loop producing nothing.
--
-- == Logic Programming
--
-- Streamly provides all operations for logic programming. It provides
-- functionality equivalent to 'LogicT' type from the 'logict' package.
-- The @MonadLogic@ operations can be implemented using the available stream
-- operations. For example, 'uncons' is @msplit@, 'interleave' corresponds to
-- the @interleave@ operation of MonadLogic, 'fairConcatFor' is the
-- fair bind (@>>-@) operation. 'fairSchedFor' is an even better alternative
-- for fair bind, it guarantees that non-productive infinite streams cannot
-- block progress.
--
-- == Related Operations
--
-- See also "Streamly.Internal.Data.StreamK.fairConcatFor".
--
{-# INLINE fairConcatFor #-}
fairConcatFor :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b
fairConcatFor :: forall (m :: * -> *) a b.
Monad m =>
Stream m a -> (a -> Stream m b) -> Stream m b
fairConcatFor = ((a -> Stream m b) -> Stream m a -> Stream m b)
-> Stream m a -> (a -> Stream m b) -> Stream m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> Stream m b) -> Stream m a -> Stream m b
forall (m :: * -> *) a b.
Monad m =>
(a -> Stream m b) -> Stream m a -> Stream m b
fairConcatMap

------------------------------------------------------------------------------
-- Combine N Streams - interpose
------------------------------------------------------------------------------

{-# ANN type InterposeSuffixState Fuse #-}
data InterposeSuffixState s1 i1 =
      InterposeSuffixFirst s1
    -- | InterposeSuffixFirstYield s1 i1
    | InterposeSuffixFirstInner s1 i1
    | InterposeSuffixSecond s1

-- XXX Note that if an unfolded layer turns out to be nil we still emit the
-- separator effect. An alternate behavior could be to emit the separator
-- effect only if at least one element has been yielded by the unfolding.
-- However, that becomes a bit complicated, so we have chosen the former
-- behavior for now.

-- | Monadic variant of 'unfoldEachEndBy'.
--
-- Definition:
--
-- >>> unfoldEachEndByM x = Stream.intercalateEndBy Unfold.identity (Stream.repeatM x)
--
{-# INLINE_NORMAL unfoldEachEndByM #-}
unfoldEachEndByM, interposeSuffixM :: Monad m =>
    m c -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachEndByM :: forall (m :: * -> *) c b.
Monad m =>
m c -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachEndByM
    m c
action
    (Unfold s -> m (Step s c)
istep1 b -> m s
inject1) (Stream State StreamK m b -> s -> m (Step s b)
step1 s
state1) =
    (State StreamK m c
 -> InterposeSuffixState s s
 -> m (Step (InterposeSuffixState s s) c))
-> InterposeSuffixState s s -> Stream m c
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m c
-> InterposeSuffixState s s
-> m (Step (InterposeSuffixState s s) c)
forall {m :: * -> *} {a}.
State StreamK m a
-> InterposeSuffixState s s
-> m (Step (InterposeSuffixState s s) c)
step (s -> InterposeSuffixState s s
forall s1 i1. s1 -> InterposeSuffixState s1 i1
InterposeSuffixFirst s
state1)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> InterposeSuffixState s s
-> m (Step (InterposeSuffixState s s) c)
step State StreamK m a
gst (InterposeSuffixFirst s
s1) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
step1 (State StreamK m a -> State StreamK m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s1
        case Step s b
r of
            Yield b
a s
s -> do
                s
i <- b -> m s
inject1 b
a
                s
i s
-> m (Step (InterposeSuffixState s s) c)
-> m (Step (InterposeSuffixState s s) c)
forall a b. a -> b -> b
`seq` Step (InterposeSuffixState s s) c
-> m (Step (InterposeSuffixState s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (InterposeSuffixState s s -> Step (InterposeSuffixState s s) c
forall s a. s -> Step s a
Skip (s -> s -> InterposeSuffixState s s
forall s1 i1. s1 -> i1 -> InterposeSuffixState s1 i1
InterposeSuffixFirstInner s
s s
i))
                -- i `seq` return (Skip (InterposeSuffixFirstYield s i))
            Skip s
s -> Step (InterposeSuffixState s s) c
-> m (Step (InterposeSuffixState s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterposeSuffixState s s) c
 -> m (Step (InterposeSuffixState s s) c))
-> Step (InterposeSuffixState s s) c
-> m (Step (InterposeSuffixState s s) c)
forall a b. (a -> b) -> a -> b
$ InterposeSuffixState s s -> Step (InterposeSuffixState s s) c
forall s a. s -> Step s a
Skip (s -> InterposeSuffixState s s
forall s1 i1. s1 -> InterposeSuffixState s1 i1
InterposeSuffixFirst s
s)
            Step s b
Stop -> Step (InterposeSuffixState s s) c
-> m (Step (InterposeSuffixState s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (InterposeSuffixState s s) c
forall s a. Step s a
Stop

    {-
    step _ (InterposeSuffixFirstYield s1 i1) = do
        r <- istep1 i1
        return $ case r of
            Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')
            Skip i'    -> Skip (InterposeSuffixFirstYield s1 i')
            Stop       -> Skip (InterposeSuffixFirst s1)
    -}

    step State StreamK m a
_ (InterposeSuffixFirstInner s
s1 s
i1) = do
        Step s c
r <- s -> m (Step s c)
istep1 s
i1
        Step (InterposeSuffixState s s) c
-> m (Step (InterposeSuffixState s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterposeSuffixState s s) c
 -> m (Step (InterposeSuffixState s s) c))
-> Step (InterposeSuffixState s s) c
-> m (Step (InterposeSuffixState s s) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Yield c
x s
i' -> c -> InterposeSuffixState s s -> Step (InterposeSuffixState s s) c
forall s a. a -> s -> Step s a
Yield c
x (s -> s -> InterposeSuffixState s s
forall s1 i1. s1 -> i1 -> InterposeSuffixState s1 i1
InterposeSuffixFirstInner s
s1 s
i')
            Skip s
i'    -> InterposeSuffixState s s -> Step (InterposeSuffixState s s) c
forall s a. s -> Step s a
Skip (s -> s -> InterposeSuffixState s s
forall s1 i1. s1 -> i1 -> InterposeSuffixState s1 i1
InterposeSuffixFirstInner s
s1 s
i')
            Step s c
Stop       -> InterposeSuffixState s s -> Step (InterposeSuffixState s s) c
forall s a. s -> Step s a
Skip (s -> InterposeSuffixState s s
forall s1 i1. s1 -> InterposeSuffixState s1 i1
InterposeSuffixSecond s
s1)

    step State StreamK m a
_ (InterposeSuffixSecond s
s1) = do
        c
r <- m c
action
        Step (InterposeSuffixState s s) c
-> m (Step (InterposeSuffixState s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterposeSuffixState s s) c
 -> m (Step (InterposeSuffixState s s) c))
-> Step (InterposeSuffixState s s) c
-> m (Step (InterposeSuffixState s s) c)
forall a b. (a -> b) -> a -> b
$ c -> InterposeSuffixState s s -> Step (InterposeSuffixState s s) c
forall s a. a -> s -> Step s a
Yield c
r (s -> InterposeSuffixState s s
forall s1 i1. s1 -> InterposeSuffixState s1 i1
InterposeSuffixFirst s
s1)

-- | Unfold the elements of a stream, append the given element after each
-- unfolded stream and then concat them into a single stream.
--
-- Definition:
--
-- >>> unfoldEachEndBy x = Stream.intercalateEndBy Unfold.identity (Stream.repeat x)
--
-- Usage:
--
-- >>> unlines = Stream.unfoldEachEndBy '\n'
--
-- /Pre-release/
{-# INLINE unfoldEachEndBy #-}
unfoldEachEndBy, interposeSuffix :: Monad m
    => c -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachEndBy :: forall (m :: * -> *) c b.
Monad m =>
c -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachEndBy c
x = m c -> Unfold m b c -> Stream m b -> Stream m c
forall (m :: * -> *) c b.
Monad m =>
m c -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachEndByM (c -> m c
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return c
x)

RENAME(interposeSuffix,unfoldEachEndBy)
RENAME(interposeSuffixM,unfoldEachEndByM)

{-# ANN type InterposeState Fuse #-}
data InterposeState s1 i1 a =
      InterposeFirst s1
    -- | InterposeFirstYield s1 i1
    | InterposeFirstInner s1 i1
    | InterposeFirstInject s1
    -- | InterposeFirstBuf s1 i1
    | InterposeSecondYield s1 i1
    -- -- | InterposeSecondYield s1 i1 a
    -- -- | InterposeFirstResume s1 i1 a

-- Note that this only interposes the pure values, we may run many effects to
-- generate those values as some effects may not generate anything (Skip).

-- | Monadic variant of 'unfoldEachSepBy'.
--
-- Definition:
--
-- >>> unfoldEachSepByM x = Stream.intercalateSepBy Unfold.identity (Stream.repeatM x)
--
{-# INLINE_NORMAL unfoldEachSepByM #-}
unfoldEachSepByM, interposeM :: Monad m =>
    m c -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachSepByM :: forall (m :: * -> *) c b.
Monad m =>
m c -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachSepByM
    m c
action
    (Unfold s -> m (Step s c)
istep1 b -> m s
inject1) (Stream State StreamK m b -> s -> m (Step s b)
step1 s
state1) =
    (State StreamK m c
 -> InterposeState s s Any -> m (Step (InterposeState s s Any) c))
-> InterposeState s s Any -> Stream m c
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m c
-> InterposeState s s Any -> m (Step (InterposeState s s Any) c)
forall {m :: * -> *} {a} {a} {a}.
State StreamK m a
-> InterposeState s s a -> m (Step (InterposeState s s a) c)
step (s -> InterposeState s s Any
forall s1 i1 a. s1 -> InterposeState s1 i1 a
InterposeFirst s
state1)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> InterposeState s s a -> m (Step (InterposeState s s a) c)
step State StreamK m a
gst (InterposeFirst s
s1) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
step1 (State StreamK m a -> State StreamK m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s1
        case Step s b
r of
            Yield b
a s
s -> do
                s
i <- b -> m s
inject1 b
a
                s
i s
-> m (Step (InterposeState s s a) c)
-> m (Step (InterposeState s s a) c)
forall a b. a -> b -> b
`seq` Step (InterposeState s s a) c -> m (Step (InterposeState s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (InterposeState s s a -> Step (InterposeState s s a) c
forall s a. s -> Step s a
Skip (s -> s -> InterposeState s s a
forall s1 i1 a. s1 -> i1 -> InterposeState s1 i1 a
InterposeFirstInner s
s s
i))
                -- i `seq` return (Skip (InterposeFirstYield s i))
            Skip s
s -> Step (InterposeState s s a) c -> m (Step (InterposeState s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterposeState s s a) c
 -> m (Step (InterposeState s s a) c))
-> Step (InterposeState s s a) c
-> m (Step (InterposeState s s a) c)
forall a b. (a -> b) -> a -> b
$ InterposeState s s a -> Step (InterposeState s s a) c
forall s a. s -> Step s a
Skip (s -> InterposeState s s a
forall s1 i1 a. s1 -> InterposeState s1 i1 a
InterposeFirst s
s)
            Step s b
Stop -> Step (InterposeState s s a) c -> m (Step (InterposeState s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (InterposeState s s a) c
forall s a. Step s a
Stop

    {-
    step _ (InterposeFirstYield s1 i1) = do
        r <- istep1 i1
        return $ case r of
            Yield x i' -> Yield x (InterposeFirstInner s1 i')
            Skip i'    -> Skip (InterposeFirstYield s1 i')
            Stop       -> Skip (InterposeFirst s1)
    -}

    step State StreamK m a
_ (InterposeFirstInner s
s1 s
i1) = do
        Step s c
r <- s -> m (Step s c)
istep1 s
i1
        Step (InterposeState s s a) c -> m (Step (InterposeState s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterposeState s s a) c
 -> m (Step (InterposeState s s a) c))
-> Step (InterposeState s s a) c
-> m (Step (InterposeState s s a) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Yield c
x s
i' -> c -> InterposeState s s a -> Step (InterposeState s s a) c
forall s a. a -> s -> Step s a
Yield c
x (s -> s -> InterposeState s s a
forall s1 i1 a. s1 -> i1 -> InterposeState s1 i1 a
InterposeFirstInner s
s1 s
i')
            Skip s
i'    -> InterposeState s s a -> Step (InterposeState s s a) c
forall s a. s -> Step s a
Skip (s -> s -> InterposeState s s a
forall s1 i1 a. s1 -> i1 -> InterposeState s1 i1 a
InterposeFirstInner s
s1 s
i')
            Step s c
Stop       -> InterposeState s s a -> Step (InterposeState s s a) c
forall s a. s -> Step s a
Skip (s -> InterposeState s s a
forall s1 i1 a. s1 -> InterposeState s1 i1 a
InterposeFirstInject s
s1)

    step State StreamK m a
gst (InterposeFirstInject s
s1) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
step1 (State StreamK m a -> State StreamK m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s1
        case Step s b
r of
            Yield b
a s
s -> do
                s
i <- b -> m s
inject1 b
a
                -- i `seq` return (Skip (InterposeFirstBuf s i))
                s
i s
-> m (Step (InterposeState s s a) c)
-> m (Step (InterposeState s s a) c)
forall a b. a -> b -> b
`seq` Step (InterposeState s s a) c -> m (Step (InterposeState s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (InterposeState s s a -> Step (InterposeState s s a) c
forall s a. s -> Step s a
Skip (s -> s -> InterposeState s s a
forall s1 i1 a. s1 -> i1 -> InterposeState s1 i1 a
InterposeSecondYield s
s s
i))
            Skip s
s -> Step (InterposeState s s a) c -> m (Step (InterposeState s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterposeState s s a) c
 -> m (Step (InterposeState s s a) c))
-> Step (InterposeState s s a) c
-> m (Step (InterposeState s s a) c)
forall a b. (a -> b) -> a -> b
$ InterposeState s s a -> Step (InterposeState s s a) c
forall s a. s -> Step s a
Skip (s -> InterposeState s s a
forall s1 i1 a. s1 -> InterposeState s1 i1 a
InterposeFirstInject s
s)
            Step s b
Stop -> Step (InterposeState s s a) c -> m (Step (InterposeState s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (InterposeState s s a) c
forall s a. Step s a
Stop

    {-
    step _ (InterposeFirstBuf s1 i1) = do
        r <- istep1 i1
        return $ case r of
            Yield x i' -> Skip (InterposeSecondYield s1 i' x)
            Skip i'    -> Skip (InterposeFirstBuf s1 i')
            Stop       -> Stop
    -}

    {-
    step _ (InterposeSecondYield s1 i1 v) = do
        r <- action
        return $ Yield r (InterposeFirstResume s1 i1 v)
    -}
    step State StreamK m a
_ (InterposeSecondYield s
s1 s
i1) = do
        c
r <- m c
action
        Step (InterposeState s s a) c -> m (Step (InterposeState s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterposeState s s a) c
 -> m (Step (InterposeState s s a) c))
-> Step (InterposeState s s a) c
-> m (Step (InterposeState s s a) c)
forall a b. (a -> b) -> a -> b
$ c -> InterposeState s s a -> Step (InterposeState s s a) c
forall s a. a -> s -> Step s a
Yield c
r (s -> s -> InterposeState s s a
forall s1 i1 a. s1 -> i1 -> InterposeState s1 i1 a
InterposeFirstInner s
s1 s
i1)

    {-
    step _ (InterposeFirstResume s1 i1 v) = do
        return $ Yield v (InterposeFirstInner s1 i1)
    -}

-- | Unfold the elements of a stream, intersperse the given element between the
-- unfolded streams and then concat them into a single stream.
--
-- Definition:
--
-- >>> unfoldEachSepBy x = Stream.unfoldEachSepByM (return x)
-- >>> unfoldEachSepBy x = Stream.intercalateSepBy Unfold.identity (Stream.repeat x)
--
-- Usage:
--
-- >>> unwords = Stream.unfoldEachSepBy ' '
--
-- /Pre-release/
{-# INLINE unfoldEachSepBy #-}
unfoldEachSepBy, interpose :: Monad m
    => c -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachSepBy :: forall (m :: * -> *) c b.
Monad m =>
c -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachSepBy c
x = m c -> Unfold m b c -> Stream m b -> Stream m c
forall (m :: * -> *) c b.
Monad m =>
m c -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachSepByM (c -> m c
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return c
x)

RENAME(interposeM,unfoldEachSepByM)
RENAME(interpose,unfoldEachSepBy)

------------------------------------------------------------------------------
-- Combine N Streams - intercalate
------------------------------------------------------------------------------

data ICUState s1 s2 i1 i2 =
      ICUFirst s1 s2
    | ICUSecond s1 s2
    | ICUSecondOnly s2
    | ICUFirstOnly s1
    | ICUFirstInner s1 s2 i1
    | ICUSecondInner s1 s2 i2
    | ICUFirstOnlyInner s1 i1
    | ICUSecondOnlyInner s2 i2

-- | See 'intercalateSepBy' for detailed documentation.
--
-- You can think of this as 'interleaveEndBy' on the stream of streams followed
-- by concat. Same as the following but more efficient:
--
-- >>> intercalateEndBy u1 s1 u2 s2 = Stream.concat $ Stream.interleaveEndBy (fmap (Stream.unfold u1) s1) (fmap (Stream.unfold u2) s2)
--
-- /Pre-release/
{-# INLINE_NORMAL intercalateEndBy #-}
intercalateEndBy :: Monad m =>
       Unfold m a c -> Stream m a
    -> Unfold m b c -> Stream m b
    -> Stream m c
intercalateEndBy :: forall (m :: * -> *) a c b.
Monad m =>
Unfold m a c
-> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
intercalateEndBy
    (Unfold s -> m (Step s c)
istep2 a -> m s
inject2) (Stream State StreamK m a -> s -> m (Step s a)
step2 s
state2)
    (Unfold s -> m (Step s c)
istep1 b -> m s
inject1) (Stream State StreamK m b -> s -> m (Step s b)
step1 s
state1) =
    (State StreamK m c
 -> ICUState s s s s -> m (Step (ICUState s s s s) c))
-> ICUState s s s s -> Stream m c
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m c
-> ICUState s s s s -> m (Step (ICUState s s s s) c)
forall {m :: * -> *} {a}.
State StreamK m a
-> ICUState s s s s -> m (Step (ICUState s s s s) c)
step (s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> ICUState s1 s2 i1 i2
ICUFirst s
state1 s
state2)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> ICUState s s s s -> m (Step (ICUState s s s s) c)
step State StreamK m a
gst (ICUFirst s
s1 s
s2) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
step1 (State StreamK m a -> State StreamK m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s1
        case Step s b
r of
            Yield b
a s
s -> do
                s
i <- b -> m s
inject1 b
a
                s
i s -> m (Step (ICUState s s s s) c) -> m (Step (ICUState s s s s) c)
forall a b. a -> b -> b
`seq` Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> i1 -> ICUState s1 s2 i1 i2
ICUFirstInner s
s s
s2 s
i))
            Skip s
s -> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c))
-> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a b. (a -> b) -> a -> b
$ ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> ICUState s1 s2 i1 i2
ICUFirst s
s s
s2)
            Step s b
Stop -> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ICUState s s s s) c
forall s a. Step s a
Stop

    step State StreamK m a
gst (ICUFirstOnly s
s1) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
step1 (State StreamK m a -> State StreamK m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s1
        case Step s b
r of
            Yield b
a s
s -> do
                s
i <- b -> m s
inject1 b
a
                s
i s -> m (Step (ICUState s s s s) c) -> m (Step (ICUState s s s s) c)
forall a b. a -> b -> b
`seq` Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> i1 -> ICUState s1 s2 i1 i2
ICUFirstOnlyInner s
s s
i))
            Skip s
s -> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c))
-> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a b. (a -> b) -> a -> b
$ ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> ICUState s1 s2 i1 i2
ICUFirstOnly s
s)
            Step s b
Stop -> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ICUState s s s s) c
forall s a. Step s a
Stop

    step State StreamK m a
_ (ICUFirstInner s
s1 s
s2 s
i1) = do
        Step s c
r <- s -> m (Step s c)
istep1 s
i1
        Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c))
-> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Yield c
x s
i' -> c -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. a -> s -> Step s a
Yield c
x (s -> s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> i1 -> ICUState s1 s2 i1 i2
ICUFirstInner s
s1 s
s2 s
i')
            Skip s
i'    -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> i1 -> ICUState s1 s2 i1 i2
ICUFirstInner s
s1 s
s2 s
i')
            Step s c
Stop       -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> ICUState s1 s2 i1 i2
ICUSecond s
s1 s
s2)

    step State StreamK m a
_ (ICUFirstOnlyInner s
s1 s
i1) = do
        Step s c
r <- s -> m (Step s c)
istep1 s
i1
        Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c))
-> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Yield c
x s
i' -> c -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. a -> s -> Step s a
Yield c
x (s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> i1 -> ICUState s1 s2 i1 i2
ICUFirstOnlyInner s
s1 s
i')
            Skip s
i'    -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> i1 -> ICUState s1 s2 i1 i2
ICUFirstOnlyInner s
s1 s
i')
            Step s c
Stop       -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> ICUState s1 s2 i1 i2
ICUFirstOnly s
s1)

    step State StreamK m a
gst (ICUSecond s
s1 s
s2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step2 (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s2
        case Step s a
r of
            Yield a
a s
s -> do
                s
i <- a -> m s
inject2 a
a
                s
i s -> m (Step (ICUState s s s s) c) -> m (Step (ICUState s s s s) c)
forall a b. a -> b -> b
`seq` Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> i2 -> ICUState s1 s2 i1 i2
ICUSecondInner s
s1 s
s s
i))
            Skip s
s -> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c))
-> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a b. (a -> b) -> a -> b
$ ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> ICUState s1 s2 i1 i2
ICUSecond s
s1 s
s)
            Step s a
Stop -> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c))
-> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a b. (a -> b) -> a -> b
$ ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> ICUState s1 s2 i1 i2
ICUFirstOnly s
s1)

    step State StreamK m a
_ (ICUSecondInner s
s1 s
s2 s
i2) = do
        Step s c
r <- s -> m (Step s c)
istep2 s
i2
        Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c))
-> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Yield c
x s
i' -> c -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. a -> s -> Step s a
Yield c
x (s -> s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> i2 -> ICUState s1 s2 i1 i2
ICUSecondInner s
s1 s
s2 s
i')
            Skip s
i'    -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> i2 -> ICUState s1 s2 i1 i2
ICUSecondInner s
s1 s
s2 s
i')
            Step s c
Stop       -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> ICUState s1 s2 i1 i2
ICUFirst s
s1 s
s2)

    step State StreamK m a
_ (ICUSecondOnly s
_s2) = m (Step (ICUState s s s s) c)
forall a. HasCallStack => a
undefined
    step State StreamK m a
_ (ICUSecondOnlyInner s
_s2 s
_i2) = m (Step (ICUState s s s s) c)
forall a. HasCallStack => a
undefined

-- |
--
-- >>> gintercalateSuffix u1 s1 u2 s2 = Stream.intercalateEndBy u2 s2 u1 s1
--
{-# DEPRECATED gintercalateSuffix "Please use intercalateEndBy instead. Note the change in argument order." #-}
{-# INLINE gintercalateSuffix #-}
gintercalateSuffix
    :: Monad m
    => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
gintercalateSuffix :: forall (m :: * -> *) a c b.
Monad m =>
Unfold m a c
-> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
gintercalateSuffix Unfold m a c
u1 Stream m a
s1 Unfold m b c
u2 Stream m b
s2 = Unfold m b c
-> Stream m b -> Unfold m a c -> Stream m a -> Stream m c
forall (m :: * -> *) a c b.
Monad m =>
Unfold m a c
-> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
intercalateEndBy Unfold m b c
u2 Stream m b
s2 Unfold m a c
u1 Stream m a
s1

data ICALState s1 s2 i1 i2 a =
      ICALFirst s1 s2
    -- | ICALFirstYield s1 s2 i1
    | ICALFirstInner s1 s2 i1
    | ICALFirstOnly s1
    | ICALFirstOnlyInner s1 i1
    | ICALSecondInject s1 s2
    | ICALFirstInject s1 s2 i2
    -- | ICALFirstBuf s1 s2 i1 i2
    | ICALSecondInner s1 s2 i1 i2
    -- -- | ICALSecondInner s1 s2 i1 i2 a
    -- -- | ICALFirstResume s1 s2 i1 i2 a

-- | The first stream @Stream m b@ is turned into a stream of streams by
-- unfolding each element using the first unfold, similarly @Stream m a@ is
-- also turned into a stream of streams.  The second stream of streams is
-- interspersed with the streams from the first stream in an infix manner and
-- then the resulting stream is flattened.
--
-- You can think of this as 'interleaveSepBy' on the stream of streams followed
-- by concat. Same as the following but more efficient:
--
-- >>> intercalateSepBy u1 s1 u2 s2 = Stream.concat $ Stream.interleaveSepBy (fmap (Stream.unfold u1) s1) (fmap (Stream.unfold u2) s2)
--
-- If the separator stream consists of nil streams then it becomes equivalent
-- to 'unfoldEach':
--
-- >>> unfoldEach = Stream.intercalateSepBy (Unfold.nilM (const (return ()))) (Stream.repeat ())
--
-- /Pre-release/
{-# INLINE_NORMAL intercalateSepBy #-}
intercalateSepBy
    :: Monad m
    => Unfold m b c -> Stream m b
    -> Unfold m a c -> Stream m a
    -> Stream m c
{-
intercalateSepBy u1 s1 u2 s2 =
    Stream.concat $ interleaveSepBy (fmap (unfold u1) s1) (fmap (unfold u2) s2)
-}
intercalateSepBy :: forall (m :: * -> *) a c b.
Monad m =>
Unfold m a c
-> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
intercalateSepBy
    (Unfold s -> m (Step s c)
istep2 b -> m s
inject2) (Stream State StreamK m b -> s -> m (Step s b)
step2 s
state2)
    (Unfold s -> m (Step s c)
istep1 a -> m s
inject1) (Stream State StreamK m a -> s -> m (Step s a)
step1 s
state1) =
    (State StreamK m c
 -> ICALState s s s s Any -> m (Step (ICALState s s s s Any) c))
-> ICALState s s s s Any -> Stream m c
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m c
-> ICALState s s s s Any -> m (Step (ICALState s s s s Any) c)
forall {m :: * -> *} {a} {a} {a}.
State StreamK m a
-> ICALState s s s s a -> m (Step (ICALState s s s s a) c)
step (s -> s -> ICALState s s s s Any
forall s1 s2 i1 i2 a. s1 -> s2 -> ICALState s1 s2 i1 i2 a
ICALFirst s
state1 s
state2)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> ICALState s s s s a -> m (Step (ICALState s s s s a) c)
step State StreamK m a
gst (ICALFirst s
s1 s
s2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s1
        case Step s a
r of
            Yield a
a s
s -> do
                s
i <- a -> m s
inject1 a
a
                s
i s
-> m (Step (ICALState s s s s a) c)
-> m (Step (ICALState s s s s a) c)
forall a b. a -> b -> b
`seq` Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> s2 -> i1 -> ICALState s1 s2 i1 i2 a
ICALFirstInner s
s s
s2 s
i))
                -- i `seq` return (Skip (ICALFirstYield s s2 i))
            Skip s
s -> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c))
-> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a b. (a -> b) -> a -> b
$ ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> s2 -> ICALState s1 s2 i1 i2 a
ICALFirst s
s s
s2)
            Step s a
Stop -> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ICALState s s s s a) c
forall s a. Step s a
Stop

    {-
    step _ (ICALFirstYield s1 s2 i1) = do
        r <- istep1 i1
        return $ case r of
            Yield x i' -> Yield x (ICALFirstInner s1 s2 i')
            Skip i'    -> Skip (ICALFirstYield s1 s2 i')
            Stop       -> Skip (ICALFirst s1 s2)
    -}

    step State StreamK m a
_ (ICALFirstInner s
s1 s
s2 s
i1) = do
        Step s c
r <- s -> m (Step s c)
istep1 s
i1
        Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c))
-> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Yield c
x s
i' -> c -> ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. a -> s -> Step s a
Yield c
x (s -> s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> s2 -> i1 -> ICALState s1 s2 i1 i2 a
ICALFirstInner s
s1 s
s2 s
i')
            Skip s
i'    -> ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> s2 -> i1 -> ICALState s1 s2 i1 i2 a
ICALFirstInner s
s1 s
s2 s
i')
            Step s c
Stop       -> ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> s2 -> ICALState s1 s2 i1 i2 a
ICALSecondInject s
s1 s
s2)

    step State StreamK m a
gst (ICALFirstOnly s
s1) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s1
        case Step s a
r of
            Yield a
a s
s -> do
                s
i <- a -> m s
inject1 a
a
                s
i s
-> m (Step (ICALState s s s s a) c)
-> m (Step (ICALState s s s s a) c)
forall a b. a -> b -> b
`seq` Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> i1 -> ICALState s1 s2 i1 i2 a
ICALFirstOnlyInner s
s s
i))
            Skip s
s -> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c))
-> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a b. (a -> b) -> a -> b
$ ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> ICALState s1 s2 i1 i2 a
ICALFirstOnly s
s)
            Step s a
Stop -> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ICALState s s s s a) c
forall s a. Step s a
Stop

    step State StreamK m a
_ (ICALFirstOnlyInner s
s1 s
i1) = do
        Step s c
r <- s -> m (Step s c)
istep1 s
i1
        Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c))
-> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Yield c
x s
i' -> c -> ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. a -> s -> Step s a
Yield c
x (s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> i1 -> ICALState s1 s2 i1 i2 a
ICALFirstOnlyInner s
s1 s
i')
            Skip s
i'    -> ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> i1 -> ICALState s1 s2 i1 i2 a
ICALFirstOnlyInner s
s1 s
i')
            Step s c
Stop       -> ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> ICALState s1 s2 i1 i2 a
ICALFirstOnly s
s1)

    -- We inject the second stream even before checking if the first stream
    -- would yield any more elements. There is no clear choice whether we
    -- should do this before or after that. Doing it after may make the state
    -- machine a bit simpler though.
    step State StreamK m a
gst (ICALSecondInject s
s1 s
s2) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
step2 (State StreamK m a -> State StreamK m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s2
        case Step s b
r of
            Yield b
a s
s -> do
                s
i <- b -> m s
inject2 b
a
                s
i s
-> m (Step (ICALState s s s s a) c)
-> m (Step (ICALState s s s s a) c)
forall a b. a -> b -> b
`seq` Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> s2 -> i2 -> ICALState s1 s2 i1 i2 a
ICALFirstInject s
s1 s
s s
i))
            Skip s
s -> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c))
-> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a b. (a -> b) -> a -> b
$ ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> s2 -> ICALState s1 s2 i1 i2 a
ICALSecondInject s
s1 s
s)
            Step s b
Stop -> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c))
-> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a b. (a -> b) -> a -> b
$ ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> ICALState s1 s2 i1 i2 a
ICALFirstOnly s
s1)

    step State StreamK m a
gst (ICALFirstInject s
s1 s
s2 s
i2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s1
        case Step s a
r of
            Yield a
a s
s -> do
                s
i <- a -> m s
inject1 a
a
                s
i s
-> m (Step (ICALState s s s s a) c)
-> m (Step (ICALState s s s s a) c)
forall a b. a -> b -> b
`seq` Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> s -> s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a.
s1 -> s2 -> i1 -> i2 -> ICALState s1 s2 i1 i2 a
ICALSecondInner s
s s
s2 s
i s
i2))
                -- i `seq` return (Skip (ICALFirstBuf s s2 i i2))
            Skip s
s -> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c))
-> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a b. (a -> b) -> a -> b
$ ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> s2 -> i2 -> ICALState s1 s2 i1 i2 a
ICALFirstInject s
s s
s2 s
i2)
            Step s a
Stop -> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ICALState s s s s a) c
forall s a. Step s a
Stop

    {-
    step _ (ICALFirstBuf s1 s2 i1 i2) = do
        r <- istep1 i1
        return $ case r of
            Yield x i' -> Skip (ICALSecondInner s1 s2 i' i2 x)
            Skip i'    -> Skip (ICALFirstBuf s1 s2 i' i2)
            Stop       -> Stop

    step _ (ICALSecondInner s1 s2 i1 i2 v) = do
        r <- istep2 i2
        return $ case r of
            Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i' v)
            Skip i'    -> Skip (ICALSecondInner s1 s2 i1 i' v)
            Stop       -> Skip (ICALFirstResume s1 s2 i1 i2 v)
    -}

    step State StreamK m a
_ (ICALSecondInner s
s1 s
s2 s
i1 s
i2) = do
        Step s c
r <- s -> m (Step s c)
istep2 s
i2
        Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c))
-> Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Yield c
x s
i' -> c -> ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. a -> s -> Step s a
Yield c
x (s -> s -> s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a.
s1 -> s2 -> i1 -> i2 -> ICALState s1 s2 i1 i2 a
ICALSecondInner s
s1 s
s2 s
i1 s
i')
            Skip s
i'    -> ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> s -> s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a.
s1 -> s2 -> i1 -> i2 -> ICALState s1 s2 i1 i2 a
ICALSecondInner s
s1 s
s2 s
i1 s
i')
            Step s c
Stop       -> ICALState s s s s a -> Step (ICALState s s s s a) c
forall s a. s -> Step s a
Skip (s -> s -> s -> ICALState s s s s a
forall s1 s2 i1 i2 a. s1 -> s2 -> i1 -> ICALState s1 s2 i1 i2 a
ICALFirstInner s
s1 s
s2 s
i1)
            -- Stop       -> Skip (ICALFirstResume s1 s2 i1 i2)

    {-
    step _ (ICALFirstResume s1 s2 i1 i2 x) = do
        return $ Yield x (ICALFirstInner s1 s2 i1 i2)
    -}

-- |
--
-- >>> gintercalate u1 s1 u2 s2 = Stream.intercalateSepBy u2 s2 u1 s1
--
{-# DEPRECATED gintercalate "Please use intercalateSepBy instead." #-}
{-# INLINE gintercalate #-}
gintercalate :: Monad m =>
    Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
gintercalate :: forall (m :: * -> *) a c b.
Monad m =>
Unfold m a c
-> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
gintercalate Unfold m a c
u1 Stream m a
s1 Unfold m b c
u2 Stream m b
s2 = Unfold m b c
-> Stream m b -> Unfold m a c -> Stream m a -> Stream m c
forall (m :: * -> *) a c b.
Monad m =>
Unfold m a c
-> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
intercalateSepBy Unfold m b c
u2 Stream m b
s2 Unfold m a c
u1 Stream m a
s1

-- | Unfold each element of the stream, end each unfold by a sequence generated
-- by unfolding the supplied value.
--
-- Definition:
--
-- >>> unfoldEachEndBySeq a u = Stream.unfoldEach u . Stream.intersperseEndByM a
-- >>> unfoldEachEndBySeq a u = Stream.intercalateEndBy u (Stream.repeat a) u
--
-- Idioms:
--
-- >>> intersperseEndByM x = Stream.unfoldEachEndBySeq x Unfold.identity
-- >>> unlines = Stream.unfoldEachEndBySeq "\n" Unfold.fromList
--
-- Usage:
--
-- >>> input = Stream.fromList ["abc", "def", "ghi"]
-- >>> Stream.toList $ Stream.unfoldEachEndBySeq "\n" Unfold.fromList input
-- "abc\ndef\nghi\n"
--
{-# INLINE unfoldEachEndBySeq #-}
unfoldEachEndBySeq :: Monad m
    => b -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachEndBySeq :: forall (m :: * -> *) b c.
Monad m =>
b -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachEndBySeq b
seed Unfold m b c
unf = Unfold m b c -> Stream m b -> Stream m c
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
unfoldEach Unfold m b c
unf (Stream m b -> Stream m c)
-> (Stream m b -> Stream m b) -> Stream m b -> Stream m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> Stream m b -> Stream m b
forall (m :: * -> *) a. Monad m => m a -> Stream m a -> Stream m a
intersperseEndByM (b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
seed)

{-# DEPRECATED intercalateSuffix "Please use unfoldEachEndBySeq instead." #-}
{-# INLINE intercalateSuffix #-}
intercalateSuffix :: Monad m
    => Unfold m b c -> b -> Stream m b -> Stream m c
intercalateSuffix :: forall (m :: * -> *) b c.
Monad m =>
Unfold m b c -> b -> Stream m b -> Stream m c
intercalateSuffix Unfold m b c
u b
x = b -> Unfold m b c -> Stream m b -> Stream m c
forall (m :: * -> *) b c.
Monad m =>
b -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachEndBySeq b
x Unfold m b c
u

-- | Unfold each element of the stream, separate the successive unfolds by a
-- sequence generated by unfolding the supplied value.
--
-- Definition:
--
-- >>> unfoldEachSepBySeq a u = Stream.unfoldEach u . Stream.intersperse a
-- >>> unfoldEachSepBySeq a u = Stream.intercalateSepBy u (Stream.repeat a) u
--
-- Idioms:
--
-- >>> intersperse x = Stream.unfoldEachSepBySeq x Unfold.identity
-- >>> unwords = Stream.unfoldEachSepBySeq " " Unfold.fromList
--
-- Usage:
--
-- >>> input = Stream.fromList ["abc", "def", "ghi"]
-- >>> Stream.toList $ Stream.unfoldEachSepBySeq " " Unfold.fromList input
-- "abc def ghi"
--
{-# INLINE unfoldEachSepBySeq #-}
unfoldEachSepBySeq :: Monad m
    => b -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachSepBySeq :: forall (m :: * -> *) b c.
Monad m =>
b -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachSepBySeq b
seed Unfold m b c
unf Stream m b
str = Unfold m b c -> Stream m b -> Stream m c
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
unfoldEach Unfold m b c
unf (Stream m b -> Stream m c) -> Stream m b -> Stream m c
forall a b. (a -> b) -> a -> b
$ b -> Stream m b -> Stream m b
forall (m :: * -> *) a. Monad m => a -> Stream m a -> Stream m a
intersperse b
seed Stream m b
str

{-# DEPRECATED intercalate "Please use unfoldEachSepBySeq instead." #-}
{-# INLINE intercalate #-}
intercalate :: Monad m
    => Unfold m b c -> b -> Stream m b -> Stream m c
intercalate :: forall (m :: * -> *) b c.
Monad m =>
Unfold m b c -> b -> Stream m b -> Stream m c
intercalate Unfold m b c
u b
x = b -> Unfold m b c -> Stream m b -> Stream m c
forall (m :: * -> *) b c.
Monad m =>
b -> Unfold m b c -> Stream m b -> Stream m c
unfoldEachSepBySeq b
x Unfold m b c
u

------------------------------------------------------------------------------
-- Folding
------------------------------------------------------------------------------

-- | Apply a stream of folds to an input stream and emit the results in the
-- output stream.
--
-- /Unimplemented/
--
{-# INLINE foldSequence #-}
foldSequence
       :: -- Monad m =>
       Stream m (Fold m a b)
    -> Stream m a
    -> Stream m b
foldSequence :: forall (m :: * -> *) a b.
Stream m (Fold m a b) -> Stream m a -> Stream m b
foldSequence Stream m (Fold m a b)
_f Stream m a
_m = Stream m b
forall a. HasCallStack => a
undefined

{-# ANN type FIterState Fuse #-}
data FIterState s f m a b
    = FIterInit s f
    | forall fs. FIterStream s (fs -> a -> m (FL.Step fs b)) fs (fs -> m b)
        (fs -> m b)
    | FIterYield b (FIterState s f m a b)
    | FIterStop

-- | Iterate a fold generator on a stream. The initial value @b@ is used to
-- generate the first fold, the fold is applied on the stream and the result of
-- the fold is used to generate the next fold and so on.
--
-- Usage:
--
-- >>> import Data.Monoid (Sum(..))
-- >>> f x = return (Fold.take 2 (Fold.sconcat x))
-- >>> s = fmap Sum $ Stream.fromList [1..10]
-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.foldIterateM f (pure 0) s
-- [3,10,21,36,55,55]
--
-- This is the streaming equivalent of monad like sequenced application of
-- folds where next fold is dependent on the previous fold.
--
-- /Pre-release/
--
{-# INLINE_NORMAL foldIterateM #-}
foldIterateM ::
       Monad m => (b -> m (FL.Fold m a b)) -> m b -> Stream m a -> Stream m b
foldIterateM :: forall (m :: * -> *) b a.
Monad m =>
(b -> m (Fold m a b)) -> m b -> Stream m a -> Stream m b
foldIterateM b -> m (Fold m a b)
func m b
seed0 (Stream State StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m b
 -> FIterState s (m b) m a b
 -> m (Step (FIterState s (m b) m a b) b))
-> FIterState s (m b) m a b -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> FIterState s (m b) m a b
-> m (Step (FIterState s (m b) m a b) b)
forall {m :: * -> *} {a}.
State StreamK m a
-> FIterState s (m b) m a b
-> m (Step (FIterState s (m b) m a b) b)
stepOuter (s -> m b -> FIterState s (m b) m a b
forall s f (m :: * -> *) a b. s -> f -> FIterState s f m a b
FIterInit s
state m b
seed0)

    where

    {-# INLINE iterStep #-}
    iterStep :: m (Step fs a)
-> s
-> (fs -> a -> m (Step fs a))
-> (fs -> m a)
-> (fs -> m a)
-> m (Step (FIterState s (m a) m a a) a)
iterStep m (Step fs a)
from s
st fs -> a -> m (Step fs a)
fstep fs -> m a
extract fs -> m a
final = do
        Step fs a
res <- m (Step fs a)
from
        Step (FIterState s (m a) m a a) a
-> m (Step (FIterState s (m a) m a a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (FIterState s (m a) m a a) a
 -> m (Step (FIterState s (m a) m a a) a))
-> Step (FIterState s (m a) m a a) a
-> m (Step (FIterState s (m a) m a a) a)
forall a b. (a -> b) -> a -> b
$ FIterState s (m a) m a a -> Step (FIterState s (m a) m a a) a
forall s a. s -> Step s a
Skip
            (FIterState s (m a) m a a -> Step (FIterState s (m a) m a a) a)
-> FIterState s (m a) m a a -> Step (FIterState s (m a) m a a) a
forall a b. (a -> b) -> a -> b
$ case Step fs a
res of
                  FL.Partial fs
fs -> s
-> (fs -> a -> m (Step fs a))
-> fs
-> (fs -> m a)
-> (fs -> m a)
-> FIterState s (m a) m a a
forall s f (m :: * -> *) a b fs.
s
-> (fs -> a -> m (Step fs b))
-> fs
-> (fs -> m b)
-> (fs -> m b)
-> FIterState s f m a b
FIterStream s
st fs -> a -> m (Step fs a)
fstep fs
fs fs -> m a
extract fs -> m a
final
                  FL.Done a
fb -> a -> FIterState s (m a) m a a -> FIterState s (m a) m a a
forall s f (m :: * -> *) a b.
b -> FIterState s f m a b -> FIterState s f m a b
FIterYield a
fb (FIterState s (m a) m a a -> FIterState s (m a) m a a)
-> FIterState s (m a) m a a -> FIterState s (m a) m a a
forall a b. (a -> b) -> a -> b
$ s -> m a -> FIterState s (m a) m a a
forall s f (m :: * -> *) a b. s -> f -> FIterState s f m a b
FIterInit s
st (a -> m a
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
fb)

    {-# INLINE_LATE stepOuter #-}
    stepOuter :: State StreamK m a
-> FIterState s (m b) m a b
-> m (Step (FIterState s (m b) m a b) b)
stepOuter State StreamK m a
_ (FIterInit s
st m b
seed) = do
        (FL.Fold s -> a -> m (Step s b)
fstep m (Step s b)
initial s -> m b
extract s -> m b
final) <- m b
seed m b -> (b -> m (Fold m a b)) -> m (Fold m a b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m (Fold m a b)
func
        m (Step s b)
-> s
-> (s -> a -> m (Step s b))
-> (s -> m b)
-> (s -> m b)
-> m (Step (FIterState s (m b) m a b) b)
forall {m :: * -> *} {m :: * -> *} {fs} {a} {s} {a} {m :: * -> *}
       {a}.
(Monad m, Monad m) =>
m (Step fs a)
-> s
-> (fs -> a -> m (Step fs a))
-> (fs -> m a)
-> (fs -> m a)
-> m (Step (FIterState s (m a) m a a) a)
iterStep m (Step s b)
initial s
st s -> a -> m (Step s b)
fstep s -> m b
extract s -> m b
final
    stepOuter State StreamK m a
gst (FIterStream s
st fs -> a -> m (Step fs b)
fstep fs
fs fs -> m b
extract fs -> m b
final) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
r of
            Yield a
x s
s -> do
                m (Step fs b)
-> s
-> (fs -> a -> m (Step fs b))
-> (fs -> m b)
-> (fs -> m b)
-> m (Step (FIterState s (m b) m a b) b)
forall {m :: * -> *} {m :: * -> *} {fs} {a} {s} {a} {m :: * -> *}
       {a}.
(Monad m, Monad m) =>
m (Step fs a)
-> s
-> (fs -> a -> m (Step fs a))
-> (fs -> m a)
-> (fs -> m a)
-> m (Step (FIterState s (m a) m a a) a)
iterStep (fs -> a -> m (Step fs b)
fstep fs
fs a
x) s
s fs -> a -> m (Step fs b)
fstep fs -> m b
extract fs -> m b
final
            Skip s
s -> Step (FIterState s (m b) m a b) b
-> m (Step (FIterState s (m b) m a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FIterState s (m b) m a b) b
 -> m (Step (FIterState s (m b) m a b) b))
-> Step (FIterState s (m b) m a b) b
-> m (Step (FIterState s (m b) m a b) b)
forall a b. (a -> b) -> a -> b
$ FIterState s (m b) m a b -> Step (FIterState s (m b) m a b) b
forall s a. s -> Step s a
Skip (FIterState s (m b) m a b -> Step (FIterState s (m b) m a b) b)
-> FIterState s (m b) m a b -> Step (FIterState s (m b) m a b) b
forall a b. (a -> b) -> a -> b
$ s
-> (fs -> a -> m (Step fs b))
-> fs
-> (fs -> m b)
-> (fs -> m b)
-> FIterState s (m b) m a b
forall s f (m :: * -> *) a b fs.
s
-> (fs -> a -> m (Step fs b))
-> fs
-> (fs -> m b)
-> (fs -> m b)
-> FIterState s f m a b
FIterStream s
s fs -> a -> m (Step fs b)
fstep fs
fs fs -> m b
extract fs -> m b
final
            Step s a
Stop -> do
                b
b <- fs -> m b
final fs
fs
                Step (FIterState s (m b) m a b) b
-> m (Step (FIterState s (m b) m a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FIterState s (m b) m a b) b
 -> m (Step (FIterState s (m b) m a b) b))
-> Step (FIterState s (m b) m a b) b
-> m (Step (FIterState s (m b) m a b) b)
forall a b. (a -> b) -> a -> b
$ FIterState s (m b) m a b -> Step (FIterState s (m b) m a b) b
forall s a. s -> Step s a
Skip (FIterState s (m b) m a b -> Step (FIterState s (m b) m a b) b)
-> FIterState s (m b) m a b -> Step (FIterState s (m b) m a b) b
forall a b. (a -> b) -> a -> b
$ b -> FIterState s (m b) m a b -> FIterState s (m b) m a b
forall s f (m :: * -> *) a b.
b -> FIterState s f m a b -> FIterState s f m a b
FIterYield b
b FIterState s (m b) m a b
forall s f (m :: * -> *) a b. FIterState s f m a b
FIterStop
    stepOuter State StreamK m a
_ (FIterYield b
a FIterState s (m b) m a b
next) = Step (FIterState s (m b) m a b) b
-> m (Step (FIterState s (m b) m a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FIterState s (m b) m a b) b
 -> m (Step (FIterState s (m b) m a b) b))
-> Step (FIterState s (m b) m a b) b
-> m (Step (FIterState s (m b) m a b) b)
forall a b. (a -> b) -> a -> b
$ b -> FIterState s (m b) m a b -> Step (FIterState s (m b) m a b) b
forall s a. a -> s -> Step s a
Yield b
a FIterState s (m b) m a b
next
    stepOuter State StreamK m a
_ FIterState s (m b) m a b
FIterStop = Step (FIterState s (m b) m a b) b
-> m (Step (FIterState s (m b) m a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (FIterState s (m b) m a b) b
forall s a. Step s a
Stop

------------------------------------------------------------------------------
-- Parsing
------------------------------------------------------------------------------

-- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the
-- output stream.
--
-- Usage:
--
-- >>> s = Stream.fromList [1..10]
-- >>> parser = Parser.takeBetween 0 2 Fold.sum
-- >>> Stream.toList $ Stream.parseMany parser s
-- [Right 3,Right 7,Right 11,Right 15,Right 19]
--
-- This is the streaming equivalent of the 'Streamly.Data.Parser.many' parse
-- combinator.
--
-- Known Issues: When the parser fails there is no way to get the remaining
-- stream.
--
{-# INLINE parseMany #-}
parseMany
    :: Monad m
    => PRD.Parser a m b
    -> Stream m a
    -> Stream m (Either ParseError b)
parseMany :: forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> Stream m a -> Stream m (Either ParseError b)
parseMany = Parser a m b -> Stream m a -> Stream m (Either ParseError b)
forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> Stream m a -> Stream m (Either ParseError b)
Drivers.parseMany

-- | Like 'parseMany' but includes stream position information in the error
-- messages.
--
{-# INLINE parseManyPos #-}
parseManyPos
    :: Monad m
    => PRD.Parser a m b
    -> Stream m a
    -> Stream m (Either ParseErrorPos b)
parseManyPos :: forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> Stream m a -> Stream m (Either ParseErrorPos b)
parseManyPos = Parser a m b -> Stream m a -> Stream m (Either ParseErrorPos b)
forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> Stream m a -> Stream m (Either ParseErrorPos b)
Drivers.parseManyPos

{-# DEPRECATED parseManyD "Please use parseMany instead." #-}
{-# INLINE parseManyD #-}
parseManyD
    :: Monad m
    => PR.Parser a m b
    -> Stream m a
    -> Stream m (Either ParseError b)
parseManyD :: forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> Stream m a -> Stream m (Either ParseError b)
parseManyD = Parser a m b -> Stream m a -> Stream m (Either ParseError b)
forall (m :: * -> *) a b.
Monad m =>
Parser a m b -> Stream m a -> Stream m (Either ParseError b)
parseMany

-- | Apply a stream of parsers to an input stream and emit the results in the
-- output stream.
--
-- /Unimplemented/
--
{-# INLINE parseSequence #-}
parseSequence
       :: -- Monad m =>
       Stream m (PR.Parser a m b)
    -> Stream m a
    -> Stream m b
parseSequence :: forall (m :: * -> *) a b.
Stream m (Parser a m b) -> Stream m a -> Stream m b
parseSequence Stream m (Parser a m b)
_f Stream m a
_m = Stream m b
forall a. HasCallStack => a
undefined

-- XXX Change the parser arguments' order

-- | @parseManyTill collect test stream@ tries the parser @test@ on the input,
-- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds
-- @test@ is tried again and so on. The parser stops when @test@ succeeds.  The
-- output of @test@ is discarded and the output of @collect@ is emitted in the
-- output stream. The parser fails if @collect@ fails.
--
-- /Unimplemented/
--
{-# INLINE parseManyTill #-}
parseManyTill ::
    -- MonadThrow m =>
       PR.Parser a m b
    -> PR.Parser a m x
    -> Stream m a
    -> Stream m b
parseManyTill :: forall a (m :: * -> *) b x.
Parser a m b -> Parser a m x -> Stream m a -> Stream m b
parseManyTill = Parser a m b -> Parser a m x -> Stream m a -> Stream m b
forall a. HasCallStack => a
undefined

-- | Iterate a parser generating function on a stream. The initial value @b@ is
-- used to generate the first parser, the parser is applied on the stream and
-- the result is used to generate the next parser and so on.
--
-- Example:
--
-- >>> import Data.Monoid (Sum(..))
-- >>> s = Stream.fromList [1..10]
-- >>> Stream.toList $ fmap getSum $ Stream.catRights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum s
-- [3,10,21,36,55,55]
--
-- This is the streaming equivalent of monad like sequenced application of
-- parsers where next parser is dependent on the previous parser.
--
-- /Pre-release/
--
{-# INLINE parseIterate #-}
parseIterate
    :: Monad m
    => (b -> PRD.Parser a m b)
    -> b
    -> Stream m a
    -> Stream m (Either ParseError b)
parseIterate :: forall (m :: * -> *) b a.
Monad m =>
(b -> Parser a m b)
-> b -> Stream m a -> Stream m (Either ParseError b)
parseIterate = (b -> Parser a m b)
-> b -> Stream m a -> Stream m (Either ParseError b)
forall (m :: * -> *) b a.
Monad m =>
(b -> Parser a m b)
-> b -> Stream m a -> Stream m (Either ParseError b)
Drivers.parseIterate

-- | Like 'parseIterate' but includes stream position information in the error
-- messages.
--
{-# INLINE parseIteratePos #-}
parseIteratePos
    :: Monad m
    => (b -> PRD.Parser a m b)
    -> b
    -> Stream m a
    -> Stream m (Either ParseErrorPos b)
parseIteratePos :: forall (m :: * -> *) b a.
Monad m =>
(b -> Parser a m b)
-> b -> Stream m a -> Stream m (Either ParseErrorPos b)
parseIteratePos = (b -> Parser a m b)
-> b -> Stream m a -> Stream m (Either ParseErrorPos b)
forall (m :: * -> *) b a.
Monad m =>
(b -> Parser a m b)
-> b -> Stream m a -> Stream m (Either ParseErrorPos b)
Drivers.parseIteratePos

{-# DEPRECATED parseIterateD "Please use parseIterate instead." #-}
{-# INLINE parseIterateD #-}
parseIterateD
    :: Monad m
    => (b -> PR.Parser a m b)
    -> b
    -> Stream m a
    -> Stream m (Either ParseError b)
parseIterateD :: forall (m :: * -> *) b a.
Monad m =>
(b -> Parser a m b)
-> b -> Stream m a -> Stream m (Either ParseError b)
parseIterateD = (b -> Parser a m b)
-> b -> Stream m a -> Stream m (Either ParseError b)
forall (m :: * -> *) b a.
Monad m =>
(b -> Parser a m b)
-> b -> Stream m a -> Stream m (Either ParseError b)
parseIterate

------------------------------------------------------------------------------
-- Grouping
------------------------------------------------------------------------------

data GroupByState st fs a b
    = GroupingInit st
    | GroupingDo st !fs
    | GroupingInitWith st !a
    | GroupingDoWith st !fs !a
    | GroupingYield !b (GroupByState st fs a b)
    | GroupingDone

-- | Keep collecting items in a group as long as the comparison function
-- returns true. The comparison function is @cmp old new@ where @old@ is the
-- first item in the group and @new@ is the incoming item being tested for
-- membership of the group. The collected items are folded by the supplied
-- fold.
--
-- Definition:
--
-- >>> groupsWhile cmp f = Stream.parseMany (Parser.groupBy cmp f)
{-# INLINE_NORMAL groupsWhile #-}
groupsWhile :: Monad m
    => (a -> a -> Bool)
    -> Fold m a b
    -> Stream m a
    -> Stream m b
{-
groupsWhile eq fld = parseMany (PRD.groupBy eq fld)
-}
groupsWhile :: forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
groupsWhile a -> a -> Bool
cmp (Fold s -> a -> m (Step s b)
fstep m (Step s b)
initial s -> m b
_ s -> m b
final) (Stream State StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m b
 -> GroupByState s s a Any -> m (Step (GroupByState s s a Any) b))
-> GroupByState s s a Any -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> GroupByState s s a Any -> m (Step (GroupByState s s a Any) b)
forall {m :: * -> *} {a} {b} {b}.
State StreamK m a
-> GroupByState s s a b -> m (Step (GroupByState s s a b) b)
stepOuter (s -> GroupByState s s a Any
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
state)

    where

    {-# INLINE_LATE stepOuter #-}
    stepOuter :: State StreamK m a
-> GroupByState s s a b -> m (Step (GroupByState s s a b) b)
stepOuter State StreamK m a
_ (GroupingInit s
st) = do
        -- XXX Note that if the stream stops without yielding a single element
        -- in the group we discard the "initial" effect.
        Step s b
res <- m (Step s b)
initial
        Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Partial s
s -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. s -> Step s a
Skip (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ s -> s -> GroupByState s s a b
forall st fs a b. st -> fs -> GroupByState st fs a b
GroupingDo s
st s
s
                  FL.Done b
b -> b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
b (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ s -> GroupByState s s a b
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
st
    stepOuter State StreamK m a
gst (GroupingDo s
st s
fs) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                Step s b
r <- s -> a -> m (Step s b)
fstep s
fs a
x
                case Step s b
r of
                    FL.Partial s
fs1 -> SPEC -> a -> s -> s -> m (Step (GroupByState s s a b) b)
forall {fs} {b}.
SPEC -> a -> s -> s -> m (Step (GroupByState s fs a b) b)
go SPEC
SPEC a
x s
s s
fs1
                    FL.Done b
b -> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
b (s -> GroupByState s s a b
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
s)
            Skip s
s -> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. s -> Step s a
Skip (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ s -> s -> GroupByState s s a b
forall st fs a b. st -> fs -> GroupByState st fs a b
GroupingDo s
s s
fs
            Step s a
Stop -> s -> m b
final s
fs m b
-> m (Step (GroupByState s s a b) b)
-> m (Step (GroupByState s s a b) b)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (GroupByState s s a b) b
forall s a. Step s a
Stop

        where

        go :: SPEC -> a -> s -> s -> m (Step (GroupByState s fs a b) b)
go !SPEC
_ a
prev s
stt !s
acc = do
            Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
stt
            case Step s a
res of
                Yield a
x s
s -> do
                    if a -> a -> Bool
cmp a
prev a
x
                    then do
                        Step s b
r <- s -> a -> m (Step s b)
fstep s
acc a
x
                        case Step s b
r of
                            FL.Partial s
fs1 -> SPEC -> a -> s -> s -> m (Step (GroupByState s fs a b) b)
go SPEC
SPEC a
prev s
s s
fs1
                            FL.Done b
b -> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s fs a b) b
 -> m (Step (GroupByState s fs a b) b))
-> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s fs a b -> Step (GroupByState s fs a b) b
forall s a. a -> s -> Step s a
Yield b
b (s -> GroupByState s fs a b
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
s)
                    else do
                        b
r <- s -> m b
final s
acc
                        Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s fs a b) b
 -> m (Step (GroupByState s fs a b) b))
-> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s fs a b -> Step (GroupByState s fs a b) b
forall s a. a -> s -> Step s a
Yield b
r (s -> a -> GroupByState s fs a b
forall st fs a b. st -> a -> GroupByState st fs a b
GroupingInitWith s
s a
x)
                Skip s
s -> SPEC -> a -> s -> s -> m (Step (GroupByState s fs a b) b)
go SPEC
SPEC a
prev s
s s
acc
                Step s a
Stop -> do
                    b
r <- s -> m b
final s
acc
                    Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s fs a b) b
 -> m (Step (GroupByState s fs a b) b))
-> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s fs a b -> Step (GroupByState s fs a b) b
forall s a. a -> s -> Step s a
Yield b
r GroupByState s fs a b
forall st fs a b. GroupByState st fs a b
GroupingDone
    stepOuter State StreamK m a
_ (GroupingInitWith s
st a
x) = do
        Step s b
res <- m (Step s b)
initial
        Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Partial s
s -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. s -> Step s a
Skip (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ s -> s -> a -> GroupByState s s a b
forall st fs a b. st -> fs -> a -> GroupByState st fs a b
GroupingDoWith s
st s
s a
x
                  FL.Done b
b -> b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
b (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ s -> a -> GroupByState s s a b
forall st fs a b. st -> a -> GroupByState st fs a b
GroupingInitWith s
st a
x
    stepOuter State StreamK m a
gst (GroupingDoWith s
st s
fs a
prev) = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
fs a
prev
        case Step s b
res of
            FL.Partial s
fs1 -> SPEC -> s -> s -> m (Step (GroupByState s s a b) b)
forall {fs} {b}.
SPEC -> s -> s -> m (Step (GroupByState s fs a b) b)
go SPEC
SPEC s
st s
fs1
            FL.Done b
b -> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
b (s -> GroupByState s s a b
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
st)

        where

        -- XXX code duplicated from the previous equation
        go :: SPEC -> s -> s -> m (Step (GroupByState s fs a b) b)
go !SPEC
_ s
stt !s
acc = do
            Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
stt
            case Step s a
res of
                Yield a
x s
s -> do
                    if a -> a -> Bool
cmp a
prev a
x
                    then do
                        Step s b
r <- s -> a -> m (Step s b)
fstep s
acc a
x
                        case Step s b
r of
                            FL.Partial s
fs1 -> SPEC -> s -> s -> m (Step (GroupByState s fs a b) b)
go SPEC
SPEC s
s s
fs1
                            FL.Done b
b -> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s fs a b) b
 -> m (Step (GroupByState s fs a b) b))
-> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s fs a b -> Step (GroupByState s fs a b) b
forall s a. a -> s -> Step s a
Yield b
b (s -> GroupByState s fs a b
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
s)
                    else do
                        b
r <- s -> m b
final s
acc
                        Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s fs a b) b
 -> m (Step (GroupByState s fs a b) b))
-> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s fs a b -> Step (GroupByState s fs a b) b
forall s a. a -> s -> Step s a
Yield b
r (s -> a -> GroupByState s fs a b
forall st fs a b. st -> a -> GroupByState st fs a b
GroupingInitWith s
s a
x)
                Skip s
s -> SPEC -> s -> s -> m (Step (GroupByState s fs a b) b)
go SPEC
SPEC s
s s
acc
                Step s a
Stop -> do
                    b
r <- s -> m b
final s
acc
                    Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s fs a b) b
 -> m (Step (GroupByState s fs a b) b))
-> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s fs a b -> Step (GroupByState s fs a b) b
forall s a. a -> s -> Step s a
Yield b
r GroupByState s fs a b
forall st fs a b. GroupByState st fs a b
GroupingDone
    stepOuter State StreamK m a
_ (GroupingYield b
_ GroupByState s s a b
_) = [Char] -> m (Step (GroupByState s s a b) b)
forall a. HasCallStack => [Char] -> a
error [Char]
"groupsWhile: Unreachable"
    stepOuter State StreamK m a
_ GroupByState s s a b
GroupingDone = Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (GroupByState s s a b) b
forall s a. Step s a
Stop

-- | The argument order of the comparison function in `groupsWhile` is
-- different than that of `groupsBy`.
--
-- In `groupsBy` the comparison function takes the next element as the first
-- argument and the previous element as the second argument. In `groupsWhile`
-- the first argument is the previous element and second argument is the next
-- element.
{-# DEPRECATED groupsBy "Please use groupsWhile instead. Please note the change in the argument order of the comparison function." #-}
{-# INLINE_NORMAL groupsBy #-}
groupsBy :: Monad m
    => (a -> a -> Bool)
    -> Fold m a b
    -> Stream m a
    -> Stream m b
groupsBy :: forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
groupsBy a -> a -> Bool
cmp = (a -> a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
groupsWhile ((a -> a -> Bool) -> a -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> Bool
cmp)

-- |
--
-- Definition:
--
-- >>> groupsRollingBy cmp f = Stream.parseMany (Parser.groupByRolling cmp f)
--
{-# INLINE_NORMAL groupsRollingBy #-}
groupsRollingBy :: Monad m
    => (a -> a -> Bool)
    -> Fold m a b
    -> Stream m a
    -> Stream m b
{-
groupsRollingBy eq fld = parseMany (PRD.groupByRolling eq fld)
-}
groupsRollingBy :: forall (m :: * -> *) a b.
Monad m =>
(a -> a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
groupsRollingBy a -> a -> Bool
cmp (Fold s -> a -> m (Step s b)
fstep m (Step s b)
initial s -> m b
_ s -> m b
final) (Stream State StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m b
 -> GroupByState s s a b -> m (Step (GroupByState s s a b) b))
-> GroupByState s s a b -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> GroupByState s s a b -> m (Step (GroupByState s s a b) b)
forall {m :: * -> *} {a}.
State StreamK m a
-> GroupByState s s a b -> m (Step (GroupByState s s a b) b)
stepOuter (s -> GroupByState s s a b
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
state)

    where

    {-# INLINE_LATE stepOuter #-}
    stepOuter :: State StreamK m a
-> GroupByState s s a b -> m (Step (GroupByState s s a b) b)
stepOuter State StreamK m a
_ (GroupingInit s
st) = do
        -- XXX Note that if the stream stops without yielding a single element
        -- in the group we discard the "initial" effect.
        Step s b
res <- m (Step s b)
initial
        Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Partial s
fs -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. s -> Step s a
Skip (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ s -> s -> GroupByState s s a b
forall st fs a b. st -> fs -> GroupByState st fs a b
GroupingDo s
st s
fs
                  FL.Done b
fb -> b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
fb (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ s -> GroupByState s s a b
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
st
    stepOuter State StreamK m a
gst (GroupingDo s
st s
fs) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                Step s b
r <- s -> a -> m (Step s b)
fstep s
fs a
x
                case Step s b
r of
                    FL.Partial s
fs1 -> SPEC -> a -> s -> s -> m (Step (GroupByState s s a b) b)
forall {fs} {b}.
SPEC -> a -> s -> s -> m (Step (GroupByState s fs a b) b)
go SPEC
SPEC a
x s
s s
fs1
                    FL.Done b
fb -> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
fb (s -> GroupByState s s a b
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
s)
            Skip s
s -> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. s -> Step s a
Skip (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ s -> s -> GroupByState s s a b
forall st fs a b. st -> fs -> GroupByState st fs a b
GroupingDo s
s s
fs
            Step s a
Stop -> s -> m b
final s
fs m b
-> m (Step (GroupByState s s a b) b)
-> m (Step (GroupByState s s a b) b)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (GroupByState s s a b) b
forall s a. Step s a
Stop

        where

        go :: SPEC -> a -> s -> s -> m (Step (GroupByState s fs a b) b)
go !SPEC
_ a
prev s
stt !s
acc = do
            Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
stt
            case Step s a
res of
                Yield a
x s
s -> do
                    if a -> a -> Bool
cmp a
prev a
x
                    then do
                        Step s b
r <- s -> a -> m (Step s b)
fstep s
acc a
x
                        case Step s b
r of
                            FL.Partial s
fs1 -> SPEC -> a -> s -> s -> m (Step (GroupByState s fs a b) b)
go SPEC
SPEC a
x s
s s
fs1
                            FL.Done b
b -> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s fs a b) b
 -> m (Step (GroupByState s fs a b) b))
-> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s fs a b -> Step (GroupByState s fs a b) b
forall s a. a -> s -> Step s a
Yield b
b (s -> GroupByState s fs a b
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
s)
                    else do
                        b
r <- s -> m b
final s
acc
                        Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s fs a b) b
 -> m (Step (GroupByState s fs a b) b))
-> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s fs a b -> Step (GroupByState s fs a b) b
forall s a. a -> s -> Step s a
Yield b
r (s -> a -> GroupByState s fs a b
forall st fs a b. st -> a -> GroupByState st fs a b
GroupingInitWith s
s a
x)
                Skip s
s -> SPEC -> a -> s -> s -> m (Step (GroupByState s fs a b) b)
go SPEC
SPEC a
prev s
s s
acc
                Step s a
Stop -> do
                    b
r <- s -> m b
final s
acc
                    Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s fs a b) b
 -> m (Step (GroupByState s fs a b) b))
-> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s fs a b -> Step (GroupByState s fs a b) b
forall s a. a -> s -> Step s a
Yield b
r GroupByState s fs a b
forall st fs a b. GroupByState st fs a b
GroupingDone
    stepOuter State StreamK m a
_ (GroupingInitWith s
st a
x) = do
        Step s b
res <- m (Step s b)
initial
        Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Partial s
s -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. s -> Step s a
Skip (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ s -> s -> a -> GroupByState s s a b
forall st fs a b. st -> fs -> a -> GroupByState st fs a b
GroupingDoWith s
st s
s a
x
                  FL.Done b
b -> b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
b (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ s -> a -> GroupByState s s a b
forall st fs a b. st -> a -> GroupByState st fs a b
GroupingInitWith s
st a
x
    stepOuter State StreamK m a
gst (GroupingDoWith s
st s
fs a
previous) = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
fs a
previous
        case Step s b
res of
            FL.Partial s
s -> SPEC -> a -> s -> s -> m (Step (GroupByState s s a b) b)
go SPEC
SPEC a
previous s
st s
s
            FL.Done b
b -> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
b (s -> GroupByState s s a b
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
st)

        where

        -- XXX GHC: groupsWhile has one less parameter in this go loop and it
        -- fuses. However, groupsRollingBy does not fuse, removing the prev
        -- parameter makes it fuse. Something needs to be fixed in GHC. The
        -- workaround for this is noted in the comments below.
        go :: SPEC -> a -> s -> s -> m (Step (GroupByState s s a b) b)
go !SPEC
_ a
prev !s
stt !s
acc = do
            Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
stt
            case Step s a
res of
                Yield a
x s
s -> do
                    if a -> a -> Bool
cmp a
prev a
x
                    then do
                        Step s b
r <- s -> a -> m (Step s b)
fstep s
acc a
x
                        case Step s b
r of
                            FL.Partial s
fs1 -> SPEC -> a -> s -> s -> m (Step (GroupByState s s a b) b)
go SPEC
SPEC a
x s
s s
fs1
                            FL.Done b
b -> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
b (s -> GroupByState s s a b
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
st)
                    else do
                        {-
                        r <- final acc
                        return $ Yield r (GroupingInitWith s x)
                        -}
                        -- The code above does not let groupBy fuse. We use the
                        -- alternative code below instead.  Instead of jumping
                        -- to GroupingInitWith state, we unroll the code of
                        -- GroupingInitWith state here to help GHC with stream
                        -- fusion.
                        Step s b
result <- m (Step s b)
initial
                        b
r <- s -> m b
final s
acc
                        Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                            (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
r
                            (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ case Step s b
result of
                                  FL.Partial s
fsi -> s -> s -> a -> GroupByState s s a b
forall st fs a b. st -> fs -> a -> GroupByState st fs a b
GroupingDoWith s
s s
fsi a
x
                                  FL.Done b
b -> b -> GroupByState s s a b -> GroupByState s s a b
forall st fs a b.
b -> GroupByState st fs a b -> GroupByState st fs a b
GroupingYield b
b (s -> GroupByState s s a b
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
s)
                Skip s
s -> SPEC -> a -> s -> s -> m (Step (GroupByState s s a b) b)
go SPEC
SPEC a
prev s
s s
acc
                Step s a
Stop -> do
                    b
r <- s -> m b
final s
acc
                    Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
r GroupByState s s a b
forall st fs a b. GroupByState st fs a b
GroupingDone
    stepOuter State StreamK m a
_ (GroupingYield b
r GroupByState s s a b
next) = Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
r GroupByState s s a b
next
    stepOuter State StreamK m a
_ GroupByState s s a b
GroupingDone = Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (GroupByState s s a b) b
forall s a. Step s a
Stop

------------------------------------------------------------------------------
-- Splitting - by a predicate
------------------------------------------------------------------------------

data WordsByState st fs b
    = WordsByInit st
    | WordsByDo st !fs
    | WordsByDone
    | WordsByYield !b (WordsByState st fs b)

-- | Split the stream after stripping leading, trailing, and repeated
-- separators determined by the predicate supplied. The tokens after splitting
-- are collected by the supplied fold. In other words, the tokens are parsed in
-- the same way as words are parsed from whitespace separated text.
--
-- >>> f x = Stream.toList $ Stream.wordsBy (== '.') Fold.toList $ Stream.fromList x
-- >>> f "a.b"
-- ["a","b"]
-- >>> f "a..b"
-- ["a","b"]
-- >>> f ".a..b."
-- ["a","b"]
--
{-# INLINE_NORMAL wordsBy #-}
wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
wordsBy :: forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
wordsBy a -> Bool
predicate (Fold s -> a -> m (Step s b)
fstep m (Step s b)
initial s -> m b
_ s -> m b
final) (Stream State StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m b
 -> WordsByState s s b -> m (Step (WordsByState s s b) b))
-> WordsByState s s b -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> WordsByState s s b -> m (Step (WordsByState s s b) b)
forall {m :: * -> *} {a}.
State StreamK m a
-> WordsByState s s b -> m (Step (WordsByState s s b) b)
stepOuter (s -> WordsByState s s b
forall st fs b. st -> WordsByState st fs b
WordsByInit s
state)

    where

    {-# INLINE_LATE stepOuter #-}
    stepOuter :: State StreamK m a
-> WordsByState s s b -> m (Step (WordsByState s s b) b)
stepOuter State StreamK m a
_ (WordsByInit s
st) = do
        Step s b
res <- m (Step s b)
initial
        Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b))
-> Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Partial s
s -> WordsByState s s b -> Step (WordsByState s s b) b
forall s a. s -> Step s a
Skip (WordsByState s s b -> Step (WordsByState s s b) b)
-> WordsByState s s b -> Step (WordsByState s s b) b
forall a b. (a -> b) -> a -> b
$ s -> s -> WordsByState s s b
forall st fs b. st -> fs -> WordsByState st fs b
WordsByDo s
st s
s
                  FL.Done b
b -> b -> WordsByState s s b -> Step (WordsByState s s b) b
forall s a. a -> s -> Step s a
Yield b
b (s -> WordsByState s s b
forall st fs b. st -> WordsByState st fs b
WordsByInit s
st)

    stepOuter State StreamK m a
gst (WordsByDo s
st s
fs) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                if a -> Bool
predicate a
x
                then do
                    Step s b
resi <- m (Step s b)
initial
                    Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                        (Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b))
-> Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
resi of
                              FL.Partial s
fs1 -> WordsByState s s b -> Step (WordsByState s s b) b
forall s a. s -> Step s a
Skip (WordsByState s s b -> Step (WordsByState s s b) b)
-> WordsByState s s b -> Step (WordsByState s s b) b
forall a b. (a -> b) -> a -> b
$ s -> s -> WordsByState s s b
forall st fs b. st -> fs -> WordsByState st fs b
WordsByDo s
s s
fs1
                              FL.Done b
b -> b -> WordsByState s s b -> Step (WordsByState s s b) b
forall s a. a -> s -> Step s a
Yield b
b (s -> WordsByState s s b
forall st fs b. st -> WordsByState st fs b
WordsByInit s
s)
                else do
                    Step s b
r <- s -> a -> m (Step s b)
fstep s
fs a
x
                    case Step s b
r of
                        FL.Partial s
fs1 -> SPEC -> s -> s -> m (Step (WordsByState s s b) b)
go SPEC
SPEC s
s s
fs1
                        FL.Done b
b -> Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b))
-> Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a b. (a -> b) -> a -> b
$ b -> WordsByState s s b -> Step (WordsByState s s b) b
forall s a. a -> s -> Step s a
Yield b
b (s -> WordsByState s s b
forall st fs b. st -> WordsByState st fs b
WordsByInit s
s)
            Skip s
s    -> Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b))
-> Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a b. (a -> b) -> a -> b
$ WordsByState s s b -> Step (WordsByState s s b) b
forall s a. s -> Step s a
Skip (WordsByState s s b -> Step (WordsByState s s b) b)
-> WordsByState s s b -> Step (WordsByState s s b) b
forall a b. (a -> b) -> a -> b
$ s -> s -> WordsByState s s b
forall st fs b. st -> fs -> WordsByState st fs b
WordsByDo s
s s
fs
            Step s a
Stop      -> s -> m b
final s
fs m b
-> m (Step (WordsByState s s b) b)
-> m (Step (WordsByState s s b) b)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (WordsByState s s b) b
forall s a. Step s a
Stop

        where

        go :: SPEC -> s -> s -> m (Step (WordsByState s s b) b)
go !SPEC
_ s
stt !s
acc = do
            Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
stt
            case Step s a
res of
                Yield a
x s
s -> do
                    if a -> Bool
predicate a
x
                    then do
                        {-
                        r <- final acc
                        return $ Yield r (WordsByInit s)
                        -}
                        -- The above code does not fuse well. Need to check why
                        -- GHC is not able to simplify it well.  Using the code
                        -- below, instead of jumping through the WordsByInit
                        -- state always, we directly go to WordsByDo state in
                        -- the common case of Partial.
                        Step s b
resi <- m (Step s b)
initial
                        b
r <- s -> m b
final s
acc
                        Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
                            (Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b))
-> Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a b. (a -> b) -> a -> b
$ b -> WordsByState s s b -> Step (WordsByState s s b) b
forall s a. a -> s -> Step s a
Yield b
r
                            (WordsByState s s b -> Step (WordsByState s s b) b)
-> WordsByState s s b -> Step (WordsByState s s b) b
forall a b. (a -> b) -> a -> b
$ case Step s b
resi of
                                  FL.Partial s
fs1 -> s -> s -> WordsByState s s b
forall st fs b. st -> fs -> WordsByState st fs b
WordsByDo s
s s
fs1
                                  FL.Done b
b -> b -> WordsByState s s b -> WordsByState s s b
forall st fs b. b -> WordsByState st fs b -> WordsByState st fs b
WordsByYield b
b (s -> WordsByState s s b
forall st fs b. st -> WordsByState st fs b
WordsByInit s
s)
                    else do
                        Step s b
r <- s -> a -> m (Step s b)
fstep s
acc a
x
                        case Step s b
r of
                            FL.Partial s
fs1 -> SPEC -> s -> s -> m (Step (WordsByState s s b) b)
go SPEC
SPEC s
s s
fs1
                            FL.Done b
b -> Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b))
-> Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a b. (a -> b) -> a -> b
$ b -> WordsByState s s b -> Step (WordsByState s s b) b
forall s a. a -> s -> Step s a
Yield b
b (s -> WordsByState s s b
forall st fs b. st -> WordsByState st fs b
WordsByInit s
s)
                Skip s
s -> SPEC -> s -> s -> m (Step (WordsByState s s b) b)
go SPEC
SPEC s
s s
acc
                Step s a
Stop -> do
                    b
r <- s -> m b
final s
acc
                    Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b))
-> Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a b. (a -> b) -> a -> b
$ b -> WordsByState s s b -> Step (WordsByState s s b) b
forall s a. a -> s -> Step s a
Yield b
r WordsByState s s b
forall st fs b. WordsByState st fs b
WordsByDone

    stepOuter State StreamK m a
_ WordsByState s s b
WordsByDone = Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (WordsByState s s b) b
forall s a. Step s a
Stop

    stepOuter State StreamK m a
_ (WordsByYield b
b WordsByState s s b
next) = Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b))
-> Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall a b. (a -> b) -> a -> b
$ b -> WordsByState s s b -> Step (WordsByState s s b) b
forall s a. a -> s -> Step s a
Yield b
b WordsByState s s b
next

------------------------------------------------------------------------------
-- Splitting on a sequence
------------------------------------------------------------------------------

-- String search algorithms:
-- http://www-igm.univ-mlv.fr/~lecroq/string/index.html

-- XXX Can GHC find a way to modularise this? Can we write different cases
-- i.e.g single element, word hash, karp-rabin as different functions and then
-- be able to combine them into a single state machine?

{-# ANN type TakeEndBySeqState Fuse #-}
data TakeEndBySeqState mba rb rh ck w s b x =
      TakeEndBySeqInit
    | TakeEndBySeqYield !b (TakeEndBySeqState mba rb rh ck w s b x)
    | TakeEndBySeqDone

    | TakeEndBySeqSingle s x

    | TakeEndBySeqWordInit !Int !w s
    | TakeEndBySeqWordLoop !w s
    | TakeEndBySeqWordDone !Int !w

    | TakeEndBySeqKRInit s mba
    | TakeEndBySeqKRInit1 s mba !Int
    | TakeEndBySeqKRLoop s mba !rh !ck
    | TakeEndBySeqKRCheck s mba !rh
    | TakeEndBySeqKRDone !Int rb

-- | If the pattern is empty the output stream is empty.
{-# INLINE_NORMAL takeEndBySeqWith #-}
takeEndBySeqWith
    :: forall m a. (MonadIO m, Unbox a, Enum a, Eq a)
    => Bool
    -> Array a
    -> Stream m a
    -> Stream m a
takeEndBySeqWith :: forall (m :: * -> *) a.
(MonadIO m, Unbox a, Enum a, Eq a) =>
Bool -> Array a -> Stream m a -> Stream m a
takeEndBySeqWith Bool
withSep Array a
patArr (Stream State StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m a
 -> TakeEndBySeqState
      MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {m :: * -> *} {a}.
State StreamK m a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
stepOuter TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x. TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqInit

    where

    patLen :: Int
patLen = Array a -> Int
forall a. Unbox a => Array a -> Int
A.length Array a
patArr
    patBytes :: Int
patBytes = Array a -> Int
forall a. Array a -> Int
A.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)
    elemBits :: Int
elemBits = SIZE_OF(a) * 8

    -- For word pattern case
    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
A.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?
    patHash :: Word32
patHash = (Word32 -> a -> Word32) -> Word32 -> Array a -> Word32
forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b
A.foldl' Word32 -> a -> Word32
forall {a}. Enum a => Word32 -> a -> Word32
addCksum Word32
0 Array a
patArr

    skip :: a -> m (Step a a)
skip = Step a a -> m (Step a a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step a a -> m (Step a a)) -> (a -> Step a a) -> a -> m (Step a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Step a a
forall s a. s -> Step s a
Skip

    {-# INLINE yield #-}
    yield :: b
-> TakeEndBySeqState mba rb rh ck w s b x
-> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a)
yield b
x !TakeEndBySeqState mba rb rh ck w s b x
s = TakeEndBySeqState mba rb rh ck w s b x
-> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a)
forall {a} {a}. a -> m (Step a a)
skip (TakeEndBySeqState mba rb rh ck w s b x
 -> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a))
-> TakeEndBySeqState mba rb rh ck w s b x
-> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a)
forall a b. (a -> b) -> a -> b
$ b
-> TakeEndBySeqState mba rb rh ck w s b x
-> TakeEndBySeqState mba rb rh ck w s b x
forall mba rb rh ck w s b x.
b
-> TakeEndBySeqState mba rb rh ck w s b x
-> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqYield b
x TakeEndBySeqState mba rb rh ck w s b x
s

    {-# INLINE_LATE stepOuter #-}
    stepOuter :: State StreamK m a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
stepOuter State StreamK m a
_ TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
TakeEndBySeqInit = do
        -- XXX When we statically specify the method compiler is able to
        -- simplify the code better and removes the handling of other states.
        -- When it is determined dynamically, the code is less efficient. For
        -- example, the single element search degrades by 80% if the handling
        -- of other cases is present. We need to investigate this further but
        -- until then we can guide the compiler statically where we can. If we
        -- want to use single element search statically then we can use
        -- takeEndBy instead.
        --
        -- XXX Is there a way for GHC to statically determine patLen when we
        -- use an array created from a static string as pattern e.g. "\n".
        case () of
            ()
_ | Int
patLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
forall s a. Step s a
Stop
              | 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
A.unsafeGetIndexIO Int
0 Array a
patArr
                    Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (TakeEndBySeqState
      MutByteArray (RingArray a) Int Word32 Word s a a)
   a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> Step
     (TakeEndBySeqState
        MutByteArray (RingArray a) Int Word32 Word s a a)
     a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> Step
     (TakeEndBySeqState
        MutByteArray (RingArray a) Int Word32 Word s a a)
     a
forall s a. s -> Step s a
Skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> Step
      (TakeEndBySeqState
         MutByteArray (RingArray a) Int Word32 Word s a a)
      a)
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> Step
     (TakeEndBySeqState
        MutByteArray (RingArray a) Int Word32 Word s a a)
     a
forall a b. (a -> b) -> a -> b
$ s
-> a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
s -> x -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqSingle s
state a
pat
              | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->
                    Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (TakeEndBySeqState
      MutByteArray (RingArray a) Int Word32 Word s a a)
   a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> Step
     (TakeEndBySeqState
        MutByteArray (RingArray a) Int Word32 Word s a a)
     a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> Step
     (TakeEndBySeqState
        MutByteArray (RingArray a) Int Word32 Word s a a)
     a
forall s a. s -> Step s a
Skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> Step
      (TakeEndBySeqState
         MutByteArray (RingArray a) Int Word32 Word s a a)
      a)
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> Step
     (TakeEndBySeqState
        MutByteArray (RingArray a) Int Word32 Word s a a)
     a
forall a b. (a -> b) -> a -> b
$ Int
-> Word
-> s
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
Int -> w -> s -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqWordInit Int
0 Word
0 s
state
              | 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)
MutArray.emptyOf Int
patLen
                    TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ s
-> MutByteArray
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
s -> mba -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRInit s
state MutByteArray
mba

    ---------------------
    -- Single yield point
    ---------------------

    stepOuter State StreamK m a
_ (TakeEndBySeqYield a
x TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
next) = Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (TakeEndBySeqState
      MutByteArray (RingArray a) Int Word32 Word s a a)
   a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> Step
     (TakeEndBySeqState
        MutByteArray (RingArray a) Int Word32 Word s a a)
     a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> Step
     (TakeEndBySeqState
        MutByteArray (RingArray a) Int Word32 Word s a a)
     a
forall s a. a -> s -> Step s a
Yield a
x TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
next

    -----------------
    -- Done
    -----------------

    stepOuter State StreamK m a
_ TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
TakeEndBySeqDone = Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
forall s a. Step s a
Stop

    -----------------
    -- Single Pattern
    -----------------

    stepOuter State StreamK m a
gst (TakeEndBySeqSingle s
st a
pat) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s ->
                if a
pat a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x
                then a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {b} {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
b
-> TakeEndBySeqState mba rb rh ck w s b x
-> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a)
yield a
x (s
-> a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
s -> x -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqSingle s
s a
pat)
                else do
                    if Bool
withSep
                    then a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {b} {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
b
-> TakeEndBySeqState mba rb rh ck w s b x
-> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a)
yield a
x TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x. TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqDone
                    else Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
forall s a. Step s a
Stop
            Skip s
s -> TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ s
-> a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
s -> x -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqSingle s
s a
pat
            Step s a
Stop -> Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
forall s a. Step s a
Stop

    ---------------------------
    -- Short Pattern - Shift Or
    ---------------------------

    -- Note: Karp-Rabin is roughly 15% slower than word hash for a 2 element
    -- pattern. This may be useful for common cases like splitting lines using
    -- "\r\n".
    stepOuter State StreamK m a
_ (TakeEndBySeqWordDone Int
0 Word
_) = do
        Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
forall s a. Step s a
Stop
    stepOuter State StreamK m a
_ (TakeEndBySeqWordDone Int
n Word
wrd) = 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)))
         in a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {b} {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
b
-> TakeEndBySeqState mba rb rh ck w s b x
-> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a)
yield
                (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)
                (Int
-> Word
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
Int -> w -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqWordDone (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Word
wrd)

    -- XXX If we remove this init state for perf experiment the time taken
    -- reduces to half, there may be some optimization opportunity here.
    stepOuter State StreamK m a
gst (TakeEndBySeqWordInit Int
idx Word
wrd s
st) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> 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
                    next :: TakeEndBySeqState mba rb rh ck Word s b x
next
                      | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
maxIndex =
                            Int -> Word -> s -> TakeEndBySeqState mba rb rh ck Word s b x
forall mba rb rh ck w s b x.
Int -> w -> s -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqWordInit (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word
wrd1 s
s
                      | 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 =
                            Word -> s -> TakeEndBySeqState mba rb rh ck Word s b x
forall mba rb rh ck w s b x.
w -> s -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqWordLoop Word
wrd1 s
s
                      | Bool
otherwise = TakeEndBySeqState mba rb rh ck Word s b x
forall mba rb rh ck w s b x. TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqDone
                if Bool
withSep
                then a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {b} {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
b
-> TakeEndBySeqState mba rb rh ck w s b x
-> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a)
yield a
x TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
forall {mba} {rb} {rh} {ck} {b} {x}.
TakeEndBySeqState mba rb rh ck Word s b x
next
                else TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
forall {mba} {rb} {rh} {ck} {b} {x}.
TakeEndBySeqState mba rb rh ck Word s b x
next
            Skip s
s -> TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ Int
-> Word
-> s
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
Int -> w -> s -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqWordInit Int
idx Word
wrd s
s
            Step s a
Stop ->
                if Bool
withSep
                then Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
forall s a. Step s a
Stop
                else TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ Int
-> Word
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
Int -> w -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqWordDone Int
idx Word
wrd

    stepOuter State StreamK m a
gst (TakeEndBySeqWordLoop Word
wrd s
st) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                -- XXX Never use a lazy expression as state, that causes issues
                -- in simplification because the state argument of Yield is
                -- lazy, maybe we can make that strict.
                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))
                    !y :: a
y =
                            if Bool
withSep
                            then a
x
                            else 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
                -- Note: changing the nesting order of if and yield makes a
                -- difference in performance.
                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 a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {b} {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
b
-> TakeEndBySeqState mba rb rh ck w s b x
-> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a)
yield a
y (Word
-> s
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
w -> s -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqWordLoop Word
wrd1 s
s)
                else a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {b} {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
b
-> TakeEndBySeqState mba rb rh ck w s b x
-> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a)
yield a
y TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x. TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqDone
            Skip s
s -> TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ Word
-> s
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
w -> s -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqWordLoop Word
wrd s
s
            Step s a
Stop ->
                 if Bool
withSep
                 then Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
forall s a. Step s a
Stop
                 else TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ Int
-> Word
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
Int -> w -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqWordDone Int
patLen Word
wrd

    -------------------------------
    -- General Pattern - Karp Rabin
    -------------------------------

    stepOuter State StreamK m a
gst (TakeEndBySeqKRInit s
st0 MutByteArray
mba) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st0
        case Step s a
res of
            Yield a
x s
s -> 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
0 MutByteArray
mba a
x
                if Bool
withSep
                then a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {b} {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
b
-> TakeEndBySeqState mba rb rh ck w s b x
-> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a)
yield a
x (s
-> MutByteArray
-> Int
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
s -> mba -> Int -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRInit1 s
s MutByteArray
mba (SIZE_OF(a)))
                else TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ s
-> MutByteArray
-> Int
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
s -> mba -> Int -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRInit1 s
s MutByteArray
mba (SIZE_OF(a))
            Skip s
s -> TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ s
-> MutByteArray
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
s -> mba -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRInit s
s MutByteArray
mba
            Step s a
Stop -> Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
forall s a. Step s a
Stop

    stepOuter State StreamK m a
gst (TakeEndBySeqKRInit1 s
st MutByteArray
mba Int
offset) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        let Array a
arr :: Array a = Array
                    { arrContents :: MutByteArray
arrContents = MutByteArray
mba
                    , arrStart :: Int
arrStart = Int
0
                    , arrEnd :: Int
arrEnd = Int
patBytes
                    }
        case Step s a
res of
            Yield a
x s
s -> 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
                let next :: TakeEndBySeqState MutByteArray rb Int Word32 w s b x
next =
                        if Int
offset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
maxOffset
                        then s
-> MutByteArray
-> Int
-> TakeEndBySeqState MutByteArray rb Int Word32 w s b x
forall mba rb rh ck w s b x.
s -> mba -> Int -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRInit1 s
s MutByteArray
mba (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a))
                        else
                            let ringHash :: Word32
ringHash = (Word32 -> a -> Word32) -> Word32 -> Array a -> Word32
forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b
A.foldl' Word32 -> a -> Word32
forall {a}. Enum a => Word32 -> a -> Word32
addCksum Word32
0 Array a
arr
                             in if Word32
ringHash Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
patHash
                                then s
-> MutByteArray
-> Int
-> TakeEndBySeqState MutByteArray rb Int Word32 w s b x
forall mba rb rh ck w s b x.
s -> mba -> rh -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRCheck s
s MutByteArray
mba Int
0
                                else s
-> MutByteArray
-> Int
-> Word32
-> TakeEndBySeqState MutByteArray rb Int Word32 w s b x
forall mba rb rh ck w s b x.
s -> mba -> rh -> ck -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRLoop s
s MutByteArray
mba Int
0 Word32
ringHash
                if Bool
withSep
                then a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {b} {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
b
-> TakeEndBySeqState mba rb rh ck w s b x
-> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a)
yield a
x TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
forall {rb} {w} {b} {x}.
TakeEndBySeqState MutByteArray rb Int Word32 w s b x
next
                else TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
forall {rb} {w} {b} {x}.
TakeEndBySeqState MutByteArray rb Int Word32 w s b x
next
            Skip s
s -> TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ s
-> MutByteArray
-> Int
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
s -> mba -> Int -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRInit1 s
s MutByteArray
mba Int
offset
            Step s a
Stop -> do
                if Bool
withSep
                then Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
forall s a. Step s a
Stop
                else do
                    let rb :: RingArray a
rb = RingArray
                            { ringContents :: MutByteArray
ringContents = MutByteArray
mba
                            , ringSize :: Int
ringSize = Int
offset
                            , ringHead :: Int
ringHead = Int
0
                            }
                     in TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ Int
-> RingArray a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
Int -> rb -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRDone Int
offset RingArray a
forall {a}. RingArray a
rb

    stepOuter State StreamK m a
gst (TakeEndBySeqKRLoop s
st MutByteArray
mba Int
rh Word32
cksum) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        let rb :: RingArray a
rb = RingArray
                { ringContents :: MutByteArray
ringContents = MutByteArray
mba
                , ringSize :: Int
ringSize = Int
patBytes
                , ringHead :: Int
ringHead = Int
rh
                }
        case Step s a
res of
            Yield a
x s
s -> do
                (RingArray a
rb1, a
old) <- 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)
RB.replace RingArray a
forall {a}. RingArray a
rb a
x)
                let cksum1 :: Word32
cksum1 = 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
                    next :: TakeEndBySeqState MutByteArray rb Int Word32 w s b x
next =
                        if Word32
cksum1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
patHash
                        then s
-> MutByteArray
-> Int
-> Word32
-> TakeEndBySeqState MutByteArray rb Int Word32 w s b x
forall mba rb rh ck w s b x.
s -> mba -> rh -> ck -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRLoop s
s MutByteArray
mba Int
rh1 Word32
cksum1
                        else s
-> MutByteArray
-> Int
-> TakeEndBySeqState MutByteArray rb Int Word32 w s b x
forall mba rb rh ck w s b x.
s -> mba -> rh -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRCheck s
s MutByteArray
mba Int
rh1
                if Bool
withSep
                then a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {b} {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
b
-> TakeEndBySeqState mba rb rh ck w s b x
-> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a)
yield a
x TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
forall {rb} {w} {b} {x}.
TakeEndBySeqState MutByteArray rb Int Word32 w s b x
next
                else a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {b} {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
b
-> TakeEndBySeqState mba rb rh ck w s b x
-> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a)
yield a
old TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
forall {rb} {w} {b} {x}.
TakeEndBySeqState MutByteArray rb Int Word32 w s b x
next
            Skip s
s -> TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ s
-> MutByteArray
-> Int
-> Word32
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
s -> mba -> rh -> ck -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRLoop s
s MutByteArray
mba Int
rh Word32
cksum
            Step s a
Stop -> do
                if Bool
withSep
                then Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
forall s a. Step s a
Stop
                else TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ Int
-> RingArray a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
Int -> rb -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRDone Int
patBytes RingArray a
forall {a}. RingArray a
rb

    stepOuter State StreamK m a
_ (TakeEndBySeqKRCheck s
st MutByteArray
mba Int
rh) = do
        let rb :: RingArray a
rb = RingArray
                    { ringContents :: MutByteArray
ringContents = MutByteArray
mba
                    , ringSize :: Int
ringSize = Int
patBytes
                    , ringHead :: Int
ringHead = Int
rh
                    }
        Bool
matches <- 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
RB.eqArray RingArray a
forall {a}. RingArray a
rb Array a
patArr
        if Bool
matches
        then Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
forall s a. Step s a
Stop
        else TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {a} {a}. a -> m (Step a a)
skip (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ s
-> MutByteArray
-> Int
-> Word32
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
s -> mba -> rh -> ck -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRLoop s
st MutByteArray
mba Int
rh Word32
patHash

    stepOuter State StreamK m a
_ (TakeEndBySeqKRDone Int
0 RingArray a
_) = Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a)
  a
forall s a. Step s a
Stop
    stepOuter State StreamK m a
_ (TakeEndBySeqKRDone Int
len RingArray a
rb) = do
        Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        a
old <- RingArray a -> m a
forall (m :: * -> *) a. (MonadIO m, Unbox a) => RingArray a -> m a
RB.unsafeGetHead RingArray a
rb
        let rb1 :: RingArray a
rb1 = RingArray a -> RingArray a
forall a. Unbox a => RingArray a -> RingArray a
RB.moveForward RingArray a
rb
        a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall {b} {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
b
-> TakeEndBySeqState mba rb rh ck w s b x
-> m (Step (TakeEndBySeqState mba rb rh ck w s b x) a)
yield a
old (TakeEndBySeqState MutByteArray (RingArray a) Int Word32 Word s a a
 -> m (Step
         (TakeEndBySeqState
            MutByteArray (RingArray a) Int Word32 Word s a a)
         a))
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
-> m (Step
        (TakeEndBySeqState
           MutByteArray (RingArray a) Int Word32 Word s a a)
        a)
forall a b. (a -> b) -> a -> b
$ Int
-> RingArray a
-> TakeEndBySeqState
     MutByteArray (RingArray a) Int Word32 Word s a a
forall mba rb rh ck w s b x.
Int -> rb -> TakeEndBySeqState mba rb rh ck w s b x
TakeEndBySeqKRDone (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- SIZE_OF(a)) rb1

-- | Take the stream until the supplied sequence is encountered. Take the
-- sequence as well and stop.
--
-- Usage:
--
-- >>> f pat xs = Stream.toList $ Stream.takeEndBySeq (Array.fromList pat) $ Stream.fromList xs
-- >>> f "fgh" "abcdefghijk"
-- "abcdefgh"
-- >>> f "lmn" "abcdefghijk"
-- "abcdefghijk"
-- >>> f "" "abcdefghijk"
-- ""
--
{-# INLINE takeEndBySeq #-}
takeEndBySeq
    :: forall m a. (MonadIO m, Unbox a, Enum a, Eq a)
    => Array a
    -> Stream m a
    -> Stream m a
takeEndBySeq :: forall (m :: * -> *) a.
(MonadIO m, Unbox a, Enum a, Eq a) =>
Array a -> Stream m a -> Stream m a
takeEndBySeq = Bool -> Array a -> Stream m a -> Stream m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a, Enum a, Eq a) =>
Bool -> Array a -> Stream m a -> Stream m a
takeEndBySeqWith Bool
True

-- | Take the stream until the supplied sequence is encountered. Do not take
-- the sequence.
--
-- Usage:
--
-- >>> f pat xs = Stream.toList $ Stream.takeEndBySeq_ (Array.fromList pat) $ Stream.fromList xs
-- >>> f "fgh" "abcdefghijk"
-- "abcde"
-- >>> f "lmn" "abcdefghijk"
-- "abcdefghijk"
-- >>> f "" "abcdefghijk"
-- ""
--
{-# INLINE takeEndBySeq_ #-}
takeEndBySeq_
    :: forall m a. (MonadIO m, Unbox a, Enum a, Eq a)
    => Array a
    -> Stream m a
    -> Stream m a
takeEndBySeq_ :: forall (m :: * -> *) a.
(MonadIO m, Unbox a, Enum a, Eq a) =>
Array a -> Stream m a -> Stream m a
takeEndBySeq_ = Bool -> Array a -> Stream m a -> Stream m a
forall (m :: * -> *) a.
(MonadIO m, Unbox a, Enum a, Eq a) =>
Bool -> Array a -> Stream m a -> Stream m a
takeEndBySeqWith Bool
False

{-
-- TODO can we unify the splitting operations using a splitting configuration
-- like in the split package.
--
data SplitStyle = Infix | Suffix | Prefix deriving (Eq, Show)
data SplitOptions = SplitOptions
    { style    :: SplitStyle
    , withSep  :: Bool  -- ^ keep the separators in output
    -- , compact  :: Bool  -- ^ treat multiple consecutive separators as one
    -- , trimHead :: Bool  -- ^ drop blank at head
    -- , trimTail :: Bool  -- ^ drop blank at tail
    }
-}

-- XXX using "fs" as the last arg in Constructors may simplify the code a bit,
-- because we can use the constructor directly without having to create "jump"
-- functions.
{-# ANN type SplitOnSeqState Fuse #-}
data SplitOnSeqState mba rb rh ck w fs s b x =
      SplitOnSeqInit
    | SplitOnSeqYield b (SplitOnSeqState mba rb rh ck w fs s b x)
    | SplitOnSeqDone

    | SplitOnSeqEmpty !fs s

    | SplitOnSeqSingle0 !fs s x
    | SplitOnSeqSingle !fs s x

    | SplitOnSeqWordInit0 !fs s
    | SplitOnSeqWordInit Int Word !fs s
    | SplitOnSeqWordLoop !w s !fs
    | SplitOnSeqWordDone Int !fs !w

    | SplitOnSeqKRInit0 Int !fs s mba
    | SplitOnSeqKRInit Int !fs s mba
    | SplitOnSeqKRLoop fs s mba !rh !ck
    | SplitOnSeqKRCheck fs s mba !rh
    | SplitOnSeqKRDone Int !fs rb

    | SplitOnSeqReinit (fs -> SplitOnSeqState mba rb rh ck w fs s b x)

-- XXX Need to fix empty stream split behavior

-- | Like 'splitSepBy_' but splits the stream on a sequence of elements rather than
-- a single element. Parses a sequence of tokens separated by an infixed
-- separator e.g. @a;b;c@ is parsed as @a@, @b@, @c@. If the pattern is empty
-- then each element is a match, thus the fold is finalized on each element.
--
-- >>> splitSepBy p xs = Stream.fold Fold.toList $ Stream.splitSepBySeq_ (Array.fromList p) Fold.toList (Stream.fromList xs)
--
-- >>> splitSepBy "" ""
-- []
--
-- >>> splitSepBy "" "a...b"
-- ["a",".",".",".","b"]
--
-- >>> splitSepBy ".." ""
-- []
--
-- >>> splitSepBy ".." "a...b"
-- ["a",".b"]
--
-- >>> splitSepBy ".." "abc"
-- ["abc"]
--
-- >>> splitSepBy ".." ".."
-- ["",""]
--
-- >>> splitSepBy "." ".a"
-- ["","a"]
--
-- >>> splitSepBy "." "a."
-- ["a",""]
--
-- Uses Rabin-Karp algorithm for substring search.
--
{-# INLINE_NORMAL splitSepBySeq_ #-}
splitSepBySeq_, splitOnSeq
    :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a)
    => Array a
    -> Fold m a b
    -> Stream m a
    -> Stream m b
splitSepBySeq_ :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a, Enum a, Eq a) =>
Array a -> Fold m a b -> Stream m a -> Stream m b
splitSepBySeq_ Array a
patArr (Fold s -> a -> m (Step s b)
fstep m (Step s b)
initial s -> m b
_ s -> m b
final) (Stream State StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m b
 -> SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {m :: * -> *} {a}.
State StreamK m a
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
stepOuter SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqInit

    where

    patLen :: Int
patLen = Array a -> Int
forall a. Unbox a => Array a -> Int
A.length Array a
patArr
    patBytes :: Int
patBytes = Array a -> Int
forall a. Array a -> Int
A.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)
    elemBits :: Int
elemBits = SIZE_OF(a) * 8

    -- For word pattern case
    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
A.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?
    patHash :: Word32
patHash = (Word32 -> a -> Word32) -> Word32 -> Array a -> Word32
forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b
A.foldl' Word32 -> a -> Word32
forall {a}. Enum a => Word32 -> a -> Word32
addCksum Word32
0 Array a
patArr

    skip :: a -> m (Step a a)
skip = Step a a -> m (Step a a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step a a -> m (Step a a)) -> (a -> Step a a) -> a -> m (Step a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Step a a
forall s a. s -> Step s a
Skip

    nextAfterInit :: (fs -> SplitOnSeqState mba rb rh ck w fs s b x)
-> Step fs b -> SplitOnSeqState mba rb rh ck w fs s b x
nextAfterInit fs -> SplitOnSeqState mba rb rh ck w fs s b x
nextGen Step fs b
stepRes =
        case Step fs b
stepRes of
            FL.Partial fs
s -> fs -> SplitOnSeqState mba rb rh ck w fs s b x
nextGen fs
s
            FL.Done b
b -> b
-> SplitOnSeqState mba rb rh ck w fs s b x
-> SplitOnSeqState mba rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
b
-> SplitOnSeqState mba rb rh ck w fs s b x
-> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqYield b
b ((fs -> SplitOnSeqState mba rb rh ck w fs s b x)
-> SplitOnSeqState mba rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
(fs -> SplitOnSeqState mba rb rh ck w fs s b x)
-> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqReinit fs -> SplitOnSeqState mba rb rh ck w fs s b x
nextGen)

    {-# INLINE yieldReinit #-}
    yieldReinit :: (s -> SplitOnSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
yieldReinit s -> SplitOnSeqState mba rb rh ck w s s b x
nextGen b
fs =
        m (Step s b)
initial m (Step s b)
-> (Step s b
    -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a))
-> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SplitOnSeqState mba rb rh ck w s s b x
-> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState mba rb rh ck w s s b x
 -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a))
-> (Step s b -> SplitOnSeqState mba rb rh ck w s s b x)
-> Step s b
-> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b
-> SplitOnSeqState mba rb rh ck w s s b x
-> SplitOnSeqState mba rb rh ck w s s b x
forall mba rb rh ck w fs s b x.
b
-> SplitOnSeqState mba rb rh ck w fs s b x
-> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqYield b
fs (SplitOnSeqState mba rb rh ck w s s b x
 -> SplitOnSeqState mba rb rh ck w s s b x)
-> (Step s b -> SplitOnSeqState mba rb rh ck w s s b x)
-> Step s b
-> SplitOnSeqState mba rb rh ck w s s b x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> SplitOnSeqState mba rb rh ck w s s b x)
-> Step s b -> SplitOnSeqState mba rb rh ck w s s b x
forall {fs} {mba} {rb} {rh} {ck} {w} {s} {b} {x}.
(fs -> SplitOnSeqState mba rb rh ck w fs s b x)
-> Step fs b -> SplitOnSeqState mba rb rh ck w fs s b x
nextAfterInit s -> SplitOnSeqState mba rb rh ck w s s b x
nextGen

    {-# INLINE_LATE stepOuter #-}
    stepOuter :: State StreamK m a
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
stepOuter State StreamK m a
_ SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
SplitOnSeqInit = do
        Step s b
res <- m (Step s b)
initial
        case Step s b
res of
            FL.Partial s
acc
                | Int
patLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
                    Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
   b
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall s a. s -> Step s a
Skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> Step
      (SplitOnSeqState
         MutByteArray (RingArray a) Int Word32 Word s s b a)
      b)
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall a b. (a -> b) -> a -> b
$ s
-> s
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqEmpty s
acc s
state
                | 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
A.unsafeGetIndexIO Int
0 Array a
patArr
                    Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
   b
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall s a. s -> Step s a
Skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> Step
      (SplitOnSeqState
         MutByteArray (RingArray a) Int Word32 Word s s b a)
      b)
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall a b. (a -> b) -> a -> b
$ s
-> s
-> a
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqSingle0 s
acc s
state a
pat
                | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->
                    Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
   b
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall s a. s -> Step s a
Skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> Step
      (SplitOnSeqState
         MutByteArray (RingArray a) Int Word32 Word s s b a)
      b)
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall a b. (a -> b) -> a -> b
$ s
-> s
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqWordInit0 s
acc s
state
                | 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)
MutArray.emptyOf Int
patLen
                    SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> s
-> MutByteArray
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
Int -> fs -> s -> mba -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRInit0 Int
0 s
acc s
state MutByteArray
mba
            FL.Done b
b -> SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
b
-> SplitOnSeqState mba rb rh ck w fs s b x
-> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqYield b
b SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqInit

    stepOuter State StreamK m a
_ (SplitOnSeqYield b
x SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
next) = Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
   b
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall s a. a -> s -> Step s a
Yield b
x SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
next

    ---------------------------
    -- Checkpoint
    ---------------------------

    stepOuter State StreamK m a
_ (SplitOnSeqReinit s
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
nextGen) =
        m (Step s b)
initial m (Step s b)
-> (Step s b
    -> m (Step
            (SplitOnSeqState
               MutByteArray (RingArray a) Int Word32 Word s s b a)
            b))
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> (Step s b
    -> SplitOnSeqState
         MutByteArray (RingArray a) Int Word32 Word s s b a)
-> Step s b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
 -> SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
-> Step s b
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall {fs} {mba} {rb} {rh} {ck} {w} {s} {b} {x}.
(fs -> SplitOnSeqState mba rb rh ck w fs s b x)
-> Step fs b -> SplitOnSeqState mba rb rh ck w fs s b x
nextAfterInit s
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
nextGen

    ---------------------------
    -- Empty pattern
    ---------------------------

    stepOuter State StreamK m a
gst (SplitOnSeqEmpty s
acc s
st) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                Step s b
r <- s -> a -> m (Step s b)
fstep s
acc a
x
                b
b1 <-
                    case Step s b
r of
                        FL.Partial s
acc1 -> s -> m b
final s
acc1
                        FL.Done b
b -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
                let jump :: fs -> SplitOnSeqState mba rb rh ck w fs s b x
jump fs
c = fs -> s -> SplitOnSeqState mba rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
fs -> s -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqEmpty fs
c s
s
                 in (s
 -> SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
yieldReinit s
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall {fs} {mba} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSeqState mba rb rh ck w fs s b x
jump b
b1
            Skip s
s -> SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (s
-> s
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqEmpty s
acc s
s)
            Step s a
Stop -> s -> m b
final s
acc m b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
forall s a. Step s a
Stop

    -----------------
    -- Done
    -----------------

    stepOuter State StreamK m a
_ SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
SplitOnSeqDone = Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
forall s a. Step s a
Stop

    -----------------
    -- Single Pattern
    -----------------

    stepOuter State StreamK m a
gst (SplitOnSeqSingle0 s
fs s
st a
pat) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                -- XXX This code block is duplicated in SplitOnSeqSingle state
                let jump :: fs -> SplitOnSeqState mba rb rh ck w fs s b a
jump fs
c = fs -> s -> a -> SplitOnSeqState mba rb rh ck w fs s b a
forall mba rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqSingle fs
c s
s a
pat
                if a
pat a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x
                then s -> m b
final s
fs m b
-> (b
    -> m (Step
            (SplitOnSeqState
               MutByteArray (RingArray a) Int Word32 Word s s b a)
            b))
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s
 -> SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
yieldReinit s
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall {fs} {mba} {rb} {rh} {ck} {w} {b}.
fs -> SplitOnSeqState mba rb rh ck w fs s b a
jump
                else do
                    Step s b
r <- s -> a -> m (Step s b)
fstep s
fs a
x
                    case Step s b
r of
                        FL.Partial s
fs1 ->
                            Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step
   (SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
   b
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall s a. s -> Step s a
Skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> Step
      (SplitOnSeqState
         MutByteArray (RingArray a) Int Word32 Word s s b a)
      b)
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall a b. (a -> b) -> a -> b
$ s
-> s
-> a
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqSingle s
fs1 s
s a
pat
                        FL.Done b
b -> (s
 -> SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
yieldReinit s
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall {fs} {mba} {rb} {rh} {ck} {w} {b}.
fs -> SplitOnSeqState mba rb rh ck w fs s b a
jump b
b
            Skip s
s -> Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step
   (SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
   b
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall s a. s -> Step s a
Skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> Step
      (SplitOnSeqState
         MutByteArray (RingArray a) Int Word32 Word s s b a)
      b)
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall a b. (a -> b) -> a -> b
$ s
-> s
-> a
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqSingle0 s
fs s
s a
pat
            Step s a
Stop -> s -> m b
final s
fs m b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
forall s a. Step s a
Stop

    stepOuter State StreamK m a
gst (SplitOnSeqSingle s
fs0 s
st0 a
pat) = do
        SPEC
-> s
-> s
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {w} {a}.
SPEC
-> s -> s -> m (Step (SplitOnSeqState mba rb rh ck w s s b a) a)
go SPEC
SPEC s
fs0 s
st0

        where

        -- The local loop increases allocations by 6% but improves CPU
        -- performance by 14%.
        go :: SPEC
-> s -> s -> m (Step (SplitOnSeqState mba rb rh ck w s s b a) a)
go !SPEC
_ !s
fs !s
st = do
            Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    let jump :: fs -> SplitOnSeqState mba rb rh ck w fs s b a
jump fs
c = fs -> s -> a -> SplitOnSeqState mba rb rh ck w fs s b a
forall mba rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqSingle fs
c s
s a
pat
                    if a
pat a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x
                    then s -> m b
final s
fs m b
-> (b -> m (Step (SplitOnSeqState mba rb rh ck w s s b a) a))
-> m (Step (SplitOnSeqState mba rb rh ck w s s b a) a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s -> SplitOnSeqState mba rb rh ck w s s b a)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b a) a)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
yieldReinit s -> SplitOnSeqState mba rb rh ck w s s b a
forall {fs} {mba} {rb} {rh} {ck} {w} {b}.
fs -> SplitOnSeqState mba rb rh ck w fs s b a
jump
                    else do
                        Step s b
r <- s -> a -> m (Step s b)
fstep s
fs a
x
                        case Step s b
r of
                            FL.Partial s
fs1 -> SPEC
-> s -> s -> m (Step (SplitOnSeqState mba rb rh ck w s s b a) a)
go SPEC
SPEC s
fs1 s
s
                            FL.Done b
b -> (s -> SplitOnSeqState mba rb rh ck w s s b a)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b a) a)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
yieldReinit s -> SplitOnSeqState mba rb rh ck w s s b a
forall {fs} {mba} {rb} {rh} {ck} {w} {b}.
fs -> SplitOnSeqState mba rb rh ck w fs s b a
jump b
b
                Skip s
s -> SPEC
-> s -> s -> m (Step (SplitOnSeqState mba rb rh ck w s s b a) a)
go SPEC
SPEC s
fs s
s
                Step s a
Stop -> do
                    b
r <- s -> m b
final s
fs
                    Step (SplitOnSeqState mba rb rh ck w s s b a) a
-> m (Step (SplitOnSeqState mba rb rh ck w s s b a) a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState mba rb rh ck w s s b a) a
 -> m (Step (SplitOnSeqState mba rb rh ck w s s b a) a))
-> Step (SplitOnSeqState mba rb rh ck w s s b a) a
-> m (Step (SplitOnSeqState mba rb rh ck w s s b a) a)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState mba rb rh ck w s s b a
-> Step (SplitOnSeqState mba rb rh ck w s s b a) a
forall s a. s -> Step s a
Skip (SplitOnSeqState mba rb rh ck w s s b a
 -> Step (SplitOnSeqState mba rb rh ck w s s b a) a)
-> SplitOnSeqState mba rb rh ck w s s b a
-> Step (SplitOnSeqState mba rb rh ck w s s b a) a
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSeqState mba rb rh ck w s s b a
-> SplitOnSeqState mba rb rh ck w s s b a
forall mba rb rh ck w fs s b x.
b
-> SplitOnSeqState mba rb rh ck w fs s b x
-> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqYield b
r SplitOnSeqState mba rb rh ck w s s b a
forall mba rb rh ck w fs s b x.
SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqDone

    ---------------------------
    -- Short Pattern - Shift Or
    ---------------------------

    -- Note: We fill the matching buffer before we emit anything, in case it
    -- matches and we have to drop it. Though we could be more eager in
    -- emitting as soon as we know that the pattern cannot match. But still the
    -- worst case will remain the same, in case a match is going to happen we
    -- will have to delay until the very end.

    stepOuter State StreamK m a
_ (SplitOnSeqWordDone Int
0 s
fs Word
_) = do
        b
r <- s -> m b
final s
fs
        SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
b
-> SplitOnSeqState mba rb rh ck w fs s b x
-> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqYield b
r SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqDone
    stepOuter State StreamK m a
_ (SplitOnSeqWordDone Int
n s
fs Word
wrd) = 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
fs (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
            FL.Partial s
fs1 -> SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> Word
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqWordDone (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) s
fs1 Word
wrd
            FL.Done b
b -> do
                 let jump :: fs -> SplitOnSeqState mba rb rh ck Word fs s b x
jump fs
c = Int -> fs -> Word -> SplitOnSeqState mba rb rh ck Word fs s b x
forall mba rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqWordDone (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) fs
c Word
wrd
                 (s
 -> SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
yieldReinit s
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall {fs} {mba} {rb} {rh} {ck} {s} {b} {x}.
fs -> SplitOnSeqState mba rb rh ck Word fs s b x
jump b
b

    stepOuter State StreamK m a
gst (SplitOnSeqWordInit0 s
fs s
st) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s ->
                let wrd1 :: Word
wrd1 = Word -> a -> Word
forall {a} {a}. (Bits a, Num a, Enum a) => a -> a -> a
addToWord Word
0 a
x
                 in Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step
   (SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
   b
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall s a. s -> Step s a
Skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> Step
      (SplitOnSeqState
         MutByteArray (RingArray a) Int Word32 Word s s b a)
      b)
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall a b. (a -> b) -> a -> b
$ Int
-> Word
-> s
-> s
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
Int -> Word -> fs -> s -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqWordInit Int
1 Word
wrd1 s
fs s
s
            Skip s
s -> Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Step
   (SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
   b
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall s a. s -> Step s a
Skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> Step
      (SplitOnSeqState
         MutByteArray (RingArray a) Int Word32 Word s s b a)
      b)
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall a b. (a -> b) -> a -> b
$ s
-> s
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqWordInit0 s
fs s
s
            Step s a
Stop -> s -> m b
final s
fs m b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
forall s a. Step s a
Stop

    stepOuter State StreamK m a
gst (SplitOnSeqWordInit Int
idx0 Word
wrd0 s
fs s
st0) =
        SPEC
-> Int
-> Word
-> s
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {x} {a}.
SPEC
-> Int
-> Word
-> s
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
go SPEC
SPEC Int
idx0 Word
wrd0 s
st0

        where

        {-# INLINE go #-}
        go :: SPEC
-> Int
-> Word
-> s
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
go !SPEC
_ !Int
idx !Word
wrd !s
st = do
            Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> 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 do
                            let jump :: fs -> SplitOnSeqState mba rb rh ck w fs s b x
jump fs
c = Int -> Word -> fs -> s -> SplitOnSeqState mba rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
Int -> Word -> fs -> s -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqWordInit Int
0 Word
0 fs
c s
s
                            s -> m b
final s
fs m b
-> (b -> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a))
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s -> SplitOnSeqState mba rb rh ck Word s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
yieldReinit s -> SplitOnSeqState mba rb rh ck Word s s b x
forall {fs} {mba} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSeqState mba rb rh ck w fs s b x
jump
                        else SplitOnSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState mba rb rh ck Word s s b x
 -> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a))
-> SplitOnSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ Word -> s -> s -> SplitOnSeqState mba rb rh ck Word s s b x
forall mba rb rh ck w fs s b x.
w -> s -> fs -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqWordLoop Word
wrd1 s
s s
fs
                    else SPEC
-> Int
-> Word
-> s
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
go SPEC
SPEC (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word
wrd1 s
s
                Skip s
s -> SPEC
-> Int
-> Word
-> s
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
go SPEC
SPEC Int
idx Word
wrd s
s
                Step s a
Stop -> do
                    if Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
                    then SplitOnSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState mba rb rh ck Word s s b x
 -> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a))
-> SplitOnSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Word -> SplitOnSeqState mba rb rh ck Word s s b x
forall mba rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqWordDone Int
idx s
fs Word
wrd
                    else do
                        b
r <- s -> m b
final s
fs
                        SplitOnSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState mba rb rh ck Word s s b x
 -> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a))
-> SplitOnSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSeqState mba rb rh ck Word s s b x
-> SplitOnSeqState mba rb rh ck Word s s b x
forall mba rb rh ck w fs s b x.
b
-> SplitOnSeqState mba rb rh ck w fs s b x
-> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqYield b
r SplitOnSeqState mba rb rh ck Word s s b x
forall mba rb rh ck w fs s b x.
SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqDone

    stepOuter State StreamK m a
gst (SplitOnSeqWordLoop Word
wrd0 s
st0 s
fs0) =
        SPEC
-> Word
-> s
-> s
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {x} {a}.
SPEC
-> Word
-> s
-> s
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
go SPEC
SPEC Word
wrd0 s
st0 s
fs0

        where

        -- This loop does not affect allocations but it improves the CPU
        -- performance signifcantly compared to looping using state.
        {-# INLINE go #-}
        go :: SPEC
-> Word
-> s
-> s
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
go !SPEC
_ !Word
wrd !s
st !s
fs = do
            Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    let jump :: fs -> SplitOnSeqState mba rb rh ck w fs s b x
jump fs
c = Int -> Word -> fs -> s -> SplitOnSeqState mba rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
Int -> Word -> fs -> s -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqWordInit Int
0 Word
0 fs
c s
s
                        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
r <- s -> a -> m (Step s b)
fstep s
fs (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
                        FL.Partial s
fs1 -> 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 s -> m b
final s
fs1 m b
-> (b -> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a))
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s -> SplitOnSeqState mba rb rh ck Word s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
yieldReinit s -> SplitOnSeqState mba rb rh ck Word s s b x
forall {fs} {mba} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSeqState mba rb rh ck w fs s b x
jump
                            else SPEC
-> Word
-> s
-> s
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
go SPEC
SPEC Word
wrd1 s
s s
fs1
                        FL.Done b
b -> (s -> SplitOnSeqState mba rb rh ck Word s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
yieldReinit s -> SplitOnSeqState mba rb rh ck Word s s b x
forall {fs} {mba} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSeqState mba rb rh ck w fs s b x
jump b
b
                Skip s
s -> SPEC
-> Word
-> s
-> s
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
go SPEC
SPEC Word
wrd s
s s
fs
                Step s a
Stop -> SplitOnSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState mba rb rh ck Word s s b x
 -> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a))
-> SplitOnSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSeqState mba rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Word -> SplitOnSeqState mba rb rh ck Word s s b x
forall mba rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqWordDone Int
patLen s
fs Word
wrd

    -------------------------------
    -- General Pattern - Karp Rabin
    -------------------------------

    -- XXX Document this pattern for writing efficient code. Loop around only
    -- required elements in the recursive loop, build the structures being
    -- manipulated locally e.g. we are passing only mba, here and build an
    -- array using patLen and arrStart from the surrounding context.

    stepOuter State StreamK m a
gst (SplitOnSeqKRInit0 Int
offset s
fs s
st MutByteArray
mba) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> 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
                SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> s
-> MutByteArray
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
Int -> fs -> s -> mba -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRInit (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a)) fs s mba
            Skip s
s -> SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> s
-> MutByteArray
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
Int -> fs -> s -> mba -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRInit0 Int
offset s
fs s
s MutByteArray
mba
            Step s a
Stop -> s -> m b
final s
fs m b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Step
  (SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
forall s a. Step s a
Stop

    stepOuter State StreamK m a
gst (SplitOnSeqKRInit Int
offset s
fs s
st MutByteArray
mba) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> 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
A.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
A.byteEq Array a
arr Array a
patArr
                    then SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> MutByteArray
-> Int
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> mba -> rh -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRCheck s
fs s
s MutByteArray
mba Int
0
                    else SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> MutByteArray
-> Int
-> Word32
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs
-> s -> mba -> rh -> ck -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRLoop s
fs s
s MutByteArray
mba Int
0 Word32
ringHash
                else SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> s
-> MutByteArray
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
Int -> fs -> s -> mba -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRInit (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a)) fs s mba
            Skip s
s -> SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> s
-> MutByteArray
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
Int -> fs -> s -> mba -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRInit Int
offset s
fs s
s MutByteArray
mba
            Step s a
Stop -> do
                let rb :: RingArray a
rb = RingArray
                        { ringContents :: MutByteArray
ringContents = MutByteArray
mba
                        , ringSize :: Int
ringSize = Int
offset
                        , ringHead :: Int
ringHead = Int
0
                        }
                SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> RingArray a
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
Int -> fs -> rb -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRDone Int
offset s
fs RingArray a
forall {a}. RingArray a
rb

    -- XXX The recursive "go" is more efficient than the state based recursion
    -- code commented out below. Perhaps its more efficient because of
    -- factoring out "mba" outside the loop.
    --
    stepOuter State StreamK m a
gst (SplitOnSeqKRLoop s
fs0 s
st0 MutByteArray
mba Int
rh0 Word32
cksum0) =
        SPEC
-> s
-> s
-> Int
-> Word32
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {ck} {w} {x} {a}.
SPEC
-> s
-> s
-> Int
-> Word32
-> m (Step
        (SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x) a)
go SPEC
SPEC s
fs0 s
st0 Int
rh0 Word32
cksum0

        where

        go :: SPEC
-> s
-> s
-> Int
-> Word32
-> m (Step
        (SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x) a)
go !SPEC
_ !s
fs !s
st !Int
rh !Word32
cksum = do
            Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            let rb :: RingArray a
rb = RingArray
                    { ringContents :: MutByteArray
ringContents = MutByteArray
mba
                    , ringSize :: Int
ringSize = Int
patBytes
                    , ringHead :: Int
ringHead = Int
rh
                    }
            case Step s a
res of
                Yield a
x s
s -> do
                    (RingArray a
rb1, a
old) <- 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)
RB.replace RingArray a
forall {a}. RingArray a
rb a
x)
                    Step s b
r <- s -> a -> m (Step s b)
fstep s
fs a
old
                    case Step s b
r of
                        FL.Partial s
fs1 -> do
                            let cksum1 :: Word32
cksum1 = 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
                            if Word32
cksum1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
patHash
                            then SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x
-> m (Step
        (SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x) a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x
 -> m (Step
         (SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x) a))
-> SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x
-> m (Step
        (SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x) a)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> MutByteArray
-> Int
-> SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x
forall mba rb rh ck w fs s b x.
fs -> s -> mba -> rh -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRCheck s
fs1 s
s MutByteArray
mba Int
rh1
                            else SPEC
-> s
-> s
-> Int
-> Word32
-> m (Step
        (SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x) a)
go SPEC
SPEC s
fs1 s
s Int
rh1 Word32
cksum1
                        FL.Done b
b -> do
                            -- XXX the old code looks wrong as we are resetting
                            -- the ring head but the ring still has old
                            -- elements as we are not resetting the size.
                            let jump :: fs -> SplitOnSeqState MutByteArray rb rh ck w fs s b x
jump fs
c = Int
-> fs
-> s
-> MutByteArray
-> SplitOnSeqState MutByteArray rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
Int -> fs -> s -> mba -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRInit Int
0 fs
c s
s MutByteArray
mba
                            (s -> SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x)
-> b
-> m (Step
        (SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x) a)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
yieldReinit s -> SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x
forall {fs} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSeqState MutByteArray rb rh ck w fs s b x
jump b
b
                Skip s
s -> SPEC
-> s
-> s
-> Int
-> Word32
-> m (Step
        (SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x) a)
go SPEC
SPEC s
fs s
s Int
rh Word32
cksum
                Step s a
Stop -> SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x
-> m (Step
        (SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x) a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x
 -> m (Step
         (SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x) a))
-> SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x
-> m (Step
        (SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x) a)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> RingArray a
-> SplitOnSeqState MutByteArray (RingArray a) Int ck w s s b x
forall mba rb rh ck w fs s b x.
Int -> fs -> rb -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRDone Int
patBytes s
fs RingArray a
forall {a}. RingArray a
rb

    -- XXX The following code is 5 times slower compared to the recursive loop
    -- based code above. Need to investigate why. One possibility is that the
    -- go loop above does not thread around the ring buffer (rb). This code may
    -- be causing the state to bloat and getting allocated on each iteration.
    -- We can check the cmm/asm code to confirm.  If so a good GHC solution to
    -- such problem is needed. One way to avoid this could be to use unboxed
    -- mutable state?
    {-
    stepOuter gst (SplitOnSeqKRLoop fs st rb rh cksum) = do
            res <- step (adaptState gst) st
            case res of
                Yield x s -> do
                    old <- liftIO $ peek rh
                    let cksum1 = deltaCksum cksum old x
                    fs1 <- fstep fs old
                    if (cksum1 == patHash)
                    then do
                        r <- done fs1
                        skip $ SplitOnSeqYield r $ SplitOnSeqKRInit 0 s rb rh
                    else do
                        rh1 <- liftIO (RB.unsafeInsert rb rh x)
                        skip $ SplitOnSeqKRLoop fs1 s rb rh1 cksum1
                Skip s -> skip $ SplitOnSeqKRLoop fs s rb rh cksum
                Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh
    -}

    stepOuter State StreamK m a
_ (SplitOnSeqKRCheck s
fs s
st MutByteArray
mba Int
rh) = do
        let rb :: RingArray a
rb = RingArray
                    { ringContents :: MutByteArray
ringContents = MutByteArray
mba
                    , ringSize :: Int
ringSize = Int
patBytes
                    , ringHead :: Int
ringHead = Int
rh
                    }
        Bool
res <- 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
RB.eqArray RingArray a
forall {a}. RingArray a
rb Array a
patArr
        if Bool
res
        then do
            b
r <- s -> m b
final s
fs
            let jump :: fs -> SplitOnSeqState MutByteArray rb rh ck w fs s b x
jump fs
c = Int
-> fs
-> s
-> MutByteArray
-> SplitOnSeqState MutByteArray rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
Int -> fs -> s -> mba -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRInit Int
0 fs
c s
st MutByteArray
mba
            (s
 -> SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
yieldReinit s
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall {fs} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSeqState MutByteArray rb rh ck w fs s b x
jump b
r
        else SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> MutByteArray
-> Int
-> Word32
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs
-> s -> mba -> rh -> ck -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRLoop s
fs s
st MutByteArray
mba Int
rh Word32
patHash

    stepOuter State StreamK m a
_ (SplitOnSeqKRDone Int
0 s
fs RingArray a
_) = do
        b
r <- s -> m b
final s
fs
        SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
b
-> SplitOnSeqState mba rb rh ck w fs s b x
-> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqYield b
r SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqDone
    stepOuter State StreamK m a
_ (SplitOnSeqKRDone Int
len s
fs RingArray a
rb) = do
        Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        a
old <- RingArray a -> m a
forall (m :: * -> *) a. (MonadIO m, Unbox a) => RingArray a -> m a
RB.unsafeGetHead RingArray a
rb
        let rb1 :: RingArray a
rb1 = RingArray a -> RingArray a
forall a. Unbox a => RingArray a -> RingArray a
RB.moveForward RingArray a
rb
        Step s b
r <- s -> a -> m (Step s b)
fstep s
fs a
old
        case Step s b
r of
            FL.Partial s
fs1 -> SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSeqState MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> RingArray a
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
Int -> fs -> rb -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRDone (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- SIZE_OF(a)) fs1 rb1
            FL.Done b
b -> do
                 let jump :: fs -> SplitOnSeqState mba (RingArray a) rh ck w fs s b x
jump fs
c = Int
-> fs
-> RingArray a
-> SplitOnSeqState mba (RingArray a) rh ck w fs s b x
forall mba rb rh ck w fs s b x.
Int -> fs -> rb -> SplitOnSeqState mba rb rh ck w fs s b x
SplitOnSeqKRDone (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- SIZE_OF(a)) c rb1
                 (s
 -> SplitOnSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState mba rb rh ck w s s b x) a)
yieldReinit s
-> SplitOnSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall {fs} {mba} {rh} {ck} {w} {s} {b} {x}.
fs -> SplitOnSeqState mba (RingArray a) rh ck w fs s b x
jump b
b

RENAME(splitOnSeq,splitSepBySeq_)

{-# ANN type SplitOnSuffixSeqState Fuse #-}
data SplitOnSuffixSeqState mba rb rh ck w fs s b x =
      SplitOnSuffixSeqInit
    | SplitOnSuffixSeqYield b (SplitOnSuffixSeqState mba rb rh ck w fs s b x)
    | SplitOnSuffixSeqDone

    | SplitOnSuffixSeqEmpty !fs s

    | SplitOnSuffixSeqSingleInit !fs s x
    | SplitOnSuffixSeqSingle !fs s x

    | SplitOnSuffixSeqWordInit !fs s
    | SplitOnSuffixSeqWordLoop !w s !fs
    | SplitOnSuffixSeqWordDone Int !fs !w

    | SplitOnSuffixSeqKRInit !fs s mba
    | SplitOnSuffixSeqKRInit1 !fs s mba
    | SplitOnSuffixSeqKRLoop fs s mba !rh !ck
    | SplitOnSuffixSeqKRCheck fs s mba !rh
    | SplitOnSuffixSeqKRDone Int !fs rb

    | SplitOnSuffixSeqReinit
          (fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x)

-- | @splitOnSuffixSeq withSep pat fld input@ splits the input using @pat@ as a
-- suffixed separator, the resulting split segments are fed to the fold @fld@.
-- If @withSep@ is True then the separator sequence is also suffixed with the
-- split segments.
--
-- /Internal/
{-# INLINE_NORMAL splitOnSuffixSeq #-}
splitOnSuffixSeq
    :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a)
    => Bool
    -> Array a
    -> Fold m a b
    -> Stream m a
    -> Stream m b
splitOnSuffixSeq :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a, Enum a, Eq a) =>
Bool -> Array a -> Fold m a b -> Stream m a -> Stream m b
splitOnSuffixSeq Bool
withSep Array a
patArr (Fold s -> a -> m (Step s b)
fstep m (Step s b)
initial s -> m b
_ s -> m b
final) (Stream State StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m b
 -> SplitOnSuffixSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {m :: * -> *} {a}.
State StreamK m a
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
stepOuter SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqInit

    where

    patLen :: Int
patLen = Array a -> Int
forall a. Unbox a => Array a -> Int
A.length Array a
patArr
    patBytes :: Int
patBytes = Array a -> Int
forall a. Array a -> Int
A.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)
    elemBits :: Int
elemBits = SIZE_OF(a) * 8

    -- For word pattern case
    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
A.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)

    nextAfterInit :: (fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x)
-> Step fs b -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
nextAfterInit fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
nextGen Step fs b
stepRes =
        case Step fs b
stepRes of
            FL.Partial fs
s -> fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
nextGen fs
s
            FL.Done b
b ->
                b
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqYield b
b ((fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x)
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
(fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x)
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqReinit fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
nextGen)

    {-# INLINE yieldReinit #-}
    yieldReinit :: (s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s -> SplitOnSuffixSeqState mba rb rh ck w s s b x
nextGen b
fs =
        m (Step s b)
initial m (Step s b)
-> (Step s b
    -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a))
-> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SplitOnSuffixSeqState mba rb rh ck w s s b x
-> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState mba rb rh ck w s s b x
 -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a))
-> (Step s b -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> Step s b
-> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b
-> SplitOnSuffixSeqState mba rb rh ck w s s b x
-> SplitOnSuffixSeqState mba rb rh ck w s s b x
forall mba rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqYield b
fs (SplitOnSuffixSeqState mba rb rh ck w s s b x
 -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> (Step s b -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> Step s b
-> SplitOnSuffixSeqState mba rb rh ck w s s b x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> Step s b -> SplitOnSuffixSeqState mba rb rh ck w s s b x
forall {fs} {mba} {rb} {rh} {ck} {w} {s} {b} {x}.
(fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x)
-> Step fs b -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
nextAfterInit s -> SplitOnSuffixSeqState mba rb rh ck w s s b x
nextGen

    -- For single element pattern case
    {-# INLINE processYieldSingle #-}
    processYieldSingle :: a
-> a
-> s
-> s
-> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b a) a)
processYieldSingle a
pat a
x s
s s
fs = do
        let jump :: fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b a
jump fs
c = fs -> s -> a -> SplitOnSuffixSeqState mba rb rh ck w fs s b a
forall mba rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqSingleInit fs
c s
s a
pat
        if a
pat a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x
        then do
            Step s b
r <- if Bool
withSep then s -> a -> m (Step s b)
fstep s
fs a
x else 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
FL.Partial s
fs
            b
b1 <-
                case Step s b
r of
                    FL.Partial s
fs1 -> s -> m b
final s
fs1
                    FL.Done b
b -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
            (s -> SplitOnSuffixSeqState mba rb rh ck w s s b a)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b a) a)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s -> SplitOnSuffixSeqState mba rb rh ck w s s b a
forall {fs} {mba} {rb} {rh} {ck} {w} {b}.
fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b a
jump b
b1
        else do
            Step s b
r <- s -> a -> m (Step s b)
fstep s
fs a
x
            case Step s b
r of
                FL.Partial s
fs1 -> SplitOnSuffixSeqState mba rb rh ck w s s b a
-> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b a) a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState mba rb rh ck w s s b a
 -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b a) a))
-> SplitOnSuffixSeqState mba rb rh ck w s s b a
-> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b a) a)
forall a b. (a -> b) -> a -> b
$ s -> s -> a -> SplitOnSuffixSeqState mba rb rh ck w s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqSingle s
fs1 s
s a
pat
                FL.Done b
b -> (s -> SplitOnSuffixSeqState mba rb rh ck w s s b a)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b a) a)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s -> SplitOnSuffixSeqState mba rb rh ck w s s b a
forall {fs} {mba} {rb} {rh} {ck} {w} {b}.
fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b a
jump b
b

    -- 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?
    patHash :: Word32
patHash = (Word32 -> a -> Word32) -> Word32 -> Array a -> Word32
forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b
A.foldl' Word32 -> a -> Word32
forall {a}. Enum a => Word32 -> a -> Word32
addCksum Word32
0 Array a
patArr

    skip :: a -> m (Step a a)
skip = Step a a -> m (Step a a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step a a -> m (Step a a)) -> (a -> Step a a) -> a -> m (Step a a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Step a a
forall s a. s -> Step s a
Skip

    {-# INLINE_LATE stepOuter #-}
    stepOuter :: State StreamK m a
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
stepOuter State StreamK m a
_ SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
SplitOnSuffixSeqInit = do
        Step s b
res <- m (Step s b)
initial
        case Step s b
res of
            FL.Partial s
fs
                | Int
patLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ->
                    SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqEmpty s
fs s
state
                | 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
A.unsafeGetIndexIO Int
0 Array a
patArr
                    SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> a
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqSingleInit s
fs s
state a
pat
                | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->
                    SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqWordInit s
fs s
state
                | 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)
MutArray.emptyOf Int
patLen
                    SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> MutByteArray
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> mba -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRInit s
fs s
state MutByteArray
mba
            FL.Done b
fb -> SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqYield b
fb SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqInit

    stepOuter State StreamK m a
_ (SplitOnSuffixSeqYield b
x SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
next) = Step
  (SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (SplitOnSuffixSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
   b
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> Step
     (SplitOnSuffixSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> Step
     (SplitOnSuffixSeqState
        MutByteArray (RingArray a) Int Word32 Word s s b a)
     b
forall s a. a -> s -> Step s a
Yield b
x SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
next

    ---------------------------
    -- Reinit
    ---------------------------

    stepOuter State StreamK m a
_ (SplitOnSuffixSeqReinit s
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
nextGen) =
        m (Step s b)
initial m (Step s b)
-> (Step s b
    -> m (Step
            (SplitOnSuffixSeqState
               MutByteArray (RingArray a) Int Word32 Word s s b a)
            b))
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> (Step s b
    -> SplitOnSuffixSeqState
         MutByteArray (RingArray a) Int Word32 Word s s b a)
-> Step s b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s
 -> SplitOnSuffixSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
-> Step s b
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall {fs} {mba} {rb} {rh} {ck} {w} {s} {b} {x}.
(fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x)
-> Step fs b -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
nextAfterInit s
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
nextGen

    ---------------------------
    -- Empty pattern
    ---------------------------

    stepOuter State StreamK m a
gst (SplitOnSuffixSeqEmpty s
acc s
st) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                let jump :: fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
jump fs
c = fs -> s -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqEmpty fs
c s
s
                Step s b
r <- s -> a -> m (Step s b)
fstep s
acc a
x
                b
b1 <-
                    case Step s b
r of
                        FL.Partial s
fs -> s -> m b
final s
fs
                        FL.Done b
b -> b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
                (s
 -> SplitOnSuffixSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall {fs} {mba} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
jump b
b1
            Skip s
s -> SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (s
-> s
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqEmpty s
acc s
s)
            Step s a
Stop -> s -> m b
final s
acc m b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step
  (SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
forall s a. Step s a
Stop

    -----------------
    -- Done
    -----------------

    stepOuter State StreamK m a
_ SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
SplitOnSuffixSeqDone = Step
  (SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
forall s a. Step s a
Stop

    -----------------
    -- Single Pattern
    -----------------

    stepOuter State StreamK m a
gst (SplitOnSuffixSeqSingleInit s
fs s
st a
pat) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> a
-> a
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {s} {mba} {rb} {rh} {ck} {w} {a}.
a
-> a
-> s
-> s
-> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b a) a)
processYieldSingle a
pat a
x s
s s
fs
            Skip s
s -> SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> a
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqSingleInit s
fs s
s a
pat
            Step s a
Stop -> s -> m b
final s
fs m b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step
  (SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
forall s a. Step s a
Stop

    stepOuter State StreamK m a
gst (SplitOnSuffixSeqSingle s
fs s
st a
pat) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> a
-> a
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {s} {mba} {rb} {rh} {ck} {w} {a}.
a
-> a
-> s
-> s
-> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b a) a)
processYieldSingle a
pat a
x s
s s
fs
            Skip s
s -> SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> a
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqSingle s
fs s
s a
pat
            Step s a
Stop -> do
                b
r <- s -> m b
final s
fs
                SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqYield b
r SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqDone

    ---------------------------
    -- Short Pattern - Shift Or
    ---------------------------

    stepOuter State StreamK m a
_ (SplitOnSuffixSeqWordDone Int
0 s
fs Word
_) = do
        b
r <- s -> m b
final s
fs
        SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqYield b
r SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqDone
    stepOuter State StreamK m a
_ (SplitOnSuffixSeqWordDone Int
n s
fs Word
wrd) = 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
fs (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
            FL.Partial s
fs1 -> SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> Word
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqWordDone (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) s
fs1 Word
wrd
            FL.Done b
b -> do
                let jump :: fs -> SplitOnSuffixSeqState mba rb rh ck Word fs s b x
jump fs
c = Int
-> fs -> Word -> SplitOnSuffixSeqState mba rb rh ck Word fs s b x
forall mba rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqWordDone (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) fs
c Word
wrd
                (s
 -> SplitOnSuffixSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall {fs} {mba} {rb} {rh} {ck} {s} {b} {x}.
fs -> SplitOnSuffixSeqState mba rb rh ck Word fs s b x
jump b
b

    stepOuter State StreamK m a
gst (SplitOnSuffixSeqWordInit s
fs0 s
st0) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st0
        case Step s a
res of
            Yield a
x s
s -> do
                let wrd :: Word
wrd = Word -> a -> Word
forall {a} {a}. (Bits a, Num a, Enum a) => a -> a -> a
addToWord Word
0 a
x
                Step s b
r <- if Bool
withSep then s -> a -> m (Step s b)
fstep s
fs0 a
x else 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
FL.Partial s
fs0
                case Step s b
r of
                    FL.Partial s
fs1 -> SPEC
-> Int
-> Word
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {x} {a}.
SPEC
-> Int
-> Word
-> s
-> s
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
go SPEC
SPEC Int
1 Word
wrd s
s s
fs1
                    FL.Done b
b -> do
                        let jump :: fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
jump fs
c = fs -> s -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqWordInit fs
c s
s
                        (s
 -> SplitOnSuffixSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall {fs} {mba} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
jump b
b
            Skip s
s -> SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (s
-> s
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqWordInit s
fs0 s
s)
            Step s a
Stop -> s -> m b
final s
fs0 m b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step
  (SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
forall s a. Step s a
Stop

        where

        {-# INLINE go #-}
        go :: SPEC
-> Int
-> Word
-> s
-> s
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
go !SPEC
_ !Int
idx !Word
wrd !s
st !s
fs = do
            Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    let jump :: fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
jump fs
c = fs -> s -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqWordInit fs
c s
s
                    let wrd1 :: Word
wrd1 = Word -> a -> Word
forall {a} {a}. (Bits a, Num a, Enum a) => a -> a -> a
addToWord Word
wrd a
x
                    Step s b
r <- if Bool
withSep then s -> a -> m (Step s b)
fstep s
fs a
x else 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
FL.Partial s
fs
                    case Step s b
r of
                        FL.Partial s
fs1
                            | Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
maxIndex ->
                                SPEC
-> Int
-> Word
-> s
-> s
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
go SPEC
SPEC (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Word
wrd1 s
s s
fs1
                            | 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 ->
                                SplitOnSuffixSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState mba rb rh ck Word s s b x
 -> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a))
-> SplitOnSuffixSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ Word -> s -> s -> SplitOnSuffixSeqState mba rb rh ck Word s s b x
forall mba rb rh ck w fs s b x.
w -> s -> fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqWordLoop Word
wrd1 s
s s
fs1
                            | Bool
otherwise ->
                                s -> m b
final s
fs1 m b
-> (b
    -> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a))
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s -> SplitOnSuffixSeqState mba rb rh ck Word s s b x)
-> b
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s -> SplitOnSuffixSeqState mba rb rh ck Word s s b x
forall {fs} {mba} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
jump
                        FL.Done b
b -> (s -> SplitOnSuffixSeqState mba rb rh ck Word s s b x)
-> b
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s -> SplitOnSuffixSeqState mba rb rh ck Word s s b x
forall {fs} {mba} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
jump b
b
                Skip s
s -> SPEC
-> Int
-> Word
-> s
-> s
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
go SPEC
SPEC Int
idx Word
wrd s
s s
fs
                Step s a
Stop ->
                    if Bool
withSep
                    then do
                        b
r <- s -> m b
final s
fs
                        SplitOnSuffixSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState mba rb rh ck Word s s b x
 -> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a))
-> SplitOnSuffixSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState mba rb rh ck Word s s b x
-> SplitOnSuffixSeqState mba rb rh ck Word s s b x
forall mba rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqYield b
r SplitOnSuffixSeqState mba rb rh ck Word s s b x
forall mba rb rh ck w fs s b x.
SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqDone
                    else SplitOnSuffixSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState mba rb rh ck Word s s b x
 -> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a))
-> SplitOnSuffixSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Word -> SplitOnSuffixSeqState mba rb rh ck Word s s b x
forall mba rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqWordDone Int
idx s
fs Word
wrd

    stepOuter State StreamK m a
gst (SplitOnSuffixSeqWordLoop Word
wrd0 s
st0 s
fs0) =
        SPEC
-> Word
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {x} {a}.
SPEC
-> Word
-> s
-> s
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
go SPEC
SPEC Word
wrd0 s
st0 s
fs0

        where

        {-# INLINE go #-}
        go :: SPEC
-> Word
-> s
-> s
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
go !SPEC
_ !Word
wrd !s
st !s
fs = do
            Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    let jump :: fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
jump fs
c = fs -> s -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqWordInit fs
c s
s
                        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
r <-
                        if Bool
withSep
                        then s -> a -> m (Step s b)
fstep s
fs a
x
                        else s -> a -> m (Step s b)
fstep s
fs (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
                        FL.Partial s
fs1 ->
                            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 s -> m b
final s
fs1 m b
-> (b
    -> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a))
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s -> SplitOnSuffixSeqState mba rb rh ck Word s s b x)
-> b
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s -> SplitOnSuffixSeqState mba rb rh ck Word s s b x
forall {fs} {mba} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
jump
                            else SPEC
-> Word
-> s
-> s
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
go SPEC
SPEC Word
wrd1 s
s s
fs1
                        FL.Done b
b -> (s -> SplitOnSuffixSeqState mba rb rh ck Word s s b x)
-> b
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s -> SplitOnSuffixSeqState mba rb rh ck Word s s b x
forall {fs} {mba} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
jump b
b
                Skip s
s -> SPEC
-> Word
-> s
-> s
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
go SPEC
SPEC Word
wrd s
s s
fs
                Step s a
Stop ->
                    if Bool
withSep
                    then do
                        b
r <- s -> m b
final s
fs
                        SplitOnSuffixSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState mba rb rh ck Word s s b x
 -> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a))
-> SplitOnSuffixSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState mba rb rh ck Word s s b x
-> SplitOnSuffixSeqState mba rb rh ck Word s s b x
forall mba rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqYield b
r SplitOnSuffixSeqState mba rb rh ck Word s s b x
forall mba rb rh ck w fs s b x.
SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqDone
                    else SplitOnSuffixSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState mba rb rh ck Word s s b x
 -> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a))
-> SplitOnSuffixSeqState mba rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState mba rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Word -> SplitOnSuffixSeqState mba rb rh ck Word s s b x
forall mba rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqWordDone Int
patLen s
fs Word
wrd

    -------------------------------
    -- General Pattern - Karp Rabin
    -------------------------------

    stepOuter State StreamK m a
gst (SplitOnSuffixSeqKRInit s
fs s
st0 MutByteArray
mba) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st0
        case Step s a
res of
            Yield a
x s
s -> 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
0 MutByteArray
mba a
x
                Step s b
r <- if Bool
withSep then s -> a -> m (Step s b)
fstep s
fs a
x else 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
FL.Partial s
fs
                case Step s b
r of
                    FL.Partial s
fs1 ->
                        SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> MutByteArray
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> mba -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRInit1 s
fs1 s
s MutByteArray
mba
                    FL.Done b
b -> do
                        let jump :: fs -> SplitOnSuffixSeqState MutByteArray rb rh ck w fs s b x
jump fs
c = fs
-> s
-> MutByteArray
-> SplitOnSuffixSeqState MutByteArray rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
fs -> s -> mba -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRInit fs
c s
s MutByteArray
mba
                        (s
 -> SplitOnSuffixSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall {fs} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSuffixSeqState MutByteArray rb rh ck w fs s b x
jump b
b
            Skip s
s -> SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> MutByteArray
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs -> s -> mba -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRInit s
fs s
s MutByteArray
mba
            Step s a
Stop -> s -> m b
final s
fs m b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step
  (SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a)
  b
forall s a. Step s a
Stop

    stepOuter State StreamK m a
gst (SplitOnSuffixSeqKRInit1 s
fs0 s
st0 MutByteArray
mba) = do
        SPEC
-> Int
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {rh} {a} {w} {x} {a}.
Num rh =>
SPEC
-> Int
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
go SPEC
SPEC (SIZE_OF(a)) st0 fs0

        where

        go :: SPEC
-> Int
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
go !SPEC
_ !Int
offset s
st !s
fs = do
            Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            let Array a
arr :: Array a = Array
                        { arrContents :: MutByteArray
arrContents = MutByteArray
mba
                        , arrStart :: Int
arrStart = Int
0
                        , arrEnd :: Int
arrEnd = Int
patBytes
                        }
            case Step s a
res of
                Yield a
x s
s -> 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
                    Step s b
r <- if Bool
withSep then s -> a -> m (Step s b)
fstep s
fs a
x else 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
FL.Partial s
fs
                    let ringHash :: Word32
ringHash = (Word32 -> a -> Word32) -> Word32 -> Array a -> Word32
forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b
A.foldl' Word32 -> a -> Word32
forall {a}. Enum a => Word32 -> a -> Word32
addCksum Word32
0 Array a
arr
                    case Step s b
r of
                        FL.Partial s
fs1
                            | Int
offset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
maxOffset ->
                                SPEC
-> Int
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
go SPEC
SPEC (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ SIZE_OF(a)) s fs1
                            | Word32
ringHash Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
patHash ->
                                SplitOnSuffixSeqState
  MutByteArray (RingArray a) rh Word32 w s s b x
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) rh Word32 w s s b x
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) rh Word32 w s s b x)
         a))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) rh Word32 w s s b x
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> MutByteArray
-> rh
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) rh Word32 w s s b x
forall mba rb rh ck w fs s b x.
fs
-> s -> mba -> rh -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRCheck s
fs1 s
s MutByteArray
mba rh
0
                            | Bool
otherwise ->
                                SplitOnSuffixSeqState
  MutByteArray (RingArray a) rh Word32 w s s b x
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) rh Word32 w s s b x
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) rh Word32 w s s b x)
         a))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) rh Word32 w s s b x
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> MutByteArray
-> rh
-> Word32
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) rh Word32 w s s b x
forall mba rb rh ck w fs s b x.
fs
-> s
-> mba
-> rh
-> ck
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRLoop
                                    s
fs1 s
s MutByteArray
mba rh
0 Word32
ringHash
                        FL.Done b
b -> do
                            let jump :: fs -> SplitOnSuffixSeqState MutByteArray rb rh ck w fs s b x
jump fs
c = fs
-> s
-> MutByteArray
-> SplitOnSuffixSeqState MutByteArray rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
fs -> s -> mba -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRInit fs
c s
s MutByteArray
mba
                            (s
 -> SplitOnSuffixSeqState
      MutByteArray (RingArray a) rh Word32 w s s b x)
-> b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) rh Word32 w s s b x
forall {fs} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSuffixSeqState MutByteArray rb rh ck w fs s b x
jump b
b
                Skip s
s -> SPEC
-> Int
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
go SPEC
SPEC Int
offset s
s s
fs
                Step s a
Stop -> do
                    -- do not issue a blank segment when we end at pattern
                    if Int
offset Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxOffset Bool -> Bool -> Bool
&& Array a -> Array a -> Bool
forall a. Array a -> Array a -> Bool
A.byteEq Array a
arr Array a
patArr
                    then s -> m b
final s
fs m b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Step
  (SplitOnSuffixSeqState
     MutByteArray (RingArray a) rh Word32 w s s b x)
  a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (SplitOnSuffixSeqState
     MutByteArray (RingArray a) rh Word32 w s s b x)
  a
forall s a. Step s a
Stop
                    else if Bool
withSep
                    then do
                        b
r <- s -> m b
final s
fs
                        SplitOnSuffixSeqState
  MutByteArray (RingArray a) rh Word32 w s s b x
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) rh Word32 w s s b x
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) rh Word32 w s s b x)
         a))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) rh Word32 w s s b x
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) rh Word32 w s s b x
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) rh Word32 w s s b x
forall mba rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqYield b
r SplitOnSuffixSeqState
  MutByteArray (RingArray a) rh Word32 w s s b x
forall mba rb rh ck w fs s b x.
SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqDone
                    else do
                        let rb :: RingArray a
rb = RingArray
                                { ringContents :: MutByteArray
ringContents = MutByteArray
mba
                                , ringSize :: Int
ringSize = Int
offset
                                , ringHead :: Int
ringHead = Int
0
                                }
                         in SplitOnSuffixSeqState
  MutByteArray (RingArray a) rh Word32 w s s b x
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) rh Word32 w s s b x
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) rh Word32 w s s b x)
         a))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) rh Word32 w s s b x
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) rh Word32 w s s b x)
        a)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> RingArray a
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) rh Word32 w s s b x
forall mba rb rh ck w fs s b x.
Int -> fs -> rb -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRDone Int
offset s
fs RingArray a
forall {a}. RingArray a
rb

    stepOuter State StreamK m a
gst (SplitOnSuffixSeqKRLoop s
fs0 s
st0 MutByteArray
mba Int
rh0 Word32
cksum0) =
        SPEC
-> s
-> s
-> Int
-> Word32
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {ck} {w} {x} {a}.
SPEC
-> s
-> s
-> Int
-> Word32
-> m (Step
        (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x)
        a)
go SPEC
SPEC s
fs0 s
st0 Int
rh0 Word32
cksum0

        where

        go :: SPEC
-> s
-> s
-> Int
-> Word32
-> m (Step
        (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x)
        a)
go !SPEC
_ !s
fs !s
st !Int
rh !Word32
cksum = do
            Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            let rb :: RingArray a
rb = RingArray
                    { ringContents :: MutByteArray
ringContents = MutByteArray
mba
                    , ringSize :: Int
ringSize = Int
patBytes
                    , ringHead :: Int
ringHead = Int
rh
                    }
            case Step s a
res of
                Yield a
x s
s -> do
                    (RingArray a
rb1, a
old) <- 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)
RB.replace RingArray a
forall {a}. RingArray a
rb a
x)
                    let cksum1 :: Word32
cksum1 = 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
                    Step s b
r <- if Bool
withSep then s -> a -> m (Step s b)
fstep s
fs a
x else s -> a -> m (Step s b)
fstep s
fs a
old
                    case Step s b
r of
                        FL.Partial s
fs1 ->
                            if Word32
cksum1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
patHash
                            then SPEC
-> s
-> s
-> Int
-> Word32
-> m (Step
        (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x)
        a)
go SPEC
SPEC s
fs1 s
s Int
rh1 Word32
cksum1
                            else SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x
-> m (Step
        (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x)
        a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x
 -> m (Step
         (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x)
         a))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int ck w s s b x
-> m (Step
        (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x)
        a)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> MutByteArray
-> Int
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int ck w s s b x
forall mba rb rh ck w fs s b x.
fs
-> s -> mba -> rh -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRCheck s
fs1 s
s MutByteArray
mba Int
rh1
                        FL.Done b
b -> do
                            let jump :: fs -> SplitOnSuffixSeqState MutByteArray rb rh ck w fs s b x
jump fs
c = fs
-> s
-> MutByteArray
-> SplitOnSuffixSeqState MutByteArray rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
fs -> s -> mba -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRInit fs
c s
s MutByteArray
mba
                            (s
 -> SplitOnSuffixSeqState
      MutByteArray (RingArray a) Int ck w s s b x)
-> b
-> m (Step
        (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x)
        a)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int ck w s s b x
forall {fs} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSuffixSeqState MutByteArray rb rh ck w fs s b x
jump b
b
                Skip s
s -> SPEC
-> s
-> s
-> Int
-> Word32
-> m (Step
        (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x)
        a)
go SPEC
SPEC s
fs s
s Int
rh Word32
cksum
                Step s a
Stop -> do
                    if Bool
withSep
                    then do
                        b
r <- s -> m b
final s
fs
                        SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x
-> m (Step
        (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x)
        a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x
 -> m (Step
         (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x)
         a))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int ck w s s b x
-> m (Step
        (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x)
        a)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int ck w s s b x
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int ck w s s b x
forall mba rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqYield b
r SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x
forall mba rb rh ck w fs s b x.
SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqDone
                    else SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x
-> m (Step
        (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x)
        a)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x
 -> m (Step
         (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x)
         a))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int ck w s s b x
-> m (Step
        (SplitOnSuffixSeqState MutByteArray (RingArray a) Int ck w s s b x)
        a)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> RingArray a
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int ck w s s b x
forall mba rb rh ck w fs s b x.
Int -> fs -> rb -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRDone Int
patBytes s
fs RingArray a
forall {a}. RingArray a
rb

    stepOuter State StreamK m a
_ (SplitOnSuffixSeqKRCheck s
fs s
st MutByteArray
mba Int
rh) = do
        let rb :: RingArray a
rb = RingArray
                    { ringContents :: MutByteArray
ringContents = MutByteArray
mba
                    , ringSize :: Int
ringSize = Int
patBytes
                    , ringHead :: Int
ringHead = Int
rh
                    }
        Bool
matches <- 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
RB.eqArray RingArray a
forall {a}. RingArray a
rb Array a
patArr
        if Bool
matches
        then do
            b
r <- s -> m b
final s
fs
            let jump :: fs -> SplitOnSuffixSeqState MutByteArray rb rh ck w fs s b x
jump fs
c = fs
-> s
-> MutByteArray
-> SplitOnSuffixSeqState MutByteArray rb rh ck w fs s b x
forall mba rb rh ck w fs s b x.
fs -> s -> mba -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRInit fs
c s
st MutByteArray
mba
            (s
 -> SplitOnSuffixSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall {fs} {rb} {rh} {ck} {w} {b} {x}.
fs -> SplitOnSuffixSeqState MutByteArray rb rh ck w fs s b x
jump b
r
        else SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> MutByteArray
-> Int
-> Word32
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
fs
-> s
-> mba
-> rh
-> ck
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRLoop s
fs s
st MutByteArray
mba Int
rh Word32
patHash

    stepOuter State StreamK m a
_ (SplitOnSuffixSeqKRDone Int
0 s
fs RingArray a
_) = do
        b
r <- s -> m b
final s
fs
        SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
-> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqYield b
r SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqDone
    stepOuter State StreamK m a
_ (SplitOnSuffixSeqKRDone Int
len s
fs RingArray a
rb) = do
        Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        a
old <- RingArray a -> m a
forall (m :: * -> *) a. (MonadIO m, Unbox a) => RingArray a -> m a
RB.unsafeGetHead RingArray a
rb
        let rb1 :: RingArray a
rb1 = RingArray a -> RingArray a
forall a. Unbox a => RingArray a -> RingArray a
RB.moveForward RingArray a
rb
        Step s b
r <- s -> a -> m (Step s b)
fstep s
fs a
old
        case Step s b
r of
            FL.Partial s
fs1 ->
                SplitOnSuffixSeqState
  MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {a} {a}. a -> m (Step a a)
skip (SplitOnSuffixSeqState
   MutByteArray (RingArray a) Int Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState
            MutByteArray (RingArray a) Int Word32 Word s s b a)
         b))
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> RingArray a
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall mba rb rh ck w fs s b x.
Int -> fs -> rb -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRDone (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- SIZE_OF(a)) fs1 rb1
            FL.Done b
b -> do
                let jump :: fs -> SplitOnSuffixSeqState mba (RingArray a) rh ck w fs s b x
jump fs
c = Int
-> fs
-> RingArray a
-> SplitOnSuffixSeqState mba (RingArray a) rh ck w fs s b x
forall mba rb rh ck w fs s b x.
Int -> fs -> rb -> SplitOnSuffixSeqState mba rb rh ck w fs s b x
SplitOnSuffixSeqKRDone (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- SIZE_OF(a)) c rb1
                (s
 -> SplitOnSuffixSeqState
      MutByteArray (RingArray a) Int Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSuffixSeqState
           MutByteArray (RingArray a) Int Word32 Word s s b a)
        b)
forall {mba} {rb} {rh} {ck} {w} {s} {x} {a}.
(s -> SplitOnSuffixSeqState mba rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState mba rb rh ck w s s b x) a)
yieldReinit s
-> SplitOnSuffixSeqState
     MutByteArray (RingArray a) Int Word32 Word s s b a
forall {fs} {mba} {rh} {ck} {w} {s} {b} {x}.
fs -> SplitOnSuffixSeqState mba (RingArray a) rh ck w fs s b x
jump b
b

-- | Parses a sequence of tokens suffixed by a separator e.g. @a;b;c;@ is
-- parsed as @a;@, @b;@, @c;@. If the pattern is empty the input stream is
-- returned as it is.
--
-- Equivalent to the following:
--
-- >>> splitEndBySeq pat f = Stream.foldMany (Fold.takeEndBySeq pat f)
--
-- Usage:
--
-- >>> f p = Stream.splitEndBySeq (Array.fromList p) Fold.toList
-- >>> splitEndBy p xs = Stream.fold Fold.toList $ f p (Stream.fromList xs)
--
-- >>> splitEndBy "" ""
-- []
--
-- >>> splitEndBy "" "a...b"
-- ["a",".",".",".","b"]
--
-- >>> splitEndBy ".." ""
-- []
--
--
-- >>> splitEndBy ".." "a...b"
-- ["a..",".b"]
--
--
-- >>> splitEndBy ".." "abc"
-- ["abc"]
--
-- >>> splitEndBy ".." ".."
-- [".."]
--
-- >>> splitEndBy "." ".a"
-- [".","a"]
--
-- >>> splitEndBy "." "a."
-- ["a."]
--
-- Uses Rabin-Karp algorithm for substring search.
--
{-# INLINE_NORMAL splitEndBySeq #-}
splitEndBySeq
    :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a)
    => Array a
    -> Fold m a b
    -> Stream m a
    -> Stream m b
splitEndBySeq :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a, Enum a, Eq a) =>
Array a -> Fold m a b -> Stream m a -> Stream m b
splitEndBySeq = Bool -> Array a -> Fold m a b -> Stream m a -> Stream m b
forall (m :: * -> *) a b.
(MonadIO m, Unbox a, Enum a, Eq a) =>
Bool -> Array a -> Fold m a b -> Stream m a -> Stream m b
splitOnSuffixSeq Bool
True

-- | Like 'splitEndBySeq' but drops the separators and returns only the tokens.
--
-- Equivalent to the following:
--
-- >>> splitEndBySeq_ pat f = Stream.foldMany (Fold.takeEndBySeq_ pat f)
--
-- Usage:
--
-- >>> f p = Stream.splitEndBySeq_ (Array.fromList p) Fold.toList
-- >>> splitEndBy_ p xs = Stream.fold Fold.toList $ f p (Stream.fromList xs)
--
-- >>> splitEndBy_ "" ""
-- []
--
-- >>> splitEndBy_ "" "a...b"
-- ["a",".",".",".","b"]
--
-- >>> splitEndBy_ ".." ""
-- []
--
-- >>> splitEndBy_ ".." "a...b"
-- ["a",".b"]
--
-- >>> splitEndBy_ ".." "abc"
-- ["abc"]
--
-- >>> splitEndBy_ ".." ".."
-- [""]
--
-- >>> splitEndBy_ "." ".a"
-- ["","a"]
--
-- >>> splitEndBy_ "." "a."
-- ["a"]
--
-- Uses Rabin-Karp algorithm for substring search.
--
{-# INLINE_NORMAL splitEndBySeq_ #-}
splitEndBySeq_
    :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a)
    => Array a
    -> Fold m a b
    -> Stream m a
    -> Stream m b
splitEndBySeq_ :: forall (m :: * -> *) a b.
(MonadIO m, Unbox a, Enum a, Eq a) =>
Array a -> Fold m a b -> Stream m a -> Stream m b
splitEndBySeq_ = Bool -> Array a -> Fold m a b -> Stream m a -> Stream m b
forall (m :: * -> *) a b.
(MonadIO m, Unbox a, Enum a, Eq a) =>
Bool -> Array a -> Fold m a b -> Stream m a -> Stream m b
splitOnSuffixSeq Bool
False

-- Implement this as a fold or a parser instead.
-- This can be implemented easily using Rabin Karp

-- | Split post any one of the given patterns.
--
-- /Unimplemented/
{-# INLINE splitEndBySeqOneOf #-}
splitEndBySeqOneOf :: -- (Monad m, Unboxed a, Integral a) =>
    [Array a] -> Fold m a b -> Stream m a -> Stream m b
splitEndBySeqOneOf :: forall a (m :: * -> *) b.
[Array a] -> Fold m a b -> Stream m a -> Stream m b
splitEndBySeqOneOf [Array a]
_subseq Fold m a b
_f Stream m a
_m = Stream m b
forall a. HasCallStack => a
undefined

-- | Split on a prefixed separator element, dropping the separator.  The
-- supplied 'Fold' is applied on the split segments.
--
-- @
-- > splitOnPrefix' p xs = Stream.toList $ Stream.splitOnPrefix p (Fold.toList) (Stream.fromList xs)
-- > splitOnPrefix' (== '.') ".a.b"
-- ["a","b"]
-- @
--
-- An empty stream results in an empty output stream:
-- @
-- > splitOnPrefix' (== '.') ""
-- []
-- @
--
-- An empty segment consisting of only a prefix is folded to the default output
-- of the fold:
--
-- @
-- > splitOnPrefix' (== '.') "."
-- [""]
--
-- > splitOnPrefix' (== '.') ".a.b."
-- ["a","b",""]
--
-- > splitOnPrefix' (== '.') ".a..b"
-- ["a","","b"]
--
-- @
--
-- A prefix is optional at the beginning of the stream:
--
-- @
-- > splitOnPrefix' (== '.') "a"
-- ["a"]
--
-- > splitOnPrefix' (== '.') "a.b"
-- ["a","b"]
-- @
--
-- 'splitOnPrefix' is an inverse of 'intercalatePrefix' with a single element:
--
-- > Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList . Stream.splitOnPrefix (== '.') Fold.toList === id
--
-- Assuming the input stream does not contain the separator:
--
-- > Stream.splitOnPrefix (== '.') Fold.toList . Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList === id
--
-- /Unimplemented/
{-# INLINE splitBeginBy_ #-}
splitBeginBy_ :: -- (MonadCatch m) =>
    (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
splitBeginBy_ :: forall a (m :: * -> *) b.
(a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
splitBeginBy_ a -> Bool
_predicate Fold m a b
_f = Stream m a -> Stream m b
forall a. HasCallStack => a
undefined
    -- parseMany (Parser.sliceBeginBy predicate f)

-- Int list examples for splitOn:
--
-- >>> splitList [] [1,2,3,3,4]
-- > [[1],[2],[3],[3],[4]]
--
-- >>> splitList [5] [1,2,3,3,4]
-- > [[1,2,3,3,4]]
--
-- >>> splitList [1] [1,2,3,3,4]
-- > [[],[2,3,3,4]]
--
-- >>> splitList [4] [1,2,3,3,4]
-- > [[1,2,3,3],[]]
--
-- >>> splitList [2] [1,2,3,3,4]
-- > [[1],[3,3,4]]
--
-- >>> splitList [3] [1,2,3,3,4]
-- > [[1,2],[],[4]]
--
-- >>> splitList [3,3] [1,2,3,3,4]
-- > [[1,2],[4]]
--
-- >>> splitList [1,2,3,3,4] [1,2,3,3,4]
-- > [[],[]]

-- This can be implemented easily using Rabin Karp
-- | Split on any one of the given patterns.
--
-- /Unimplemented/
--
{-# INLINE splitSepBySeqOneOf #-}
splitSepBySeqOneOf :: -- (Monad m, Unboxed a, Integral a) =>
    [Array a] -> Fold m a b -> Stream m a -> Stream m b
splitSepBySeqOneOf :: forall a (m :: * -> *) b.
[Array a] -> Fold m a b -> Stream m a -> Stream m b
splitSepBySeqOneOf [Array a]
_subseq Fold m a b
_f Stream m a
_m =
    Stream m b
forall a. HasCallStack => a
undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m)

------------------------------------------------------------------------------
-- Nested Container Transformation
------------------------------------------------------------------------------

{-# ANN type SplitState Fuse #-}
data SplitState s arr
    = SplitInitial s
    | SplitBuffering s arr
    | SplitSplitting s arr
    | SplitYielding arr (SplitState s arr)
    | SplitFinishing

-- XXX An alternative approach would be to use a partial fold (Fold m a b) to
-- split using a splitBy like combinator. The Fold would consume upto the
-- separator and return any leftover which can then be fed to the next fold.
--
-- We can revisit this once we have partial folds/parsers.
--
-- | Performs infix separator style splitting.
{-# INLINE_NORMAL splitInnerBy #-}
splitInnerBy
    :: Monad m
    => (f a -> m (f a, Maybe (f a)))  -- splitter
    -> (f a -> f a -> m (f a))        -- joiner
    -> Stream m (f a)
    -> Stream m (f a)
splitInnerBy :: forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
(f a -> m (f a, Maybe (f a)))
-> (f a -> f a -> m (f a)) -> Stream m (f a) -> Stream m (f a)
splitInnerBy f a -> m (f a, Maybe (f a))
splitter f a -> f a -> m (f a)
joiner (Stream State StreamK m (f a) -> s -> m (Step s (f a))
step1 s
state1) =
    (State StreamK m (f a)
 -> SplitState s (f a) -> m (Step (SplitState s (f a)) (f a)))
-> SplitState s (f a) -> Stream m (f a)
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m (f a)
-> SplitState s (f a) -> m (Step (SplitState s (f a)) (f a))
step (s -> SplitState s (f a)
forall s arr. s -> SplitState s arr
SplitInitial s
state1)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m (f a)
-> SplitState s (f a) -> m (Step (SplitState s (f a)) (f a))
step State StreamK m (f a)
gst (SplitInitial s
st) = do
        Step s (f a)
r <- State StreamK m (f a) -> s -> m (Step s (f a))
step1 State StreamK m (f a)
gst s
st
        case Step s (f a)
r of
            Yield f a
x s
s -> do
                (f a
x1, Maybe (f a)
mx2) <- f a -> m (f a, Maybe (f a))
splitter f a
x
                Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (f a)) (f a)
 -> m (Step (SplitState s (f a)) (f a)))
-> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a b. (a -> b) -> a -> b
$ case Maybe (f a)
mx2 of
                    Maybe (f a)
Nothing -> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (s -> f a -> SplitState s (f a)
forall s arr. s -> arr -> SplitState s arr
SplitBuffering s
s f a
x1)
                    Just f a
x2 -> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (f a -> SplitState s (f a) -> SplitState s (f a)
forall s arr. arr -> SplitState s arr -> SplitState s arr
SplitYielding f a
x1 (s -> f a -> SplitState s (f a)
forall s arr. s -> arr -> SplitState s arr
SplitSplitting s
s f a
x2))
            Skip s
s -> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (f a)) (f a)
 -> m (Step (SplitState s (f a)) (f a)))
-> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a b. (a -> b) -> a -> b
$ SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (s -> SplitState s (f a)
forall s arr. s -> SplitState s arr
SplitInitial s
s)
            Step s (f a)
Stop -> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitState s (f a)) (f a)
forall s a. Step s a
Stop

    step State StreamK m (f a)
gst (SplitBuffering s
st f a
buf) = do
        Step s (f a)
r <- State StreamK m (f a) -> s -> m (Step s (f a))
step1 State StreamK m (f a)
gst s
st
        case Step s (f a)
r of
            Yield f a
x s
s -> do
                (f a
x1, Maybe (f a)
mx2) <- f a -> m (f a, Maybe (f a))
splitter f a
x
                f a
buf' <- f a -> f a -> m (f a)
joiner f a
buf f a
x1
                Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (f a)) (f a)
 -> m (Step (SplitState s (f a)) (f a)))
-> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a b. (a -> b) -> a -> b
$ case Maybe (f a)
mx2 of
                    Maybe (f a)
Nothing -> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (s -> f a -> SplitState s (f a)
forall s arr. s -> arr -> SplitState s arr
SplitBuffering s
s f a
buf')
                    Just f a
x2 -> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (f a -> SplitState s (f a) -> SplitState s (f a)
forall s arr. arr -> SplitState s arr -> SplitState s arr
SplitYielding f a
buf' (s -> f a -> SplitState s (f a)
forall s arr. s -> arr -> SplitState s arr
SplitSplitting s
s f a
x2))
            Skip s
s -> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (f a)) (f a)
 -> m (Step (SplitState s (f a)) (f a)))
-> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a b. (a -> b) -> a -> b
$ SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (s -> f a -> SplitState s (f a)
forall s arr. s -> arr -> SplitState s arr
SplitBuffering s
s f a
buf)
            Step s (f a)
Stop -> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (f a)) (f a)
 -> m (Step (SplitState s (f a)) (f a)))
-> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a b. (a -> b) -> a -> b
$ SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (f a -> SplitState s (f a) -> SplitState s (f a)
forall s arr. arr -> SplitState s arr -> SplitState s arr
SplitYielding f a
buf SplitState s (f a)
forall s arr. SplitState s arr
SplitFinishing)

    step State StreamK m (f a)
_ (SplitSplitting s
st f a
buf) = do
        (f a
x1, Maybe (f a)
mx2) <- f a -> m (f a, Maybe (f a))
splitter f a
buf
        Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (f a)) (f a)
 -> m (Step (SplitState s (f a)) (f a)))
-> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a b. (a -> b) -> a -> b
$ case Maybe (f a)
mx2 of
                Maybe (f a)
Nothing -> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (SplitState s (f a) -> Step (SplitState s (f a)) (f a))
-> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall a b. (a -> b) -> a -> b
$ s -> f a -> SplitState s (f a)
forall s arr. s -> arr -> SplitState s arr
SplitBuffering s
st f a
x1
                Just f a
x2 -> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (SplitState s (f a) -> Step (SplitState s (f a)) (f a))
-> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall a b. (a -> b) -> a -> b
$ f a -> SplitState s (f a) -> SplitState s (f a)
forall s arr. arr -> SplitState s arr -> SplitState s arr
SplitYielding f a
x1 (s -> f a -> SplitState s (f a)
forall s arr. s -> arr -> SplitState s arr
SplitSplitting s
st f a
x2)

    step State StreamK m (f a)
_ (SplitYielding f a
x SplitState s (f a)
next) = Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (f a)) (f a)
 -> m (Step (SplitState s (f a)) (f a)))
-> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a b. (a -> b) -> a -> b
$ f a -> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. a -> s -> Step s a
Yield f a
x SplitState s (f a)
next
    step State StreamK m (f a)
_ SplitState s (f a)
SplitFinishing = Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitState s (f a)) (f a)
forall s a. Step s a
Stop

-- | Performs infix separator style splitting.
{-# INLINE_NORMAL splitInnerBySuffix #-}
splitInnerBySuffix
    :: Monad m
    => (f a -> Bool)                  -- isEmpty?
    -> (f a -> m (f a, Maybe (f a)))  -- splitter
    -> (f a -> f a -> m (f a))        -- joiner
    -> Stream m (f a)
    -> Stream m (f a)
splitInnerBySuffix :: forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
(f a -> Bool)
-> (f a -> m (f a, Maybe (f a)))
-> (f a -> f a -> m (f a))
-> Stream m (f a)
-> Stream m (f a)
splitInnerBySuffix f a -> Bool
isEmpty f a -> m (f a, Maybe (f a))
splitter f a -> f a -> m (f a)
joiner (Stream State StreamK m (f a) -> s -> m (Step s (f a))
step1 s
state1) =
    (State StreamK m (f a)
 -> SplitState s (f a) -> m (Step (SplitState s (f a)) (f a)))
-> SplitState s (f a) -> Stream m (f a)
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m (f a)
-> SplitState s (f a) -> m (Step (SplitState s (f a)) (f a))
step (s -> SplitState s (f a)
forall s arr. s -> SplitState s arr
SplitInitial s
state1)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m (f a)
-> SplitState s (f a) -> m (Step (SplitState s (f a)) (f a))
step State StreamK m (f a)
gst (SplitInitial s
st) = do
        Step s (f a)
r <- State StreamK m (f a) -> s -> m (Step s (f a))
step1 State StreamK m (f a)
gst s
st
        case Step s (f a)
r of
            Yield f a
x s
s -> do
                (f a
x1, Maybe (f a)
mx2) <- f a -> m (f a, Maybe (f a))
splitter f a
x
                Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (f a)) (f a)
 -> m (Step (SplitState s (f a)) (f a)))
-> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a b. (a -> b) -> a -> b
$ case Maybe (f a)
mx2 of
                    Maybe (f a)
Nothing -> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (s -> f a -> SplitState s (f a)
forall s arr. s -> arr -> SplitState s arr
SplitBuffering s
s f a
x1)
                    Just f a
x2 -> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (f a -> SplitState s (f a) -> SplitState s (f a)
forall s arr. arr -> SplitState s arr -> SplitState s arr
SplitYielding f a
x1 (s -> f a -> SplitState s (f a)
forall s arr. s -> arr -> SplitState s arr
SplitSplitting s
s f a
x2))
            Skip s
s -> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (f a)) (f a)
 -> m (Step (SplitState s (f a)) (f a)))
-> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a b. (a -> b) -> a -> b
$ SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (s -> SplitState s (f a)
forall s arr. s -> SplitState s arr
SplitInitial s
s)
            Step s (f a)
Stop -> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitState s (f a)) (f a)
forall s a. Step s a
Stop

    step State StreamK m (f a)
gst (SplitBuffering s
st f a
buf) = do
        Step s (f a)
r <- State StreamK m (f a) -> s -> m (Step s (f a))
step1 State StreamK m (f a)
gst s
st
        case Step s (f a)
r of
            Yield f a
x s
s -> do
                (f a
x1, Maybe (f a)
mx2) <- f a -> m (f a, Maybe (f a))
splitter f a
x
                f a
buf' <- f a -> f a -> m (f a)
joiner f a
buf f a
x1
                Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (f a)) (f a)
 -> m (Step (SplitState s (f a)) (f a)))
-> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a b. (a -> b) -> a -> b
$ case Maybe (f a)
mx2 of
                    Maybe (f a)
Nothing -> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (s -> f a -> SplitState s (f a)
forall s arr. s -> arr -> SplitState s arr
SplitBuffering s
s f a
buf')
                    Just f a
x2 -> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (f a -> SplitState s (f a) -> SplitState s (f a)
forall s arr. arr -> SplitState s arr -> SplitState s arr
SplitYielding f a
buf' (s -> f a -> SplitState s (f a)
forall s arr. s -> arr -> SplitState s arr
SplitSplitting s
s f a
x2))
            Skip s
s -> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (f a)) (f a)
 -> m (Step (SplitState s (f a)) (f a)))
-> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a b. (a -> b) -> a -> b
$ SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (s -> f a -> SplitState s (f a)
forall s arr. s -> arr -> SplitState s arr
SplitBuffering s
s f a
buf)
            Step s (f a)
Stop ->
                Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (f a)) (f a)
 -> m (Step (SplitState s (f a)) (f a)))
-> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a b. (a -> b) -> a -> b
$
                    if f a -> Bool
isEmpty f a
buf
                    then Step (SplitState s (f a)) (f a)
forall s a. Step s a
Stop
                    else SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (f a -> SplitState s (f a) -> SplitState s (f a)
forall s arr. arr -> SplitState s arr -> SplitState s arr
SplitYielding f a
buf SplitState s (f a)
forall s arr. SplitState s arr
SplitFinishing)

    step State StreamK m (f a)
_ (SplitSplitting s
st f a
buf) = do
        (f a
x1, Maybe (f a)
mx2) <- f a -> m (f a, Maybe (f a))
splitter f a
buf
        Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (f a)) (f a)
 -> m (Step (SplitState s (f a)) (f a)))
-> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a b. (a -> b) -> a -> b
$ case Maybe (f a)
mx2 of
                Maybe (f a)
Nothing -> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (SplitState s (f a) -> Step (SplitState s (f a)) (f a))
-> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall a b. (a -> b) -> a -> b
$ s -> f a -> SplitState s (f a)
forall s arr. s -> arr -> SplitState s arr
SplitBuffering s
st f a
x1
                Just f a
x2 -> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. s -> Step s a
Skip (SplitState s (f a) -> Step (SplitState s (f a)) (f a))
-> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall a b. (a -> b) -> a -> b
$ f a -> SplitState s (f a) -> SplitState s (f a)
forall s arr. arr -> SplitState s arr -> SplitState s arr
SplitYielding f a
x1 (s -> f a -> SplitState s (f a)
forall s arr. s -> arr -> SplitState s arr
SplitSplitting s
st f a
x2)

    step State StreamK m (f a)
_ (SplitYielding f a
x SplitState s (f a)
next) = Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (f a)) (f a)
 -> m (Step (SplitState s (f a)) (f a)))
-> Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a b. (a -> b) -> a -> b
$ f a -> SplitState s (f a) -> Step (SplitState s (f a)) (f a)
forall s a. a -> s -> Step s a
Yield f a
x SplitState s (f a)
next
    step State StreamK m (f a)
_ SplitState s (f a)
SplitFinishing = Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitState s (f a)) (f a)
forall s a. Step s a
Stop

------------------------------------------------------------------------------
-- Trimming
------------------------------------------------------------------------------

-- | Drop prefix from the input stream if present.
--
-- Space: @O(1)@
--
-- See also stripPrefix.
--
-- /Unimplemented/
{-# INLINE dropPrefix #-}
dropPrefix ::
    -- (Monad m, Eq a) =>
    Stream m a -> Stream m a -> Stream m a
dropPrefix :: forall (m :: * -> *) a. Stream m a -> Stream m a -> Stream m a
dropPrefix = [Char] -> Stream m a -> Stream m a -> Stream m a
forall a. HasCallStack => [Char] -> a
error [Char]
"Not implemented yet!"

-- | Drop all matching infix from the input stream if present. Infix stream
-- may be consumed multiple times.
--
-- Space: @O(n)@ where n is the length of the infix.
--
-- See also stripInfix.
--
-- /Unimplemented/
{-# INLINE dropInfix #-}
dropInfix ::
    -- (Monad m, Eq a) =>
    Stream m a -> Stream m a -> Stream m a
dropInfix :: forall (m :: * -> *) a. Stream m a -> Stream m a -> Stream m a
dropInfix = [Char] -> Stream m a -> Stream m a -> Stream m a
forall a. HasCallStack => [Char] -> a
error [Char]
"Not implemented yet!"

-- | Drop suffix from the input stream if present. Suffix stream may be
-- consumed multiple times.
--
-- Space: @O(n)@ where n is the length of the suffix.
--
-- See also stripSuffix.
--
-- /Unimplemented/
{-# INLINE dropSuffix #-}
dropSuffix ::
    -- (Monad m, Eq a) =>
    Stream m a -> Stream m a -> Stream m a
dropSuffix :: forall (m :: * -> *) a. Stream m a -> Stream m a -> Stream m a
dropSuffix = [Char] -> Stream m a -> Stream m a -> Stream m a
forall a. HasCallStack => [Char] -> a
error [Char]
"Not implemented yet!"